wth -- Thread time .vs Subroutine time

[deltarho[1859]]

Timing random number generators with gcc is a bit of a black art. I have tweaked one test and got the following.

CryptoRndII throughput (MHz): gcc 8.3/-O3 for 32bit and gcc 5.2/-O3 for 64bit.

Code: Select all

32bit 64bit
 445   511  Microsoft
 424   476  ThreadInitThenMultiStart
 411   460  ThreadPooling (super-new)

With the above the CryptoRndII buffers are repeatedly exhausted at a 'flat out' rate. [Full parallelization is used, no serial processing.] This would not be done in a real-world application, so I reckon that there would be no perceived performance difference whichever method we used.

With the 1TB PractRand test, a buffer was filled 8,388,608 times. Plenty of opportunity to go wrong there, but it didn't.

Considering the extra workload of ThreadPooling it is pretty close to the heels of ThreadInitThenMultiStart; only 3% behind.

For comparison Mersenne Twister comes in at about 90MHz and fails PractRand 0.94 at 256GB.

[fxm]

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'.

[fxm]

Example of compared performances (for 1 secondary thread only) between 'ThreadInitThenMultiStart', 'ThreadChaining' and 'ThreadPooling'.
3 kinds of test:
- Between the first three Types: as many 'init'&'start'/'submit' as 'wait'.
- Between the last two Types: 4 s'ubmits' for 1 'wait'.
- Between the last two Types: all 'submits' then 1 'wait'.
The case below is the most unfavorable use for user, where the user function is as short as possible (just returning an empty string):

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

'---------------------------------------------------

Function UserCode1 (Byval p As Any Ptr) As String
    Return "1"
End Function

Function UserCode2 (Byval p As Any Ptr) As String
    Return "2"
End Function

Dim As ThreadInitThenMultiStart ta
Dim As ThreadChaining tb
Dim As ThreadPooling tc
Dim As Double t

Print "Sequence of 10000 [ta.ThreadInit(@UserCode),ta.ThreadStart(),ta.ThreadWait()]"
t = Timer
For I As Integer = 1 To 5000
    ta.ThreadInit(@UserCode1)
    ta.ThreadStart()
    ta.ThreadWait()
    ta.ThreadInit(@UserCode2)
    ta.ThreadStart()
    ta.ThreadWait()
Next I
t = (Timer - t) * 1000
Print Cint(t); " ms"
Print

Print "Sequence of 10000 [tb.ChainingSubmit(@UserCode),tb.ChainingWait()]"
t = Timer
For I As Integer = 1 To 5000
    tb.ChainingSubmit(@UserCode1)
    tb.ChainingWait()
    tb.ChainingSubmit(@UserCode2)
    tb.ChainingWait()
Next I
t = (Timer - t) * 1000
Print Cint(t); " ms"
Print

Print "Sequence of 10000 [tc.PoolingSubmit(@UserCode),tc.PoolingWait()]"
t = Timer
For I As Integer = 1 To 5000
    tc.PoolingSubmit(@UserCode1)
    tc.PoolingWait()
    tc.PoolingSubmit(@UserCode2)
    tc.PoolingWait()
Next I
t = (Timer - t) * 1000
Print Cint(t); " ms"
Print
Print
Print

Print "Sequence of 2500 [4*tb.ChainingSubmit(@UserCode),tb.ChainingWait()]"
t = Timer
For I As Integer = 1 To 2500
    For J As Integer = 1 To 2
        tb.ChainingSubmit(@UserCode1)
        tb.ChainingSubmit(@UserCode2)
    Next J
    tb.ChainingWait()
Next I
t = (Timer - t) * 1000
Print Cint(t); " ms"
Print

Print "Sequence of 2500 [4*tc.PoolingSubmit(@UserCode),tc.PoolingWait()]"
t = Timer
For I As Integer = 1 To 2500
    For J As Integer = 1 To 2
        tc.PoolingSubmit(@UserCode1)
        tc.PoolingSubmit(@UserCode2)
    Next J
    tc.PoolingWait()
Next I
t = (Timer - t) * 1000
Print Cint(t); " ms"
Print
Print
Print

Print "Sequence of 10000 [tb.ChainingSubmit(@UserCode)] ended by 1 [tb.ChainingWait()]"
t = Timer
For I As Integer = 1 To 5000
    tb.ChainingSubmit(@UserCode1)
    tb.ChainingSubmit(@UserCode2)
