Adding a simple UDT on top of 'ThreadInitThenMultiStart' would not produce a 'ThreadPooling' but rather a 'ThreadChaining'.
Example of simple 'ThreadChaining':
Code: Select all
Type ThreadInitThenMultiStart
Public:
Declare Constructor()
Declare Sub ThreadInit(Byval pThread As Function(Byval As Any Ptr) As String, Byval p As Any Ptr = 0)
Declare Sub ThreadStart()
Declare Sub ThreadStart(Byval p As Any Ptr)
Declare Function ThreadWait() As String
Declare Property ThreadState() As Ubyte
Declare Destructor()
Private:
Dim As Function(Byval p As Any Ptr) As String _pThread
Dim As Any Ptr _p
Dim As Any Ptr _mutex1
Dim As Any Ptr _mutex2
Dim As Any Ptr _mutex3
Dim As Any Ptr _pt
Dim As Byte _end
Dim As String _returnF
Dim As Ubyte _state
Declare Static Sub _Thread(Byval p As Any Ptr)
End Type
Constructor ThreadInitThenMultiStart()
This._mutex1 = Mutexcreate()
Mutexlock(This._mutex1)
This._mutex2 = Mutexcreate()
Mutexlock(This._mutex2)
This._mutex3 = Mutexcreate()
Mutexlock(This._mutex3)
End Constructor
Sub ThreadInitThenMultiStart.ThreadInit(Byval pThread As Function(Byval As Any Ptr) As String, Byval p As Any Ptr = 0)
This._pThread = pThread
This._p = p
If This._pt = 0 Then
This._pt= Threadcreate(@ThreadInitThenMultiStart._Thread, @This)
Mutexunlock(This._mutex3)
This._state = 1
End If
End Sub
Sub ThreadInitThenMultiStart.ThreadStart()
Mutexlock(This._mutex3)
Mutexunlock(This._mutex1)
End Sub
Sub ThreadInitThenMultiStart.ThreadStart(Byval p As Any Ptr)
Mutexlock(This._mutex3)
This._p = p
Mutexunlock(This._mutex1)
End Sub
Function ThreadInitThenMultiStart.ThreadWait() As String
Mutexlock(This._mutex2)
Mutexunlock(This._mutex3)
This._state = 1
Return This._returnF
End Function
Property ThreadInitThenMultiStart.ThreadState() As Ubyte
Return This._state
End Property
Sub ThreadInitThenMultiStart._Thread(Byval p As Any Ptr)
Dim As ThreadInitThenMultiStart Ptr pThis = p
Do
Mutexlock(pThis->_mutex1)
If pThis->_end = 1 Then Exit Sub
pThis->_state = 2
pThis->_returnF = pThis->_pThread(pThis->_p)
pThis->_state = 4
Mutexunlock(pThis->_mutex2)
Loop
End Sub
Destructor ThreadInitThenMultiStart()
If This._pt > 0 Then
This._end = 1
Mutexunlock(This._mutex1)
.ThreadWait(This._pt)
End If
Mutexdestroy(This._mutex1)
Mutexdestroy(This._mutex2)
Mutexdestroy(This._mutex3)
End Destructor
'---------------------------------------------------
Type ThreadChaining
Public:
Declare Constructor()
Declare Sub ChainingSubmit(Byval pThread As Function(Byval As Any Ptr) As String, Byval p As Any Ptr = 0)
Declare Sub ChainingWait()
Declare Sub ChainingWait(values() As String)
Declare Property ChainingState() As Ubyte
Declare Destructor()
Private:
Dim As ThreadInitThenMultiStart Ptr _pTITMS
Dim As Function(Byval p As Any Ptr) As String _pThread0
Dim As String _returnF(Any)
End Type
Constructor ThreadChaining()
Redim This._returnF(0)
This._pTITMS = New ThreadInitThenMultiStart
End Constructor
Sub ThreadChaining.ChainingSubmit(Byval pThread As Function(Byval As Any Ptr) As String, Byval p As Any Ptr = 0)
If pThread <> This._pThread0 Then
This._pThread0 = pThread
This._ptitms->ThreadInit(pThread, p)
This._ptitms->ThreadStart()
Else
This._ptitms->ThreadStart(p)
End If
Redim Preserve This._returnF(Ubound(This._returnF) + 1)
This._returnF(Ubound(This._returnF)) = This._ptitms->ThreadWait()
End Sub
Sub ThreadChaining.ChainingWait()
Redim This._returnF(0)
End Sub
Sub ThreadChaining.ChainingWait(values() As String)
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
End Sub
Property ThreadChaining.ChainingState() As Ubyte
return This._ptitms->ThreadState
End Property
Destructor ThreadChaining()
Delete(This._pTITMS)
End Destructor
'---------------------------------------------------
Sub Prnt (Byref s As String, Byval nb As Integer, Byval t As Integer)
For I As Integer = 1 To nb
Print s;
Sleep t, 1
Next I
End Sub
Function UserCode1 (Byval p As Any Ptr) As String
Dim As String Ptr ps = p
If ps > 0 Then Print *ps;
Prnt("1", 10, 200)
Return "UserCode #1"
End Function
Function UserCode2 (Byval p As Any Ptr) As String
Dim As String Ptr ps = p
If ps > 0 Then Print *ps;
Prnt("2", 10, 150)
Return "UserCode #2"
End Function
Function UserCode3 (Byval p As Any Ptr) As String
Dim As String Ptr ps = p
If ps > 0 Then Print *ps;
Prnt("3", 10, 200)
Return "UserCode #3"
End Function
Function UserCode4 (Byval p As Any Ptr) As String
Dim As String Ptr ps = p
If ps > 0 Then Print *ps;
Prnt("4", 10, 150)
Return "UserCode #4"
End Function
Function UserCode5 (Byval p As Any Ptr) As String
Dim As String Ptr ps = p
If ps > 0 Then Print *ps;
Prnt("5", 10, 150)
Return "UserCode #5"
End Function
Function UserCode6 (Byval p As Any Ptr) As String
Dim As String Ptr ps = p
If ps > 0 Then Print *ps;
Prnt("6", 10, 150)
Return "UserCode #6"
End Function
Dim As String sa = " Sequence #a: "
Dim As String sb = " Sequence #b: "
Dim As String s()
Dim As ThreadChaining t
t.ChainingSubmit(@UserCode1, @sa)
t.ChainingSubmit(@UserCode2)
t.ChainingSubmit(@UserCode3)
Print
Print " Sequence #a of 3 user thread functions fully submitted "
t.ChainingWait()
Print " Sequence #a completed"
Print
t.ChainingSubmit(@UserCode4, @sb)
t.ChainingSubmit(@UserCode5)
t.ChainingSubmit(@UserCode6)
Print
Print " Sequence #b of 3 user thread functions fully submitted "
t.ChainingWait(s())
Print " Sequence #b completed"
Print
Print " List of returned values from sequence #b only"
For I As Integer = Lbound(s) To Ubound(s)
Print " " & I & ": " & s(I)
Next I
Print
Sleep
Sequence #a: 111111111122222222223333333333
Sequence #a of 3 user thread functions fully submitted
Sequence #a completed
Sequence #b: 444444444455555555556666666666
Sequence #b of 3 user thread functions fully submitted
Sequence #b completed
List of returned values from sequence #b only
1: UserCode #4
2: UserCode #5
3: UserCode #6
'ThreadPooling' allows you to manage a kind of FIFO (First In First Out) via dynamic arrays:
- Arrays are filled in as user submissions (from the main thread).
- Arrays are automatically emptied on the fly by the secondary thread which executes their requests as and when.
- So, the inputs and outputs of this "FIFO" are therefore asynchronous with an optimized throughput on each side.
With 'ThreadChaining' the execution time of a 'ChainingSubmit' method, in the main thread, corresponds to the recording time plus the full execution time of the user procedure in the secondary thread.
With 'ThreadPooling' the execution time of a 'PoolingSubmit' method, in the main thread, corresponds only to the recording time.
Code: Select all
Type ThreadInitThenMultiStart
Public:
Declare Constructor()
Declare Sub ThreadInit(Byval pThread As Function(Byval As Any Ptr) As String, Byval p As Any Ptr = 0)
Declare Sub ThreadStart()
Declare Sub ThreadStart(Byval p As Any Ptr)
Declare Function ThreadWait() As String
Declare Property ThreadState() As Ubyte
Declare Destructor()
Private:
Dim As Function(Byval p As Any Ptr) As String _pThread
Dim As Any Ptr _p
Dim As Any Ptr _mutex1
Dim As Any Ptr _mutex2
Dim As Any Ptr _mutex3
Dim As Any Ptr _pt
Dim As Byte _end
Dim As String _returnF
Dim As Ubyte _state
Declare Static Sub _Thread(Byval p As Any Ptr)
End Type
Constructor ThreadInitThenMultiStart()
This._mutex1 = Mutexcreate()
Mutexlock(This._mutex1)
This._mutex2 = Mutexcreate()
Mutexlock(This._mutex2)
This._mutex3 = Mutexcreate()
Mutexlock(This._mutex3)
End Constructor
Sub ThreadInitThenMultiStart.ThreadInit(Byval pThread As Function(Byval As Any Ptr) As String, Byval p As Any Ptr = 0)
This._pThread = pThread
This._p = p
If This._pt = 0 Then
This._pt= Threadcreate(@ThreadInitThenMultiStart._Thread, @This)
Mutexunlock(This._mutex3)
This._state = 1
End If
End Sub
Sub ThreadInitThenMultiStart.ThreadStart()
Mutexlock(This._mutex3)
Mutexunlock(This._mutex1)
End Sub
Sub ThreadInitThenMultiStart.ThreadStart(Byval p As Any Ptr)
Mutexlock(This._mutex3)
This._p = p
Mutexunlock(This._mutex1)
End Sub
Function ThreadInitThenMultiStart.ThreadWait() As String
Mutexlock(This._mutex2)
Mutexunlock(This._mutex3)
This._state = 1
Return This._returnF
End Function
Property ThreadInitThenMultiStart.ThreadState() As Ubyte
Return This._state
End Property
Sub ThreadInitThenMultiStart._Thread(Byval p As Any Ptr)
Dim As ThreadInitThenMultiStart Ptr pThis = p
Do
Mutexlock(pThis->_mutex1)
If pThis->_end = 1 Then Exit Sub
pThis->_state = 2
pThis->_returnF = pThis->_pThread(pThis->_p)
pThis->_state = 4
Mutexunlock(pThis->_mutex2)
Loop
End Sub
Destructor ThreadInitThenMultiStart()
If This._pt > 0 Then
This._end = 1
Mutexunlock(This._mutex1)
.ThreadWait(This._pt)
End If
Mutexdestroy(This._mutex1)
Mutexdestroy(This._mutex2)
Mutexdestroy(This._mutex3)
End Destructor
'---------------------------------------------------
Type ThreadChaining
Public:
Declare Constructor()
Declare Sub ChainingSubmit(Byval pThread As Function(Byval As Any Ptr) As String, Byval p As Any Ptr = 0)
Declare Sub ChainingWait()
Declare Sub ChainingWait(values() As String)
Declare Property ChainingState() As Ubyte
Declare Destructor()
Private:
Dim As ThreadInitThenMultiStart Ptr _pTITMS
Dim As Function(Byval p As Any Ptr) As String _pThread0
Dim As String _returnF(Any)
End Type
Constructor ThreadChaining()
Redim This._returnF(0)
This._pTITMS = New ThreadInitThenMultiStart
End Constructor
Sub ThreadChaining.ChainingSubmit(Byval pThread As Function(Byval As Any Ptr) As String, Byval p As Any Ptr = 0)
If pThread <> This._pThread0 Then
This._pThread0 = pThread
This._ptitms->ThreadInit(pThread, p)
This._ptitms->ThreadStart()
Else
This._ptitms->ThreadStart(p)
End If
Redim Preserve This._returnF(Ubound(This._returnF) + 1)
This._returnF(Ubound(This._returnF)) = This._ptitms->ThreadWait()
End Sub
Sub ThreadChaining.ChainingWait()
Redim This._returnF(0)
End Sub
Sub ThreadChaining.ChainingWait(values() As String)
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
End Sub
Property ThreadChaining.ChainingState() As Ubyte
return This._ptitms->ThreadState
End Property
Destructor ThreadChaining()
Delete(This._pTITMS)
End Destructor
'---------------------------------------------------
#include once "crt/string.bi"
Type ThreadPooling '' version super-new
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
'---------------------------------------------------
Sub Prnt (Byref s As String, Byval nb As Integer, Byval t As Integer)
For I As Integer = 1 To nb
Print s;
Sleep t, 1
Next I
End Sub
Function UserCode1 (Byval p As Any Ptr) As String
Dim As String Ptr ps = p
If ps > 0 Then Print *ps;
Prnt("1", 10, 200)
Return ""
End Function
Function UserCode2 (Byval p As Any Ptr) As String
Dim As String Ptr ps = p
If ps > 0 Then Print *ps;
Prnt("2", 10, 150)
Return ""
End Function
Function UserCode3 (Byval p As Any Ptr) As String
Dim As String Ptr ps = p
If ps > 0 Then Print *ps;
Prnt("3", 10, 200)
Return ""
End Function
Dim As String s()
Dim As ThreadChaining tb
Dim As ThreadPooling tc
Print "Legend:"
Print "'n' : user procedure number"
Print "'[sn]' : begin of the 'Submit' method for the user procedure 'n'"
Print "'[/sn]' : end of the 'Submit' method for the user procedure 'n'"
Print "'[w]' : begin of the 'Wait' method"
Print "'[/w]' : end of the 'Wait' method"
Print
Print
Print "Sequence with 'ThreadChaining':"
Print "[s1]";
tb.ChainingSubmit(@UserCode1)
Print "[/s1]";
Print "[s2]";
tb.ChainingSubmit(@UserCode2)
Print "[/s2]";
Print "[s3]";
tb.ChainingSubmit(@UserCode3)
Print "[/s3]";
Print "[w]";
tb.ChainingWait()
Print "[/w]"
Print
Print "Sequence with 'ThreadPooling':"
Print "[s1]";
tc.PoolingSubmit(@UserCode1)
Print "[/s1]";
Print "[s2]";
tc.PoolingSubmit(@UserCode2)
Print "[/s2]";
Print "[s3]";
tc.PoolingSubmit(@UserCode3)
Print "[/s3]";
Print "[w]";
tc.PoolingWait()
Print "[/w]"
Print
Sleep
Legend:
'n' : user procedure number
'[sn]' : begin of the 'Submit' method for the user procedure 'n'
'[/sn]' : end of the 'Submit' method for the user procedure 'n'
'[w]' : begin of the 'Wait' method
'[/w]' : end of the 'Wait' method
Sequence with 'ThreadChaining':
[s1]1111111111[/s1][s2]2222222222[/s2][s3]3333333333[/s3][w][/w]
Sequence with 'ThreadPooling':
[s1][/s1][s2][/s2][s3]1[/s3][w]11111111122222222223333333333[/w]
To regain the performance of a real queue, it would be necessary to reproduce a kind of FIFO at a higher level and therefore for example create another secondary thread which would take care of emptying the queue independently (in parallel) of its input (from the main thread).
But that would use 2 secondary threads altogether per instance, whereas the same work can be done with a single secondary thread as with 'ThreadPooling'.