See (for description and code):
- viewtopic.php?p=280695#p280695
- viewtopic.php?p=279512#p279512
- 'Programmer's Guide' (in 'Critical Sections FAQ' article): 13. Can we emulate a kind of thread pooling feature with FreeBASIC?
I added a second optional parameter to the 'ThreadDispatching' Type constructor in addition to the maximum number of usable secondary threads (1 secondary thread by default).
This second parameter allows to set the minimum number of initialized secondary threads (0 secondary thread by default).
As this second parameter is optional (as is the first), there is full compatibility with any user code prior to this change.
This second parameter makes it possible to impose a minimum number of secondary threads initialized as soon as the 'ThreadDispatching' instance is constructed and therefore immediately ready for user task submission (real-time improvement for starting user task).
Therefore, the number of secondary threads used is always between the minimum value and the maximum value, both fixed at the construction time.
Secondary threads that become pending are never stopped and therefore the number of secondary threads used can only increase over the lifetime of the 'ThreadDispatching' instance.
Example:
Code: Select all
#include once "crt/string.bi"
Type ThreadPooling
Public:
Declare Constructor()
Declare Sub PoolingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
Declare Sub PoolingWait()
Declare Sub PoolingWait(values() As String)
Declare Property PoolingState() As UByte
Declare Destructor()
Private:
Dim As Function(ByVal p As Any Ptr) As String _pThread0
Dim As Any Ptr _p0
Dim As Function(ByVal p As Any Ptr) As String _pThread(Any)
Dim As Any Ptr _p(Any)
Dim As Any Ptr _mutex
Dim As Any Ptr _cond1
Dim As Any Ptr _cond2
Dim As Any Ptr _pt
Dim As Byte _end
Dim As String _returnF(Any)
Dim As UByte _state
Declare Static Sub _Thread(ByVal p As Any Ptr)
End Type
Constructor ThreadPooling()
ReDim This._pThread(0)
ReDim This._p(0)
ReDim This._returnF(0)
This._mutex = MutexCreate()
This._cond1 = CondCreate()
This._cond2 = CondCreate()
This._pt= ThreadCreate(@ThreadPooling._Thread, @This)
End Constructor
Sub ThreadPooling.PoolingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
MutexLock(This._mutex)
ReDim Preserve This._pThread(UBound(This._pThread) + 1)
This._pThread(UBound(This._pThread)) = pThread
ReDim Preserve This._p(UBound(This._p) + 1)
This._p(UBound(This._p)) = p
CondSignal(This._cond2)
This._state = 1
MutexUnlock(This._mutex)
End Sub
Sub ThreadPooling.PoolingWait()
MutexLock(This._mutex)
While (This._state And 11) > 0
CondWait(This._Cond1, This._mutex)
Wend
ReDim This._returnF(0)
This._state = 0
MutexUnlock(This._mutex)
End Sub
Sub ThreadPooling.PoolingWait(values() As String)
MutexLock(This._mutex)
While (This._state And 11) > 0
CondWait(This._Cond1, This._mutex)
Wend
If UBound(This._returnF) > 0 Then
ReDim values(1 To UBound(This._returnF))
For I As Integer = 1 To UBound(This._returnF)
values(I) = This._returnF(I)
Next I
ReDim This._returnF(0)
Else
Erase values
End If
This._state = 0
MutexUnlock(This._mutex)
End Sub
Property ThreadPooling.PoolingState() As UByte
If UBound(This._p) > 0 Then
Return 8 + This._state
Else
Return This._state
End If
End Property
Sub ThreadPooling._Thread(ByVal p As Any Ptr)
Dim As ThreadPooling Ptr pThis = p
Do
MutexLock(pThis->_mutex)
If UBound(pThis->_pThread) = 0 Then
pThis->_state = 4
CondSignal(pThis->_cond1)
While UBound(pThis->_pThread) = 0
CondWait(pThis->_cond2, pThis->_mutex)
If pThis->_end = 1 Then Exit Sub
Wend
End If
pThis->_pThread0 = pThis->_pThread(1)
pThis->_p0 = pThis->_p(1)
If UBound(pThis->_pThread) > 1 Then
memmove(@pThis->_pThread(1), @pThis->_pThread(2), (UBound(pThis->_pThread) - 1) * SizeOf(pThis->_pThread))
memmove(@pThis->_p(1), @pThis->_p(2), (UBound(pThis->_p) - 1) * SizeOf(pThis->_p))
End If
ReDim Preserve pThis->_pThread(UBound(pThis->_pThread) - 1)
ReDim Preserve pThis->_p(UBound(pThis->_p) - 1)
MutexUnlock(pThis->_mutex)
ReDim Preserve pThis->_ReturnF(UBound(pThis->_returnF) + 1)
pThis->_state = 2
pThis->_returnF(UBound(pThis->_returnF)) = pThis->_pThread0(pThis->_p0)
Loop
End Sub
Destructor ThreadPooling()
MutexLock(This._mutex)
This._end = 1
CondSignal(This._cond2)
MutexUnlock(This._mutex)
.ThreadWait(This._pt)
MutexDestroy(This._mutex)
CondDestroy(This._cond1)
CondDestroy(This._cond2)
End Destructor
'---------------------------------------------------
Type ThreadDispatching
Public:
Declare Constructor(ByVal nbMaxSecondaryThread As Integer = 1, ByVal nbMinSecondaryThread As Integer = 0)
Declare Sub DispatchingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
Declare Sub DispatchingWait()
Declare Sub DispatchingWait(values() As String)
Declare Property DispatchingThread() As Integer
Declare Sub DispatchingState(state() As Ubyte)
Declare Destructor()
Private:
Dim As Integer _nbmst
Dim As Integer _dstnb
Dim As ThreadPooling Ptr _tp(Any)
End Type
Constructor ThreadDispatching(ByVal nbMaxSecondaryThread As Integer = 1, ByVal nbMinSecondaryThread As Integer = 0)
This._nbmst = nbMaxSecondaryThread
If nbMinSecondaryThread > nbMaxSecondaryThread Then
nbMinSecondaryThread = nbMaxSecondaryThread
End If
If nbMinSecondaryThread > 0 Then
ReDim This._tp(nbMinSecondaryThread - 1)
For I As Integer = 0 To nbMinSecondaryThread - 1
This._tp(I) = New ThreadPooling
Next I
End If
End Constructor
Sub ThreadDispatching.DispatchingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
For I As Integer = 0 To UBound(This._tp)
If (This._tp(I)->PoolingState And 3) = 0 Then
This._tp(I)->PoolingSubmit(pThread, p)
Exit Sub
End If
Next I
If UBound(This._tp) < This._nbmst - 1 Then
ReDim Preserve This._tp(UBound(This._tp) + 1)
This._tp(UBound(This._tp)) = New ThreadPooling
This._tp(UBound(This._tp))->PoolingSubmit(pThread, p)
ElseIf UBound(This._tp) >= 0 Then
This._tp(This._dstnb)->PoolingSubmit(pThread, p)
This._dstnb = (This._dstnb + 1) Mod This._nbmst
End If
End Sub
Sub ThreadDispatching.DispatchingWait()
For I As Integer = 0 To UBound(This._tp)
This._tp(I)->PoolingWait()
Next I
End Sub
Sub ThreadDispatching.DispatchingWait(values() As String)
Dim As String s()
For I As Integer = 0 To UBound(This._tp)
This._tp(I)->PoolingWait(s())
If UBound(s) >= 1 Then
If UBound(values) = -1 Then
ReDim Preserve values(1 To UBound(values) + UBound(s) + 1)
Else
ReDim Preserve values(1 To UBound(values) + UBound(s))
End If
For I As Integer = 1 To UBound(s)
values(UBound(values) - UBound(s) + I) = s(I)
Next I
End If
Next I
End Sub
Property ThreadDispatching.DispatchingThread() As Integer
Return UBound(This._tp) + 1
End Property
Sub ThreadDispatching.DispatchingState(state() As Ubyte)
If UBound(This._tp) >= 0 Then
Redim state(1 To UBound(This._tp) + 1)
For I As Integer = 0 To UBound(This._tp)
state(I + 1) = This._tp(I)->PoolingState
Next I
End If
End Sub
Destructor ThreadDispatching()
For I As Integer = 0 To UBound(This._tp)
Delete This._tp(I)
Next I
End Destructor
'---------------------------------------------------
Dim Shared As Double array(1 To 800000) '' only used by the [For...Next] waiting loop in UserCode()
Function UserCode (ByVal p As Any Ptr) As String
Dim As String Ptr ps = p
For I As Integer = 1 To 2
Print *ps;
For J As Integer = 1 To 800000
array(J) = Tan(J) * Atn(J) * Exp(J) * Log(J) '' [For...Next] waiting loop not freeing any CPU resource
Next J
Next I
Return ""
End Function
Dim As String s(0 To 31)
For I As Integer = 0 To 15
s(I) = Str(Hex(I))
Next I
For I As Integer = 16 To 31
s(I) = Chr(55 + I)
Next I
'---------------------------------------------------
Scope
For I As Integer = 1 To 16
Print "'ThreadDispatching' with " & I & "/" & I Shr 2 & " (maximum/minimum) secondary threads:"
Dim As ThreadDispatching td = ThreadDispatching(I, I Shr 2)
Print " Number of secondary threads at start : " & td.DispatchingThread
Dim As Double t = Timer
Print " ";
For I As Integer = 0 To 31
td.DispatchingSubmit(@UserCode, @s(I))
Next I
td.DispatchingWait()
t = Timer - t
Print Using " :####.## s"; t
Print " Number of secondary threads at end : " & td.DispatchingThread
Print
Next I
End Scope
Sleep
Code: Select all
'ThreadDispatching' with 1/0 (maximum/minimum) secondary threads:
Number of secondary threads at start : 0
00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVV : 5.35 s
Number of secondary threads at end : 1
'ThreadDispatching' with 2/0 (maximum/minimum) secondary threads:
Number of secondary threads at start : 0
01012323454567678989ABABCDCDEFEFGHGHIJIJKLKLMNMNOPOPQRQRSTSTUVUV : 2.74 s
Number of secondary threads at end : 2
'ThreadDispatching' with 3/0 (maximum/minimum) secondary threads:
Number of secondary threads at start : 0
012120453453786786BA9BA9EDCECDHFGHFGKIJKJINMLNMLQPOQPOTSRTSRVUVU : 2.01 s
Number of secondary threads at end : 3
'ThreadDispatching' with 4/1 (maximum/minimum) secondary threads:
Number of secondary threads at start : 1
012332107564657498AB98BACDFECDFEGHJIGJHIKLNMKLNMOPQRORPQVSTUVTSU : 1.46 s
Number of secondary threads at end : 4
'ThreadDispatching' with 5/1 (maximum/minimum) secondary threads:
Number of secondary threads at start : 1
01234120347689579685BEACDCAEBDFHJGIFHJGIKMOLNKMOLNPRTQSPRQTSUVUV : 1.28 s
Number of secondary threads at end : 5
'ThreadDispatching' with 6/1 (maximum/minimum) secondary threads:
Number of secondary threads at start : 1
0132453042519A678B96A7B8FCGEDHFCGDEHLIMKJNLIMKJNROQSPTROQSPTUVVU : 1.24 s
Number of secondary threads at end : 6
'ThreadDispatching' with 7/1 (maximum/minimum) secondary threads:
Number of secondary threads at start : 1
01254360452316C7B9A8D7BC9A8DIEJGHFKIGEJHFKNPLQMORNPMLQORUTVSUTVS : 1.14 s
Number of secondary threads at end : 7
'ThreadDispatching' with 8/2 (maximum/minimum) secondary threads:
Number of secondary threads at start : 2
01234567156320479DBE8ACF9DCBAFE8HLKJINMGHLKJINGMPRSTVQOUPSRTVQUO : 1.03 s
Number of secondary threads at end : 8
'ThreadDispatching' with 9/2 (maximum/minimum) secondary threads:
Number of secondary threads at start : 2
132045678413762580BGAEHD9FCEGDHAF9BCNPJMQIOKLNPMIJOQKLVRSTUVRSTU : 1.11 s
Number of secondary threads at end : 9
'ThreadDispatching' with 10/2 (maximum/minimum) secondary threads:
Number of secondary threads at start : 2
01234567899657481023FGJHEBAIDCFGBHAEJDICLPQKRTNOPSMQLRNTKOSMVUVU : 1.12 s
Number of secondary threads at end : 10
'ThreadDispatching' with 11/2 (maximum/minimum) secondary threads:
Number of secondary threads at start : 2
0123546789A90178243A56CJFGKEDBILHCJGFKBEDHLINRUMQPVSOTNRMUPVSQTO : 1.07 s
Number of secondary threads at end : 11
'ThreadDispatching' with 12/3 (maximum/minimum) secondary threads:
Number of secondary threads at start : 3
0123456789AB0287354961BKCEAGHFJILDNKCGMJEIHNDFLSOQTMUPVSROQTPUVR : 1.02 s
Number of secondary threads at end : 12
'ThreadDispatching' with 13/3 (maximum/minimum) secondary threads:
Number of secondary threads at start : 3
0123456789ABC8729635104CBAFJMLIEGKFOPDHNJMISKLOEGNDHPSVRTVQURTQU : 1.09 s
Number of secondary threads at end : 13
'ThreadDispatching' with 14/3 (maximum/minimum) secondary threads:
Number of secondary threads at start : 3
1023546789ABCD9B1A4357028C6DNPFLOGMEIJKRHQGLOMPFNKHJIERQUTVSUTVS : 1.11 s
Number of secondary threads at end : 14
'ThreadDispatching' with 15/3 (maximum/minimum) secondary threads:
Number of secondary threads at start : 3
012345678BA9CDE0A9B5D7148C236ESMFQPOGKNJIHTQLRMSPFKJGONHLRTIUVUV : 1.11 s
Number of secondary threads at end : 15
'ThreadDispatching' with 16/4 (maximum/minimum) secondary threads:
Number of secondary threads at start : 4
0123456789ABDEFC9D203EA5861B47FUICTPJGMHKOLRQVNGPUJSTIRQMLHKONVS : 1.06 s
Number of secondary threads at end : 16