Next I
tb.ChainingWait()
t = (Timer - t) * 1000
Print Cint(t); " ms"
Print

Print "Sequence of 10000 [tc.PoolingSubmit(@UserCode)] ended by 1 [tc.PoolingWait()]"
t = Timer
For I As Integer = 1 To 5000
    tc.PoolingSubmit(@UserCode1)
    tc.PoolingSubmit(@UserCode2)
Next I
tc.PoolingWait()
t = (Timer - t) * 1000
Print Cint(t); " ms"

Sleep

Sequence of 10000 [ta.ThreadInit(@UserCode),ta.ThreadStart(),ta.ThreadWait()]
150 ms

Sequence of 10000 [tb.ChainingSubmit(@UserCode),tb.ChainingWait()]
174 ms

Sequence of 10000 [tc.PoolingSubmit(@UserCode),tc.PoolingWait()]
181 ms



Sequence of 2500 [4*tb.ChainingSubmit(@UserCode),tb.ChainingWait()]
158 ms

Sequence of 2500 [4*tc.PoolingSubmit(@UserCode),tc.PoolingWait()]
157 ms



Sequence of 10000 [tb.ChainingSubmit(@UserCode)] ended by 1 [tb.ChainingWait()]
143 ms

Sequence of 10000 [tc.PoolingSubmit(@UserCode)] ended by 1 [tc.PoolingWait()]
113 ms

[fxm]

In conclusion, 'ThreadChaining' has no interest in the case of multi-threading (multi secondary threading), because the submitted user procedures will necessarily be executed one after the other temporally in the threads, whereas with 'ThreadInitThenMultiStart' or 'ThreadPooling' the user procedures can be executed in quasi parallel temporally in the threads.

Example of no multi-threading gain using 'ThreadChaining' compared to 'ThreadInitThenMultiStart' or 'ThreadPooling':

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

'---------------------------------------------------

#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 11) = 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

'---------------------------------------------------

#macro ThreadInitThenMultiStartSequence(nbThread)
Scope
    Redim As ThreadInitThenMultiStart ts(nbThread - 1)
    Print "   ";
    Dim As Double t = Timer
    For I As Integer = 0 To 32 - nbThread Step nbThread
        For J As Integer = 0 To nbThread - 1
            ts(J).ThreadInit(@UserCode, @s(I + J))
            ts(J).ThreadStart()
        Next J
        For J As Integer = 0 To nbThread - 1
            ts(J).ThreadWait()
        Next J
    Next I
    t = Timer - t
    Print Using " : ####.## s"; t
End Scope
#endmacro

#macro ThreadPoolingSequence(nbThread)
Scope
    ReDim As ThreadPooling tp(nbThread - 1)
    Print "   ";
    Dim As Double t = Timer
    For I As Integer = 0 To 32 - nbThread Step nbThread
        For J As Integer = 0 To nbThread - 1
            tp(J).PoolingSubmit(@UserCode, @s(I + J))
        Next J
    Next I
    For I As Integer = 0 To nbThread - 1
        tp(I).PoolingWait()
    Next I
    t = Timer - t
    Print Using " : ####.## s"; t
End Scope
#endmacro

#macro ThreadDispatchingSequence(nbThreadmax)
Scope
    Dim As ThreadDispatching td##nbThreadmax = nbThreadmax
    Print "   ";
    Dim As Double t = Timer
    For I As Integer = 0 To 31
        td##nbThreadmax.DispatchingSubmit(@UserCode, @s(I))
    Next I
    td##nbThreadmax.DispatchingWait()
    t = Timer - t
    Print Using " : ####.## s"; t
End Scope
#endmacro
    
'---------------------------------------------------

Print "'ThreadInitThenMultiStart' with 1 secondary thread:"
ThreadInitThenMultiStartSequence(1)

Print "'ThreadPooling' with 1 secondary thread:"
ThreadPoolingSequence(1)

Print "'ThreadDispatching' with 1 secondary thread max:"
ThreadDispatchingSequence(1)
Print

'---------------------------------------------------

Print "'ThreadInitThenMultiStart' with 2 secondary threads:"
ThreadInitThenMultiStartSequence(2)

Print "'ThreadPooling' with 2 secondary threads:"
ThreadPoolingSequence(2)

Print "'ThreadDispatching' with 2 secondary threads max:"
ThreadDispatchingSequence(2)
Print

'---------------------------------------------------

Print "'ThreadInitThenMultiStart' with 4 secondary threads:"
ThreadInitThenMultiStartSequence(4)

Print "'ThreadPooling' with 4 secondary threads:"
ThreadPoolingSequence(4)

Print "'ThreadDispatching' with 4 secondary threads max:"
ThreadDispatchingSequence(4)
Print

'---------------------------------------------------

Print "'ThreadInitThenMultiStart' with 8 secondary threads:"
ThreadInitThenMultiStartSequence(8)

Print "'ThreadPooling' with 8 secondary threads:"
ThreadPoolingSequence(8)

Print "'ThreadDispatching' with 8 secondary threads max:"
ThreadDispatchingSequence(8)
Print

'---------------------------------------------------

Print "'ThreadInitThenMultiStart' with 16 secondary threads:"
ThreadInitThenMultiStartSequence(16)

Print "'ThreadPooling' with 16 secondary threads:"
ThreadPoolingSequence(16)

Print "'ThreadDispatching' with 16 secondary threads max:"
ThreadDispatchingSequence(16)
Print

'---------------------------------------------------

Print "'ThreadInitThenMultiStart' with 32 secondary threads:"
ThreadInitThenMultiStartSequence(32)

Print "'ThreadPooling' with 32 secondary threads:"
ThreadPoolingSequence(32)

Print "'ThreadDispatching' with 32 secondary threads max:"
ThreadDispatchingSequence(32)
Print

Sleep

'ThreadInitThenMultiStart' with 1 secondary thread:
00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVV 7.42 s
'ThreadChaining' with 1 secondary thread:
00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVV 7.48 s
'ThreadPooling' with 1 secondary thread:
00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVV 7.48 s

'ThreadInitThenMultiStart' with 2 secondary threads:
01012323454567678989ABABCDCDEFEFGHHGIJIJKLKLNMNMOPOPQRQRTSTSVUVU 3.99 s
'ThreadChaining' with 2 secondary threads:
00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVV 7.48 s
'ThreadPooling' with 2 secondary threads:
10012323544576769898BABADCDCFEFEHGHGJIJILKLKNMMNOPOPQRQRTSSTUVUV 3.98 s

'ThreadInitThenMultiStart' with 4 secondary threads:
012331204567457689ABA8B9CDEFDCEFGHIJJGHIKLMNKMLNOPRQRPOQSTUVSTUV 2.26 s
'ThreadChaining' with 4 secondary threads:
00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVV 7.50 s
'ThreadPooling' with 4 secondary threads:
01230213465764758AB98AB9CEFDCEFDGIJHGIJHKMNLKLNMORPQORPQSVTUVTSU 2.22 s

'ThreadInitThenMultiStart' with 8 secondary threads:
015342670234176589ABCFEDBA89EFDCGHIKJLNMGKIHNMLJOPQRSUTVPQORVSTU 2.28 s
'ThreadChaining' with 8 secondary threads:
00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVV 7.48 s
'ThreadPooling' with 8 secondary threads:
0123546720316475BA89FDCEA98BCDEFJGHIKNMLGHIJLMKNRQPOSVUTQOPRUVTS 2.23 s

'ThreadInitThenMultiStart' with 16 secondary threads:
01F3456789ABCDE2503F1487A96C2EDBGIHJKLMNOPQRSTUVGIJHNLMKOSRPQUVT 2.33 s
'ThreadChaining' with 16 secondary threads:
00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVV 7.48 s
'ThreadPooling' with 16 secondary threads:
0123456789ACBEDF021387659A4BDEJGFIHOCMPKTGVUJQLRNOMSHTUVPKQLINSR 2.24 s

'ThreadInitThenMultiStart' with 32 secondary threads:
0123456789ABCDEFHGIJKLMOPNQRTUSV6405ADCE9B78132JHILKMQRPSUGFONTV 2.23 s
'ThreadChaining' with 32 secondary threads:
00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVV 7.48 s
'ThreadPooling' with 32 secondary threads:
0U23546789ACDBEGFHIKLJMNOPRSTQV10U2378465BDCAFGLHEJKI9ONPMSQTV1R 2.22 s

[fxm]

- Diagram of code synchronization between two threads by using one mutex in mode self-locking and mutual-unlocking:

Code: Select all

'     Initial state : mutex locked by 'Thread B'
'     Thread A                   Thread B
'
'     code A1                    code B1
'     MutexLock(@mutex) <------- MutexUnlock(@mutex)
'     code A2                    code B2
'     MutexUnlock(@mutex) -----> MutexLock(@mutex)
'     code A3                    code B3
'
'
'     thread A ...<-code A1->......<----code A2----><-code A3->...
'     thread B ...<----code B1----><-code B2->......<----code B3---->...
'
'     synchronization moments .....|................|...................

- Diagram of code synchronization between two threads by using one conditional variable (+ one mutex and flags) by using CondWait and CondSignal:

Code: Select all

'      Initial state : 'Thread A' first locks the mutex
'      Thread A                               Thread B
'
'      MutexLock(@mutex)                 .--> MutexLock(@mutex)
'      code A1                           |    code B1
'      While flagB = false               |    flagB = true
'          CondWait(@condvar, @mutex) <--*--- CondSignal(@condvar)
'      Wend <----------------------------.
'      flagB = false                     |
'      code A2                           |    code B2
'      flagA = true                      |    While flagA = false
'      CondSignal(@condvar) -------------*-----> CondWait(@condvar, @mutex)
'      code A3                           .--> Wend
'                                        |    flagA = false
'                                        |    code B3
'      MutexUnlock(@mutex) --------------'    MutexUnlock(@mutex)
'
'
'      threadA ............<-code A1->.......................<-code A2-><-code A3->...
'      threadB .......................<-tcode B1-><-code B2->......................<-code B3->...
'
'      synchronization moments .......|......................|.....................|.............

For more information, see the Programmer's Guide (Multi-Threading).

[fxm]

As soon as I have a bit of time (soon, no doubt!), I will also document this new 'ThreadPooling' following 'ThreadInitThenMultiStart', both in:
- Documentation Forum
- Programmer's Guide.
(I have already booked the locations of this new part!)

Too bad. I had started adding a lot in my last post (on 'ThreadInitThenMultiStart') of documentation forum, topic "How to Manage a Critical Section of the code of a Thread in FB", but deleted everything thinking 'ThreadPooling' was unworkable!

This addition is recent:
- starting : since 14 Feb 2021
- deleting : about 16 Feb 2021, 10:45 UTC

[Lost Zergling]

I don't have it, I wasn't following '"How to Manage a Critical Section of the code of a Thread in FB". I am very sorry and I hope not to have indirectly contributed to prejudice your work, in any case, there was no will on my part in this direction. This kind of disappointment happened to me once (on a non-computer forum, but an interesting and complex post that was more than a day of thinking and shaping nonetheless), and it was hard to accept. I had contacted the administrator of the forum to try to retrieve the message, in vain. In the end, I had to do it all again, at least as well, it was difficult and upsetting, but I felt better afterwards.

[fxm]

No problem for me.
I can quickly add 'ThreadPooling' to my documentation post, even starting from scratch because everything is in my head.
I just have to start!

[edit]
In progress...

[fxm]

As soon as I have a bit of time (soon, no doubt!), I will also document this new 'ThreadPooling' following 'ThreadInitThenMultiStart', both in:
- Documentation Forum
- Programmer's Guide.
(I have already booked the locations of this new part!)

Done.

[deltarho[1859]]

@fxm

In your "Full code with the 'ThreadInitThenMultiStart' and 'ThreadPooling' Types:" gcc -O2 and -O3 will 'rip out'

Code: Select all

For J As Integer = 1 To 73000000
Next J

To avoid that use less than -O2 or gas.

Alternatively with 32-bit and gcc use: (Tip from srvaldez some time ago)

Code: Select all

For J As Integer = 1 To 73000000
  Asm nop
Next J

[fxm]

Thank you.

I put instead:

Code: Select all

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

[fxm]

Warning when using dynamic instances of ThreadInitThenMultiStart or ThreadPooling

When using dynamic instances of these types, their addresses should not be changed during their lifetimes, due to the associated internal thread that constantly accesses the data members from a pointer passed once to the thread beginning:

• Thus, the use of 'Redim Preserve' or 'Reallocate' on such Type instances is prohibited, otherwise the program crashes.
• One solution is to use dynamic pointers to such Type instances instead, so that the addresses of these pointers can be changed without their values changing.

- Initial example with a static array of ThreadPooling instances (this works):

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

'---------------------------------------------------

Sub Prnt (Byref s As String)
    For I As Integer = 1 To 10
        Print s;
        Sleep 100, 1
    Next I
End Sub

Function UserCode1 (Byval p As Any Ptr) As String
    Prnt("1")
    Return ""
End Function

Function UserCode2 (Byval p As Any Ptr) As String
    Prnt("2")
    Return ""
End Function

Function UserCode3 (Byval p As Any Ptr) As String
    Prnt("3")
    Return ""
End Function

Function UserCode4 (Byval p As Any Ptr) As String
    Prnt("4")
    Return ""
End Function

Function UserCode5 (Byval p As Any Ptr) As String
    Prnt("5")
    Return ""
End Function

Function UserCode6 (Byval p As Any Ptr) As String
    Prnt("6")
    Return ""
End Function

Dim As ThreadPooling t(1 To 3)

t(1).PoolingSubmit(@UserCode1)
t(2).PoolingSubmit(@UserCode2)
t(3).PoolingSubmit(@UserCode3)
t(1).PoolingWait()
t(2).PoolingWait()
t(3).PoolingWait()
Print
Print " Sequence completed"
Print

t(1).PoolingSubmit(@UserCode4)
t(2).PoolingSubmit(@UserCode5)
t(3).PoolingSubmit(@UserCode6)
t(1).PoolingWait()
t(2).PoolingWait()
t(3).PoolingWait()
Print
Print " Sequence completed"
Print

Sleep

- Modified example with reallocation of a dynamic array of ThreadPooling instances (this crashes):

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

'---------------------------------------------------

Sub Prnt (Byref s As String)
    For I As Integer = 1 To 10
        Print s;
        Sleep 100, 1
    Next I
End Sub

Function UserCode1 (Byval p As Any Ptr) As String
    Prnt("1")
    Return ""
End Function

Function UserCode2 (Byval p As Any Ptr) As String
    Prnt("2")
    Return ""
End Function

Function UserCode3 (Byval p As Any Ptr) As String
    Prnt("3")
    Return ""
End Function

Function UserCode4 (Byval p As Any Ptr) As String
    Prnt("4")
    Return ""
End Function

Function UserCode5 (Byval p As Any Ptr) As String
    Prnt("5")
    Return ""
End Function

Function UserCode6 (Byval p As Any Ptr) As String
    Prnt("6")
    Return ""
End Function

Dim As ThreadPooling t(Any)

Redim Preserve t(1 To 1)
t(1).PoolingSubmit(@UserCode1)
Redim Preserve t(1 To 2)
t(2).PoolingSubmit(@UserCode2)
Redim Preserve t(1 To 3)
t(3).PoolingSubmit(@UserCode3)
t(1).PoolingWait()
t(2).PoolingWait()
t(3).PoolingWait()
Print
Print " Sequence completed"
Print

t(1).PoolingSubmit(@UserCode4)
t(2).PoolingSubmit(@UserCode5)
t(3).PoolingSubmit(@UserCode6)
t(1).PoolingWait()
t(2).PoolingWait()
t(3).PoolingWait()
Print
Print " Sequence completed"
Print

Sleep

- Corrected example with reallocation of a dynamic array of pointers to ThreadPooling instances (this works):

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

'---------------------------------------------------

Sub Prnt (Byref s As String)
    For I As Integer = 1 To 10
        Print s;
        Sleep 100, 1
    Next I
End Sub

Function UserCode1 (Byval p As Any Ptr) As String
    Prnt("1")
    Return ""
End Function

Function UserCode2 (Byval p As Any Ptr) As String
    Prnt("2")
    Return ""
End Function

Function UserCode3 (Byval p As Any Ptr) As String
    Prnt("3")
    Return ""
End Function

Function UserCode4 (Byval p As Any Ptr) As String
    Prnt("4")
    Return ""
End Function

Function UserCode5 (Byval p As Any Ptr) As String
    Prnt("5")
    Return ""
End Function

Function UserCode6 (Byval p As Any Ptr) As String
    Prnt("6")
    Return ""
End Function

Dim As ThreadPooling Ptr pt(Any)

Redim Preserve pt(1 To 1)
pt(1) = New ThreadPooling
pt(1)->PoolingSubmit(@UserCode1)
Redim Preserve pt(1 To 2)
pt(2) = New ThreadPooling
pt(2)->PoolingSubmit(@UserCode2)
Redim Preserve pt(1 To 3)
pt(3) = new ThreadPooling
pt(3)->PoolingSubmit(@UserCode3)
pt(1)->PoolingWait()
pt(2)->PoolingWait()
pt(3)->PoolingWait()
Print
Print " Sequence completed"
Print

pt(1)->PoolingSubmit(@UserCode4)
pt(2)->PoolingSubmit(@UserCode5)
pt(3)->PoolingSubmit(@UserCode6)
pt(1)->PoolingWait()
pt(2)->PoolingWait()
pt(3)->PoolingWait()
Print
Print " Sequence completed"
Print

Delete pt(1)
Delete pt(2)
Delete pt(3)

Sleep

[fxm]

ThreadDispatching Type, over-structure of ThreadPooling Type, dispatching user thread procedures over a given max number of secondary threads

The maximum number of secondary threads that can be used is fixed when constructing the 'ThreadDispatching' instance (1 secondary thread by default), and also the minimum number of initialized secondary threads (0 secondary thread by default).
'ThreadDispatching' manages an internal dynamic array of pointers to 'ThreadPooling' instances.

If a secondary thread is available (already existing instance of 'ThreadPooling' pending), it is used to submit the user thread procedure.
Otherwise, a new secondary thread is created (new instance of 'ThreadPooling' created) by respecting the number of secondary threads allowed.
As long as all potential secondary threads are already in use, each new user thread procedure is distributed evenly over them.

Methods:

• Constructor : Construct a 'ThreadDispatching' instance and set themaximum number of usable secondary threads (1 by default) and set the minimum number of initialized secondary thread (0 by default).
  DispatchingSubmit : Enter a user thread procedure in the queue of the "best" secondary thread among the usable ones.
  DispatchingWait : Wait for the complete emptying of the queues of all secondary threads used (with all last user procedures executed).
  DispatchingThread : Return the number of internal threads really started.
  
  In the 'ThreadDispatching' Type, an additional sub 'DispatchingState(state() As Ubyte)' is available to returns (in a Ubyte array) the current state of each internal thread started.

Example of use of 'ThreadDispatching' (whatever the allowed number of secondary threads, the submission sequence syntax is always the same):

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

'---------------------------------------------------

Sub Prnt (Byref s As String, Byval p As Any Ptr)
    Dim As String Ptr ps = p
    If ps > 0 Then Print *ps;
    For I As Integer = 1 To 10
        Print s;
        Sleep 100, 1
    Next I
End Sub

Function UserCode1 (Byval p As Any Ptr) As String
    Prnt("1", p)
    Return "UserCode #1"
End Function

Function UserCode2 (Byval p As Any Ptr) As String
    Prnt("2", p)
    Return "UserCode #2"
End Function

Function UserCode3 (Byval p As Any Ptr) As String
    Prnt("3", p)
    Return "UserCode #3"
End Function

Function UserCode4 (Byval p As Any Ptr) As String
    Prnt("4", p)
    Return "UserCode #4"
End Function

Function UserCode5 (Byval p As Any Ptr) As String
    Prnt("5", p)
    Return "UserCode #5"
End Function

Function UserCode6 (Byval p As Any Ptr) As String
    Prnt("6", p)
    Return "UserCode #6"
End Function

Sub SubmitSequence(Byref t As ThreadDispatching, Byval ps As String Ptr)
    t.DispatchingSubmit(@UserCode1, ps)
    t.DispatchingSubmit(@UserCode2)
    t.DispatchingSubmit(@UserCode3)
    t.DispatchingSubmit(@UserCode4)
    t.DispatchingSubmit(@UserCode5)
    t.DispatchingSubmit(@UserCode6)
End Sub    

Dim As String sa = "  Sequence #a: "
Dim As String sb = "  Sequence #b: "
Dim As String sc = "  Sequence #c: "
Dim As String sd = "  Sequence #d: "
Dim As String se = "  Sequence #e: "
Dim As String sf = "  Sequence #f: "
Dim As String s()

Dim As ThreadDispatching t1, t2 = 2, t3 = 3, t4 = 4, t5 = 5, t6 = 6

Print " Sequence #a of 6 user thread functions dispatched over 1 secondary thread:"
SubmitSequence(t1, @sa)
t1.DispatchingWait()
Print
Print

Print " Sequence #b of 6 user thread functions dispatched over 2 secondary threads:"
SubmitSequence(t2, @sb)
t2.DispatchingWait()
Print
Print

Print " Sequence #c of 6 user thread functions dispatched over 3 secondary threads:"
SubmitSequence(t3, @sc)
t3.DispatchingWait()
Print
Print

Print " Sequence #d of 6 user thread functions dispatched over 4 secondary threads:"
SubmitSequence(t4, @sd)
t4.DispatchingWait()
Print
Print

Print " Sequence #e of 6 user thread functions dispatched over 5 secondary threads:"
SubmitSequence(t5, @se)
t5.DispatchingWait()
Print
Print

Print " Sequence #f of 6 user thread functions dispatched over 6 secondary threads:"
SubmitSequence(t6, @sf)
t6.DispatchingWait(s())
Print

Print "  List of returned values from sequence #f:"
For I As Integer = Lbound(s) To Ubound(s)
    Print "   " & I & ": " & s(I)
Next I

Sleep

Code: Select all

 Sequence #a of 6 user thread functions dispatched over 1 secondary thread:
  Sequence #a: 111111111122222222223333333333444444444455555555556666666666

 Sequence #b of 6 user thread functions dispatched over 2 secondary threads:
  Sequence #b: 122112121212122112213434344343344343344356566565565656565665

 Sequence #c of 6 user thread functions dispatched over 3 secondary threads:
  Sequence #c: 123123312321213132321231213321465654546465546546456654654564

 Sequence #d of 6 user thread functions dispatched over 4 secondary threads:
  Sequence #d: 134243211234432114322341413241233124413256655656566556655656

 Sequence #e of 6 user thread functions dispatched over 5 secondary threads:
  Sequence #e: 134255243141235325415143215234342511524343521251346666666666

 Sequence #f of 6 user thread functions dispatched over 6 secondary threads:
  Sequence #f: 534126216354456132241365563142421365316524245613361245365421
  List of returned values from sequence #f:
   1: UserCode #1
   2: UserCode #2
   3: UserCode #3
   4: UserCode #4
   5: UserCode #5
   6: UserCode #6

[12val12newakk]

tell me how to parallelize iterative calculation?
the race of threads and the resulting error within one iteration (dt) is insignificant
how to make global array elements visible to all threads ?
pseudocode

Code: Select all

sub Lannard_1  (Byval n_begin As long ,Byval n_end As long )
rem datalist  input  output from sub     
rem  global   x () : global   y ()       (float32)
rem  global  vx () : global vy ()         (float32)
rem  global  MATERIAL()
rem  global    Num_neighbour  (n,NM)  '(global element number,neighbor number)   global number for neighbor
rem  global    Total_neighbour_n (n)  (element number)  amount neighbor  for (element number)
         dim as single  RCPRglue 
         dim as single dyR,dxR
         dim as single   ay,ax
         dim as single   Ri6
         dim as single   Koef_AC
     for n=n_begin to  n_end      '      Nmass-1
            for NM = 0  to  Total_neighbour_n (n)    ' 0- 5  for hexa 
						  m = Num_neighbour  (n,NM)  
					   dim as single          dx=x(m)-x(n)
					   dim as single          dy=y(m)-y(n)
					   dim as single         Rgquadro=(dx*dx+dy*dy)
					   dim as single         Rglue=sqr(Rgquadro)
					   if (rglue >Base_size*1.65) then  lost_cont=1
							  dim as single       df             
									'LannJones aproxx 
								 Ri6 =(Rgquadro*Rgquadro)*(Rgquadro *0.00000000025)     rem radius 40
								 df=(1/Ri6)-(1/(Ri6*Ri6))                                                                                
							fy(n)=fy(n)+df*dy  :  fx(n)=fx(n)+df*dx     'Force  accumulator     
						 next NM  
         next n 
         for n=n_begin to n_end    
                     ay=fy(n)/mass
                     ax=fx(n)/mass  
                     vy(n)=vy(n)+ay*dt :   fy(n)=0 : ' Velocity accumulator    
                     vx(n)=vx(n)+ax*dt :   fx(n)=0 :   'Velocity accumulator    
                     y(n)=vy(n)*dt+ y(n)           
                     x(n)=vx(n)*dt+ x(n) 
                      vy(n)=vy(n)-vy(n)*900*dt      rem  dampfer
                      vx(n)=vx(n)-vx(n)*900*dt      rem  dampfer               
         next n          
end sub
'===========

pseudo main


Nmass=16383
x(Nmass) :y(Nmass)vx(Nmass) :vy(Nmass)
MATERIAL(Nmass)
dt =1e-8
a1=  Nmass/4
a2=2*Nmass/4
a3=3*Nmass/4

'  inicial geometry hexa


Do
if (lost_cont) then  Recal_neighbour()
   'call in parralel ??
		Lannard_1(0,a1)
		Lannard_1(a1+1,a2)
		Lannard_1(a2+1,a3)
		Lannard_1(a3+1,Nmass)
   'waiting for a lagging thread  ??

' event  
fixing 
' visualisation

loop

[fxm]

tell me how to parallelize iterative calculation?

Example for initializing an array of 5000000 elements (from index 0 to index 4999999) :

• Simple code using the main thread only:

  • Code: Select all

    Dim Shared As Integer array() 
    
    Sub init_array(Byval min As Integer, Byval max As Integer)
        For I As Integer = min To max
            array(I) = I
        Next I
    End Sub
    
    Redim array(0 To 4999999)
    
    '--------------------
    
    Dim As Double t = Timer
    
    init_array(0, 4999999)
    
    t = Timer - t
    
    '--------------------
    
    For I As Integer = 0 To 9
        Print array(I)
    Next I
    Print " ....."
    For I As Integer = 4999990 To 4999999
        Print array(I)
    Next I
    
    Print
    Print t & " seconds"
    
    Sleep
    

• Advanced code using 5 secondary threads (1000000 initializations per secondary thread):

  • Code: Select all

    Dim Shared As Integer array() 
    
    Sub init_array(Byval min As Integer, Byval max As Integer)
        For I As Integer = min To max
            array(I) = I
        Next I
    End Sub
    
    Redim array(0 To 4999999)
    
    '--------------------
    
    Type min_max
        As Integer min
        As Integer max
    End Type
    
    Sub thread(Byval p As Any Ptr)
        Dim As min_max Ptr p_min_max = p
        init_array(p_min_max->min, p_min_max->max)
    End Sub
    
    Dim As Any Ptr p_thread(0 To 4)
    Dim As min_max m(0 To 4) = {(0, 999999), (1000000, 1999999), (2000000, 2999999), (3000000, 3999999), (4000000, 4999999)}
    
    Dim As Double t = Timer
    
    For I As Integer = 0 To 4
        p_thread(I) = Threadcreate(@thread, @m(I))
    Next I
    For I As Integer = 0 To 4
        Threadwait(p_thread(I))
    Next I
    
    t = Timer - t
        
    '--------------------
    
    For I As Integer = 0 To 9
        Print array(I)
    Next I
    Print " ....."
    For I As Integer = 4999990 To 4999999
        Print array(I)
    Next I
    
    Print
    Print t & " seconds"
    
    Sleep
    

    Final advanced code grouping 'thread()' and 'init_array()' procedures into a single 'thread_init_array()' procedure:

    Code: Select all

    Dim Shared As Integer array() 
    
    Type min_max
        As Integer min
        As Integer max
    End Type
    
    Sub thread_init_array(Byval p As Any Ptr)
        Dim As min_max Ptr p_min_max = p
        For I As Integer = p_min_max->min To p_min_max->max
            array(I) = I
        Next I
    End Sub
    
    Redim array(0 To 4999999)
    
    Dim As Any Ptr p_thread(0 To 4)
    Dim As min_max m(0 To 4) = {(0, 999999), (1000000, 1999999), (2000000, 2999999), (3000000, 3999999), (4000000, 4999999)}
    
    '--------------------
    
    Dim As Double t = Timer
    
    For I As Integer = 0 To 4
        p_thread(I) = Threadcreate(@thread_init_array, @m(I))
    Next I
    For I As Integer = 0 To 4
        Threadwait(p_thread(I))
    Next I
    
    t = Timer - t
    
    '--------------------
    
    For I As Integer = 0 To 9
        Print array(I)
    Next I
    Print " ....."
    For I As Integer = 4999990 To 4999999
        Print array(I)
    Next I
    
    Print
    Print t & " seconds"
    
    Sleep