wth -- Thread time .vs Subroutine time

[fxm]

About the update of the 'ThreadDispatching' Type (addition of a second optional parameter to the constructor).

See (for description and code):
- viewtopic.php?p=280695#p280695
- viewtopic.php?p=279512#p279512
- 'Programmer's Guide' (in 'Critical Sections FAQ' article): 13. Can we emulate a kind of thread pooling feature with FreeBASIC?

I added a second optional parameter to the 'ThreadDispatching' Type constructor in addition to the maximum number of usable secondary threads (1 secondary thread by default).
This second parameter allows to set the minimum number of initialized secondary threads (0 secondary thread by default).
As this second parameter is optional (as is the first), there is full compatibility with any user code prior to this change.

This second parameter makes it possible to impose a minimum number of secondary threads initialized as soon as the 'ThreadDispatching' instance is constructed and therefore immediately ready for user task submission (real-time improvement for starting user task).

Therefore, the number of secondary threads used is always between the minimum value and the maximum value, both fixed at the construction time.
Secondary threads that become pending are never stopped and therefore the number of secondary threads used can only increase over the lifetime of the 'ThreadDispatching' instance.

Example:

Code: Select all

#include once "crt/string.bi"
Type ThreadPooling
    Public:
        Declare Constructor()
        Declare Sub PoolingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
        Declare Sub PoolingWait()
        Declare Sub PoolingWait(values() As String)
        
        Declare Property PoolingState() As UByte
        
        Declare Destructor()
    Private:
        Dim As Function(ByVal p As Any Ptr) As String _pThread0
        Dim As Any Ptr _p0
        Dim As Function(ByVal p As Any Ptr) As String _pThread(Any)
        Dim As Any Ptr _p(Any)
        Dim As Any Ptr _mutex
        Dim As Any Ptr _cond1
        Dim As Any Ptr _cond2
        Dim As Any Ptr _pt
        Dim As Byte _end
        Dim As String _returnF(Any)
        Dim As UByte _state
        Declare Static Sub _Thread(ByVal p As Any Ptr)
End Type

Constructor ThreadPooling()
    ReDim This._pThread(0)
    ReDim This._p(0)
    ReDim This._returnF(0)
    This._mutex = MutexCreate()
    This._cond1 = CondCreate()
    This._cond2 = CondCreate()
    This._pt= ThreadCreate(@ThreadPooling._Thread, @This)
End Constructor

Sub ThreadPooling.PoolingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
    MutexLock(This._mutex)
    ReDim Preserve This._pThread(UBound(This._pThread) + 1)
    This._pThread(UBound(This._pThread)) = pThread
    ReDim Preserve This._p(UBound(This._p) + 1)
    This._p(UBound(This._p)) = p
    CondSignal(This._cond2)
    This._state = 1
    MutexUnlock(This._mutex)
End Sub

Sub ThreadPooling.PoolingWait()
    MutexLock(This._mutex)
    While (This._state And 11) > 0
        CondWait(This._Cond1, This._mutex)
    Wend
    ReDim This._returnF(0)
    This._state = 0
    MutexUnlock(This._mutex)
End Sub

Sub ThreadPooling.PoolingWait(values() As String)
    MutexLock(This._mutex)
    While (This._state And 11) > 0
        CondWait(This._Cond1, This._mutex)
    Wend
    If UBound(This._returnF) > 0 Then
        ReDim values(1 To UBound(This._returnF))
        For I As Integer = 1 To UBound(This._returnF)
            values(I) = This._returnF(I)
        Next I
        ReDim This._returnF(0)
    Else
        Erase values
    End If
    This._state = 0
    MutexUnlock(This._mutex)
End Sub

Property ThreadPooling.PoolingState() As UByte
    If UBound(This._p) > 0 Then
        Return 8 + This._state
    Else
        Return This._state
    End If
End Property

Sub ThreadPooling._Thread(ByVal p As Any Ptr)
    Dim As ThreadPooling Ptr pThis = p
    Do
        MutexLock(pThis->_mutex)
        If UBound(pThis->_pThread) = 0 Then
            pThis->_state = 4
            CondSignal(pThis->_cond1)
            While UBound(pThis->_pThread) = 0
                CondWait(pThis->_cond2, pThis->_mutex)
                If pThis->_end = 1 Then Exit Sub
            Wend
        End If
        pThis->_pThread0 = pThis->_pThread(1)
        pThis->_p0 = pThis->_p(1)
        If UBound(pThis->_pThread) > 1 Then
            memmove(@pThis->_pThread(1), @pThis->_pThread(2), (UBound(pThis->_pThread) - 1) * SizeOf(pThis->_pThread))
            memmove(@pThis->_p(1), @pThis->_p(2), (UBound(pThis->_p) - 1) * SizeOf(pThis->_p))
        End If
        ReDim Preserve pThis->_pThread(UBound(pThis->_pThread) - 1)
        ReDim Preserve pThis->_p(UBound(pThis->_p) - 1)
        MutexUnlock(pThis->_mutex)
        ReDim Preserve pThis->_ReturnF(UBound(pThis->_returnF) + 1)
        pThis->_state = 2
        pThis->_returnF(UBound(pThis->_returnF)) = pThis->_pThread0(pThis->_p0)
    Loop
End Sub

Destructor ThreadPooling()
    MutexLock(This._mutex)
    This._end = 1
    CondSignal(This._cond2)
    MutexUnlock(This._mutex)
    .ThreadWait(This._pt)
    MutexDestroy(This._mutex)
    CondDestroy(This._cond1)
    CondDestroy(This._cond2)
End Destructor

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

Type ThreadDispatching
    Public:
        Declare Constructor(ByVal nbMaxSecondaryThread As Integer = 1, ByVal nbMinSecondaryThread As Integer = 0)
        Declare Sub DispatchingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
        Declare Sub DispatchingWait()
        Declare Sub DispatchingWait(values() As String)
        
        Declare Property DispatchingThread() As Integer
        Declare Sub DispatchingState(state() As Ubyte)
        
        Declare Destructor()
    Private:
        Dim As Integer _nbmst
        Dim As Integer _dstnb
        Dim As ThreadPooling Ptr _tp(Any)
End Type

Constructor ThreadDispatching(ByVal nbMaxSecondaryThread As Integer = 1, ByVal nbMinSecondaryThread As Integer = 0)
    This._nbmst = nbMaxSecondaryThread
    If nbMinSecondaryThread > nbMaxSecondaryThread Then
        nbMinSecondaryThread = nbMaxSecondaryThread
    End If
    If nbMinSecondaryThread > 0 Then
        ReDim This._tp(nbMinSecondaryThread - 1)
        For I As Integer = 0 To nbMinSecondaryThread - 1
            This._tp(I) = New ThreadPooling
        Next I
    End If
End Constructor

Sub ThreadDispatching.DispatchingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
    For I As Integer = 0 To UBound(This._tp)
        If (This._tp(I)->PoolingState And 3) = 0 Then
            This._tp(I)->PoolingSubmit(pThread, p)
            Exit Sub
        End If
    Next I
    If UBound(This._tp) < This._nbmst - 1 Then
        ReDim Preserve This._tp(UBound(This._tp) + 1)
        This._tp(UBound(This._tp)) = New ThreadPooling
        This._tp(UBound(This._tp))->PoolingSubmit(pThread, p)
    ElseIf UBound(This._tp) >= 0 Then
        This._tp(This._dstnb)->PoolingSubmit(pThread, p)
        This._dstnb = (This._dstnb + 1) Mod This._nbmst
    End If
End Sub

Sub ThreadDispatching.DispatchingWait()
    For I As Integer = 0 To UBound(This._tp)
        This._tp(I)->PoolingWait()
    Next I
End Sub

Sub ThreadDispatching.DispatchingWait(values() As String)
    Dim As String s()
    For I As Integer = 0 To UBound(This._tp)
        This._tp(I)->PoolingWait(s())
        If UBound(s) >= 1 Then
            If UBound(values) = -1 Then
                ReDim Preserve values(1 To UBound(values) + UBound(s) + 1)
            Else
                ReDim Preserve values(1 To UBound(values) + UBound(s))
            End If
            For I As Integer = 1 To UBound(s)
                values(UBound(values) - UBound(s) + I) = s(I)
            Next I
        End If
    Next I
End Sub

Property ThreadDispatching.DispatchingThread() As Integer
    Return UBound(This._tp) + 1
End Property

Sub ThreadDispatching.DispatchingState(state() As Ubyte)
    If UBound(This._tp) >= 0 Then
        Redim state(1 To UBound(This._tp) + 1)
        For I As Integer = 0 To UBound(This._tp)
            state(I + 1) = This._tp(I)->PoolingState
        Next I
    End If
End Sub

Destructor ThreadDispatching()
    For I As Integer = 0 To UBound(This._tp)
        Delete This._tp(I)
    Next I
End Destructor

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

Dim Shared As Double array(1 To 800000)  '' only used by the [For...Next] waiting loop in UserCode()

Function UserCode (ByVal p As Any Ptr) As String
    Dim As String Ptr ps = p
    For I As Integer = 1 To 2
        Print *ps;
        For J As Integer = 1 To 800000
            array(J) = Tan(J) * Atn(J) * Exp(J) * Log(J)  '' [For...Next] waiting loop not freeing any CPU resource
        Next J
    Next I
    Return ""
End Function

Dim As String s(0 To 31)
For I As Integer = 0 To 15
    s(I) = Str(Hex(I))
Next I
For I As Integer = 16 To 31
    s(I) = Chr(55 + I)
Next I

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

Scope
    For I As Integer = 1 To 16
        Print "'ThreadDispatching' with " & I & "/" & I Shr 2 & " (maximum/minimum) secondary threads:"
        Dim As ThreadDispatching td = ThreadDispatching(I, I Shr 2)
        Print "  Number of secondary threads at start : " & td.DispatchingThread
        Dim As Double t = Timer
        Print "    ";
        For I As Integer = 0 To 31
            td.DispatchingSubmit(@UserCode, @s(I))
        Next I
        td.DispatchingWait()
        t = Timer - t
        Print Using " :####.## s"; t
        Print "  Number of secondary threads at end : " & td.DispatchingThread
        Print
    Next I
End Scope

Sleep

Code: Select all

'ThreadDispatching' with 1/0 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 0
    00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVV :   5.35 s
  Number of secondary threads at end : 1

'ThreadDispatching' with 2/0 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 0
    01012323454567678989ABABCDCDEFEFGHGHIJIJKLKLMNMNOPOPQRQRSTSTUVUV :   2.74 s
  Number of secondary threads at end : 2

'ThreadDispatching' with 3/0 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 0
    012120453453786786BA9BA9EDCECDHFGHFGKIJKJINMLNMLQPOQPOTSRTSRVUVU :   2.01 s
  Number of secondary threads at end : 3

'ThreadDispatching' with 4/1 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 1
    012332107564657498AB98BACDFECDFEGHJIGJHIKLNMKLNMOPQRORPQVSTUVTSU :   1.46 s
  Number of secondary threads at end : 4

'ThreadDispatching' with 5/1 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 1
    01234120347689579685BEACDCAEBDFHJGIFHJGIKMOLNKMOLNPRTQSPRQTSUVUV :   1.28 s
  Number of secondary threads at end : 5

'ThreadDispatching' with 6/1 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 1
    0132453042519A678B96A7B8FCGEDHFCGDEHLIMKJNLIMKJNROQSPTROQSPTUVVU :   1.24 s
  Number of secondary threads at end : 6

'ThreadDispatching' with 7/1 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 1
    01254360452316C7B9A8D7BC9A8DIEJGHFKIGEJHFKNPLQMORNPMLQORUTVSUTVS :   1.14 s
  Number of secondary threads at end : 7

'ThreadDispatching' with 8/2 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 2
    01234567156320479DBE8ACF9DCBAFE8HLKJINMGHLKJINGMPRSTVQOUPSRTVQUO :   1.03 s
  Number of secondary threads at end : 8

'ThreadDispatching' with 9/2 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 2
    132045678413762580BGAEHD9FCEGDHAF9BCNPJMQIOKLNPMIJOQKLVRSTUVRSTU :   1.11 s
  Number of secondary threads at end : 9

'ThreadDispatching' with 10/2 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 2
    01234567899657481023FGJHEBAIDCFGBHAEJDICLPQKRTNOPSMQLRNTKOSMVUVU :   1.12 s
  Number of secondary threads at end : 10

'ThreadDispatching' with 11/2 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 2
    0123546789A90178243A56CJFGKEDBILHCJGFKBEDHLINRUMQPVSOTNRMUPVSQTO :   1.07 s
  Number of secondary threads at end : 11

'ThreadDispatching' with 12/3 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 3
    0123456789AB0287354961BKCEAGHFJILDNKCGMJEIHNDFLSOQTMUPVSROQTPUVR :   1.02 s
  Number of secondary threads at end : 12

'ThreadDispatching' with 13/3 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 3
    0123456789ABC8729635104CBAFJMLIEGKFOPDHNJMISKLOEGNDHPSVRTVQURTQU :   1.09 s
  Number of secondary threads at end : 13

'ThreadDispatching' with 14/3 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 3
    1023546789ABCD9B1A4357028C6DNPFLOGMEIJKRHQGLOMPFNKHJIERQUTVSUTVS :   1.11 s
  Number of secondary threads at end : 14

'ThreadDispatching' with 15/3 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 3
    012345678BA9CDE0A9B5D7148C236ESMFQPOGKNJIHTQLRMSPFKJGONHLRTIUVUV :   1.11 s
  Number of secondary threads at end : 15

'ThreadDispatching' with 16/4 (maximum/minimum) secondary threads:
  Number of secondary threads at start : 4
    0123456789ABDEFC9D203EA5861B47FUICTPJGMHKOLRQVNGPUJSTIRQMLHKONVS :   1.06 s
  Number of secondary threads at end : 16

[fxm]

Other example:
- 36 user tasks submitted with a slight lag between them,
- maximum number of secondary threads from 1 to 16,
- minimum number of secondary threads = 0.

The actual number of secondary threads used in total is not necessarily equal to the maximum number of secondary threads allowed (although 36 > 16), because when a secondary thread already in use becomes pending again, another user task may be then submitted instead of start a new secondary thread:

Code: Select all

#include once "crt/string.bi"
Type ThreadPooling
    Public:
        Declare Constructor()
        Declare Sub PoolingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
        Declare Sub PoolingWait()
        Declare Sub PoolingWait(values() As String)
        
        Declare Property PoolingState() As UByte
        
        Declare Destructor()
    Private:
        Dim As Function(ByVal p As Any Ptr) As String _pThread0
        Dim As Any Ptr _p0
        Dim As Function(ByVal p As Any Ptr) As String _pThread(Any)
        Dim As Any Ptr _p(Any)
        Dim As Any Ptr _mutex
        Dim As Any Ptr _cond1
        Dim As Any Ptr _cond2
        Dim As Any Ptr _pt
        Dim As Byte _end
        Dim As String _returnF(Any)
        Dim As UByte _state
        Declare Static Sub _Thread(ByVal p As Any Ptr)
End Type

Constructor ThreadPooling()
    ReDim This._pThread(0)
    ReDim This._p(0)
    ReDim This._returnF(0)
    This._mutex = MutexCreate()
    This._cond1 = CondCreate()
    This._cond2 = CondCreate()
    This._pt= ThreadCreate(@ThreadPooling._Thread, @This)
End Constructor

Sub ThreadPooling.PoolingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
    MutexLock(This._mutex)
    ReDim Preserve This._pThread(UBound(This._pThread) + 1)
    This._pThread(UBound(This._pThread)) = pThread
    ReDim Preserve This._p(UBound(This._p) + 1)
    This._p(UBound(This._p)) = p
    CondSignal(This._cond2)
    This._state = 1
    MutexUnlock(This._mutex)
End Sub

Sub ThreadPooling.PoolingWait()
    MutexLock(This._mutex)
    While (This._state And 11) > 0
        CondWait(This._Cond1, This._mutex)
    Wend
    ReDim This._returnF(0)
    This._state = 0
    MutexUnlock(This._mutex)
End Sub

Sub ThreadPooling.PoolingWait(values() As String)
    MutexLock(This._mutex)
    While (This._state And 11) > 0
        CondWait(This._Cond1, This._mutex)
    Wend
    If UBound(This._returnF) > 0 Then
        ReDim values(1 To UBound(This._returnF))
        For I As Integer = 1 To UBound(This._returnF)
            values(I) = This._returnF(I)
        Next I
        ReDim This._returnF(0)
    Else
        Erase values
    End If
    This._state = 0
    MutexUnlock(This._mutex)
End Sub

Property ThreadPooling.PoolingState() As UByte
    If UBound(This._p) > 0 Then
        Return 8 + This._state
    Else
        Return This._state
    End If
End Property

Sub ThreadPooling._Thread(ByVal p As Any Ptr)
    Dim As ThreadPooling Ptr pThis = p
    Do
        MutexLock(pThis->_mutex)
        If UBound(pThis->_pThread) = 0 Then
            pThis->_state = 4
            CondSignal(pThis->_cond1)
            While UBound(pThis->_pThread) = 0
                CondWait(pThis->_cond2, pThis->_mutex)
                If pThis->_end = 1 Then Exit Sub
            Wend
        End If
        pThis->_pThread0 = pThis->_pThread(1)
        pThis->_p0 = pThis->_p(1)
        If UBound(pThis->_pThread) > 1 Then
            memmove(@pThis->_pThread(1), @pThis->_pThread(2), (UBound(pThis->_pThread) - 1) * SizeOf(pThis->_pThread))
            memmove(@pThis->_p(1), @pThis->_p(2), (UBound(pThis->_p) - 1) * SizeOf(pThis->_p))
        End If
        ReDim Preserve pThis->_pThread(UBound(pThis->_pThread) - 1)
        ReDim Preserve pThis->_p(UBound(pThis->_p) - 1)
        MutexUnlock(pThis->_mutex)
        ReDim Preserve pThis->_ReturnF(UBound(pThis->_returnF) + 1)
        pThis->_state = 2
        pThis->_returnF(UBound(pThis->_returnF)) = pThis->_pThread0(pThis->_p0)
    Loop
End Sub

Destructor ThreadPooling()
    MutexLock(This._mutex)
    This._end = 1
    CondSignal(This._cond2)
    MutexUnlock(This._mutex)
    .ThreadWait(This._pt)
    MutexDestroy(This._mutex)
    CondDestroy(This._cond1)
    CondDestroy(This._cond2)
End Destructor

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

Type ThreadDispatching
    Public:
        Declare Constructor(ByVal nbMaxSecondaryThread As Integer = 1, ByVal nbMinSecondaryThread As Integer = 0)
        Declare Sub DispatchingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
        Declare Sub DispatchingWait()
        Declare Sub DispatchingWait(values() As String)
        
        Declare Property DispatchingThread() As Integer
        Declare Sub DispatchingState(state() As Ubyte)
        
        Declare Destructor()
    Private:
        Dim As Integer _nbmst
        Dim As Integer _dstnb
        Dim As ThreadPooling Ptr _tp(Any)
End Type

Constructor ThreadDispatching(ByVal nbMaxSecondaryThread As Integer = 1, ByVal nbMinSecondaryThread As Integer = 0)
    This._nbmst = nbMaxSecondaryThread
    If nbMinSecondaryThread > nbMaxSecondaryThread Then
        nbMinSecondaryThread = nbMaxSecondaryThread
    End If
    If nbMinSecondaryThread > 0 Then
        ReDim This._tp(nbMinSecondaryThread - 1)
        For I As Integer = 0 To nbMinSecondaryThread - 1
            This._tp(I) = New ThreadPooling
        Next I
    End If
End Constructor

Sub ThreadDispatching.DispatchingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
    For I As Integer = 0 To UBound(This._tp)
        If (This._tp(I)->PoolingState And 3) = 0 Then
            This._tp(I)->PoolingSubmit(pThread, p)
            Exit Sub
        End If
    Next I
    If UBound(This._tp) < This._nbmst - 1 Then
        ReDim Preserve This._tp(UBound(This._tp) + 1)
        This._tp(UBound(This._tp)) = New ThreadPooling
        This._tp(UBound(This._tp))->PoolingSubmit(pThread, p)
    ElseIf UBound(This._tp) >= 0 Then
        This._tp(This._dstnb)->PoolingSubmit(pThread, p)
        This._dstnb = (This._dstnb + 1) Mod This._nbmst
    End If
End Sub

Sub ThreadDispatching.DispatchingWait()
    For I As Integer = 0 To UBound(This._tp)
        This._tp(I)->PoolingWait()
    Next I
End Sub

Sub ThreadDispatching.DispatchingWait(values() As String)
    Dim As String s()
    For I As Integer = 0 To UBound(This._tp)
        This._tp(I)->PoolingWait(s())
        If UBound(s) >= 1 Then
            If UBound(values) = -1 Then
                ReDim Preserve values(1 To UBound(values) + UBound(s) + 1)
            Else
                ReDim Preserve values(1 To UBound(values) + UBound(s))
            End If
            For I As Integer = 1 To UBound(s)
                values(UBound(values) - UBound(s) + I) = s(I)
            Next I
        End If
    Next I
End Sub

Property ThreadDispatching.DispatchingThread() As Integer
    Return UBound(This._tp) + 1
End Property

Sub ThreadDispatching.DispatchingState(state() As Ubyte)
    If UBound(This._tp) >= 0 Then
        Redim state(1 To UBound(This._tp) + 1)
        For I As Integer = 0 To UBound(This._tp)
            state(I + 1) = This._tp(I)->PoolingState
        Next I
    End If
End Sub

Destructor ThreadDispatching()
    For I As Integer = 0 To UBound(This._tp)
        Delete This._tp(I)
    Next I
End Destructor

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

Dim Shared As Double array(1 To 800000)  '' only used by the [For...Next] waiting loop in UserCode()

Function UserCode (ByVal p As Any Ptr) As String
    Dim As String Ptr ps = p
    For I As Integer = 1 To 2
        Print *ps;
        For J As Integer = 1 To 800000
            array(J) = Tan(J) * Atn(J) * Exp(J) * Log(J)  '' [For...Next] waiting loop not freeing any CPU resource
        Next J
    Next I
    Return ""
End Function

Dim As String s(0 To 35)
For I As Integer = 0 To 15
    s(I) = Str(Hex(I))
Next I
For I As Integer = 16 To 35
    s(I) = Chr(55 + I)
Next I

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

Scope
    For I As Integer = 1 To 16
        Print "'ThreadDispatching' with " & I & "/0" & " (maximum/minimum) secondary threads:"
        Dim As ThreadDispatching td = ThreadDispatching(I, 0)
        Print "    ";
        For I As Integer = 0 To 35
            td.DispatchingSubmit(@UserCode, @s(I))
            Sleep 20, 1
        Next I
        td.DispatchingWait()
        Print
        Print "    Number of secondary threads at end : " & td.DispatchingThread
        Print
    Next I
End Scope

Sleep

Code: Select all

'ThreadDispatching' with 1/0 (maximum/minimum) secondary threads:
    00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVVWWXXYYZZ
    Number of secondary threads at end : 1

'ThreadDispatching' with 2/0 (maximum/minimum) secondary threads:
    01012323454567678989ABABCDCDEFEFGHGHIJIJKLKLMNMNOPPORQRQTSTSVUUVWXWXZYZY
    Number of secondary threads at end : 2

'ThreadDispatching' with 3/0 (maximum/minimum) secondary threads:
    0120123453456786789AB9ABCDECDEFGHFGHIJKJIKMLNMLNPOQPQOSTRSTRVWUVWUYZXYZX
    Number of secondary threads at end : 3

'ThreadDispatching' with 4/0 (maximum/minimum) secondary threads:
    012301243564756789AB89ABCDEFCDEFHGIJHGIJLKMNLKMNPOQRPOQRTSUVTSUVWXYZWXYZ
    Number of secondary threads at end : 4

'ThreadDispatching' with 5/0 (maximum/minimum) secondary threads:
    0123041253467895679A8BCAEDBFECDGJFIHGKIJHLKNOMLPONMQPSTRUQTRSVUYXWZVYXWZ
    Number of secondary threads at end : 5

'ThreadDispatching' with 6/0 (maximum/minimum) secondary threads:
    01230415263475869AB7C89ABDCEGFHDIEFGHJIKLMNJOKLMNPOQRSPTUQRSVTUWXYZVWXZY
    Number of secondary threads at end : 6

'ThreadDispatching' with 7/0 (maximum/minimum) secondary threads:
    01230451623745869B7A8CD9BEAFCDGIHEFJKGILHMJKNPLOMQRNPSOTQRUWSVTXYUWZVXYZ
    Number of secondary threads at end : 7

'ThreadDispatching' with 8/0 (maximum/minimum) secondary threads:
    012304516237845A6B7C8DAEFB9CHDGEFI9JHKGLMNIJPKLQMNRSPUOQRVSWXOUTVZWXTYZY
    Number of secondary threads at end : 8

'ThreadDispatching' with 9/0 (maximum/minimum) secondary threads:
    01230415263748596A7BC8D9AEFBGCDHIEFJGKHLIMJNKOPLQMNROSTPUQVRWSXTUYVZWXYZ
    Number of secondary threads at end : 9

'ThreadDispatching' with 10/0 (maximum/minimum) secondary threads:
    0123041526378495A6B7C89DEAFBCGHEIFDJKGLHIMNJKOLPQMNROSTPQURVSWTXUYZVWXYZ
    Number of secondary threads at end : 9

'ThreadDispatching' with 11/0 (maximum/minimum) secondary threads:
    01230451623748596A7BC8D9EAFBCGDHEIJFKGLHIMNJOKLPMQNROSPTQURVSWTXUYVZWXYZ
    Number of secondary threads at end : 9

'ThreadDispatching' with 12/0 (maximum/minimum) secondary threads:
    0123045126734859A67BC89DEAFCBGDHEIFJGKHLMIJNKOPLMQRNSOTPUQRVSWXTUYZVWXYZ
    Number of secondary threads at end : 9

'ThreadDispatching' with 13/0 (maximum/minimum) secondary threads:
    01230415263748956AB78C9DEAFBCGHDEIFJGKLHMINJKOPLMQNROSTPUQVRWSXTYUVZWXYZ
    Number of secondary threads at end : 10

'ThreadDispatching' with 14/0 (maximum/minimum) secondary threads:
    01203415263748956AB7C8D9EAFBGCDHEIJFKGHLMINJKOLPMQNROSPTQURVSWTXUYVZWXYZ
    Number of secondary threads at end : 9

'ThreadDispatching' with 15/0 (maximum/minimum) secondary threads:
    0123041526378495A6B78CD9AEBFGCDHIEJFGKLHMINJKOLPMQRNOSPTQURVSWTXYUZVWXYZ
    Number of secondary threads at end : 9

'ThreadDispatching' with 16/0 (maximum/minimum) secondary threads:
    0123041526378459A6B7C8D9AEBFGCHDEIJFKGLHIMJNKOLPQMRNSOTPUQRVSWTXYUVZWXYZ
    Number of secondary threads at end : 10

A variant that details the state of each secondary thread right after the last user task is submitted (using the 'DispatchingState()' method)
DispatchingState flags:
0 -> User thread procedures sequence execution completed (after 'DispatchingWait' acknowledge or new instance creation)
1 -> Beginning of user thread procedure sequence submitted but no still executing (after first 'DispatchingSubmit')
2 -> User thread procedure running
4 -> User thread procedure sequence execution pending (for 'DispatchingWait' acknowledge or new user thread procedure submission)
8 -> User thread procedure submission queue not empty

Code: Select all

#include once "crt/string.bi"
Type ThreadPooling
    Public:
        Declare Constructor()
        Declare Sub PoolingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
        Declare Sub PoolingWait()
        Declare Sub PoolingWait(values() As String)
        
        Declare Property PoolingState() As UByte
        
        Declare Destructor()
    Private:
        Dim As Function(ByVal p As Any Ptr) As String _pThread0
        Dim As Any Ptr _p0
        Dim As Function(ByVal p As Any Ptr) As String _pThread(Any)
        Dim As Any Ptr _p(Any)
        Dim As Any Ptr _mutex
        Dim As Any Ptr _cond1
        Dim As Any Ptr _cond2
        Dim As Any Ptr _pt
        Dim As Byte _end
        Dim As String _returnF(Any)
        Dim As UByte _state
        Declare Static Sub _Thread(ByVal p As Any Ptr)
End Type

Constructor ThreadPooling()
    ReDim This._pThread(0)
    ReDim This._p(0)
    ReDim This._returnF(0)
    This._mutex = MutexCreate()
    This._cond1 = CondCreate()
    This._cond2 = CondCreate()
    This._pt= ThreadCreate(@ThreadPooling._Thread, @This)
End Constructor

Sub ThreadPooling.PoolingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
    MutexLock(This._mutex)
    ReDim Preserve This._pThread(UBound(This._pThread) + 1)
    This._pThread(UBound(This._pThread)) = pThread
    ReDim Preserve This._p(UBound(This._p) + 1)
    This._p(UBound(This._p)) = p
    CondSignal(This._cond2)
    This._state = 1
    MutexUnlock(This._mutex)
End Sub

Sub ThreadPooling.PoolingWait()
    MutexLock(This._mutex)
    While (This._state And 11) > 0
        CondWait(This._Cond1, This._mutex)
    Wend
    ReDim This._returnF(0)
    This._state = 0
    MutexUnlock(This._mutex)
End Sub

Sub ThreadPooling.PoolingWait(values() As String)
    MutexLock(This._mutex)
    While (This._state And 11) > 0
        CondWait(This._Cond1, This._mutex)
    Wend
    If UBound(This._returnF) > 0 Then
        ReDim values(1 To UBound(This._returnF))
        For I As Integer = 1 To UBound(This._returnF)
            values(I) = This._returnF(I)
        Next I
        ReDim This._returnF(0)
    Else
        Erase values
    End If
    This._state = 0
    MutexUnlock(This._mutex)
End Sub

Property ThreadPooling.PoolingState() As UByte
    If UBound(This._p) > 0 Then
        Return 8 + This._state
    Else
        Return This._state
    End If
End Property

Sub ThreadPooling._Thread(ByVal p As Any Ptr)
    Dim As ThreadPooling Ptr pThis = p
    Do
        MutexLock(pThis->_mutex)
        If UBound(pThis->_pThread) = 0 Then
            pThis->_state = 4
            CondSignal(pThis->_cond1)
            While UBound(pThis->_pThread) = 0
                CondWait(pThis->_cond2, pThis->_mutex)
                If pThis->_end = 1 Then Exit Sub
            Wend
        End If
        pThis->_pThread0 = pThis->_pThread(1)
        pThis->_p0 = pThis->_p(1)
        If UBound(pThis->_pThread) > 1 Then
            memmove(@pThis->_pThread(1), @pThis->_pThread(2), (UBound(pThis->_pThread) - 1) * SizeOf(pThis->_pThread))
            memmove(@pThis->_p(1), @pThis->_p(2), (UBound(pThis->_p) - 1) * SizeOf(pThis->_p))
        End If
        ReDim Preserve pThis->_pThread(UBound(pThis->_pThread) - 1)
        ReDim Preserve pThis->_p(UBound(pThis->_p) - 1)
        MutexUnlock(pThis->_mutex)
        ReDim Preserve pThis->_ReturnF(UBound(pThis->_returnF) + 1)
        pThis->_state = 2
        pThis->_returnF(UBound(pThis->_returnF)) = pThis->_pThread0(pThis->_p0)
    Loop
End Sub

Destructor ThreadPooling()
    MutexLock(This._mutex)
    This._end = 1
    CondSignal(This._cond2)
    MutexUnlock(This._mutex)
    .ThreadWait(This._pt)
    MutexDestroy(This._mutex)
    CondDestroy(This._cond1)
    CondDestroy(This._cond2)
End Destructor

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

Type ThreadDispatching
    Public:
        Declare Constructor(ByVal nbMaxSecondaryThread As Integer = 1, ByVal nbMinSecondaryThread As Integer = 0)
        Declare Sub DispatchingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
        Declare Sub DispatchingWait()
        Declare Sub DispatchingWait(values() As String)
        
        Declare Property DispatchingThread() As Integer
        Declare Sub DispatchingState(state() As Ubyte)
        
        Declare Destructor()
    Private:
        Dim As Integer _nbmst
        Dim As Integer _dstnb
        Dim As ThreadPooling Ptr _tp(Any)
End Type

Constructor ThreadDispatching(ByVal nbMaxSecondaryThread As Integer = 1, ByVal nbMinSecondaryThread As Integer = 0)
    This._nbmst = nbMaxSecondaryThread
    If nbMinSecondaryThread > nbMaxSecondaryThread Then
        nbMinSecondaryThread = nbMaxSecondaryThread
    End If
    If nbMinSecondaryThread > 0 Then
        ReDim This._tp(nbMinSecondaryThread - 1)
        For I As Integer = 0 To nbMinSecondaryThread - 1
            This._tp(I) = New ThreadPooling
        Next I
    End If
End Constructor

Sub ThreadDispatching.DispatchingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
    For I As Integer = 0 To UBound(This._tp)
        If (This._tp(I)->PoolingState And 3) = 0 Then
            This._tp(I)->PoolingSubmit(pThread, p)
            Exit Sub
        End If
    Next I
    If UBound(This._tp) < This._nbmst - 1 Then
        ReDim Preserve This._tp(UBound(This._tp) + 1)
        This._tp(UBound(This._tp)) = New ThreadPooling
        This._tp(UBound(This._tp))->PoolingSubmit(pThread, p)
    ElseIf UBound(This._tp) >= 0 Then
        This._tp(This._dstnb)->PoolingSubmit(pThread, p)
        This._dstnb = (This._dstnb + 1) Mod This._nbmst
    End If
End Sub

Sub ThreadDispatching.DispatchingWait()
    For I As Integer = 0 To UBound(This._tp)
        This._tp(I)->PoolingWait()
    Next I
End Sub

Sub ThreadDispatching.DispatchingWait(values() As String)
    Dim As String s()
    For I As Integer = 0 To UBound(This._tp)
        This._tp(I)->PoolingWait(s())
        If UBound(s) >= 1 Then
            If UBound(values) = -1 Then
                ReDim Preserve values(1 To UBound(values) + UBound(s) + 1)
            Else
                ReDim Preserve values(1 To UBound(values) + UBound(s))
            End If
            For I As Integer = 1 To UBound(s)
                values(UBound(values) - UBound(s) + I) = s(I)
            Next I
        End If
    Next I
End Sub

Property ThreadDispatching.DispatchingThread() As Integer
    Return UBound(This._tp) + 1
End Property

Sub ThreadDispatching.DispatchingState(state() As Ubyte)
    If UBound(This._tp) >= 0 Then
        Redim state(1 To UBound(This._tp) + 1)
        For I As Integer = 0 To UBound(This._tp)
            state(I + 1) = This._tp(I)->PoolingState
        Next I
    End If
End Sub

Destructor ThreadDispatching()
    For I As Integer = 0 To UBound(This._tp)
        Delete This._tp(I)
    Next I
End Destructor

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

Dim Shared As Double array(1 To 800000)  '' only used by the [For...Next] waiting loop in UserCode()

Function UserCode (ByVal p As Any Ptr) As String
    Dim As String Ptr ps = p
    For I As Integer = 1 To 2
        Print *ps;
        For J As Integer = 1 To 800000
            array(J) = Tan(J) * Atn(J) * Exp(J) * Log(J)  '' [For...Next] waiting loop not freeing any CPU resource
        Next J
    Next I
    Return ""
End Function

Dim As String s(0 To 35)
For I As Integer = 0 To 15
    s(I) = Str(Hex(I))
Next I
For I As Integer = 16 To 35
    s(I) = Chr(55 + I)
Next I

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

Scope
    For I As Integer = 1 To 16
        Dim As Ubyte state()
        Print "'ThreadDispatching' with " & I & "/0" & " (maximum/minimum) secondary threads:"
        Dim As ThreadDispatching td = ThreadDispatching(I, 0)
        Print "    ";
        For I As Integer = 0 To 35
            td.DispatchingSubmit(@UserCode, @s(I))
            Sleep 20, 1
        Next I
        td.DispatchingState(state())
        td.DispatchingWait()
        Print
        Print "    Just after last task submission:"
        Print "       Number of secondary threads : " & Ubound(state)
        Print "       State for each secondary thread : ";
        For I As Integer = Lbound(state) To Ubound(state)
            Print state(I) & " ";
        Next I
        Print
        Print
    Next I
End Scope

Sleep

Code: Select all

'ThreadDispatching' with 1/0 (maximum/minimum) secondary threads:
    00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVVWWXXYYZZ
    Just after last task submission:
       Number of secondary threads : 1
       State for each secondary thread : 9

'ThreadDispatching' with 2/0 (maximum/minimum) secondary threads:
    01012323454567678989ABABCDCDEFEFGHGHIJIJKLKLMNMNOPOPQRQRSTSTUVUVWXWXYZYZ
    Just after last task submission:
       Number of secondary threads : 2
       State for each secondary thread : 10 9

'ThreadDispatching' with 3/0 (maximum/minimum) secondary threads:
    0120123453456786798AB9ACBDECDFEGHFGHIJKIJKLMNLMNOPQOPQRSTRSTUVWUVWXYZXYZ
    Just after last task submission:
       Number of secondary threads : 3
       State for each secondary thread : 9 9 9

'ThreadDispatching' with 4/0 (maximum/minimum) secondary threads:
    012031243564756879A8B9ACBDECFDEGFHIGJHIKJLMKNLMONPQORPSQRTUSVTWUVXYWZXYZ
    Just after last task submission:
       Number of secondary threads : 4
       State for each secondary thread : 10 10 10 9

'ThreadDispatching' with 5/0 (maximum/minimum) secondary threads:
    012304125346785967A89BCADBEFCDEGHFIJGHKJILMNKOLNPMOQSRPTQSRUVTXUWYVXWZYZ
    Just after last task submission:
       Number of secondary threads : 5
       State for each secondary thread : 9 10 10 10 10

'ThreadDispatching' with 6/0 (maximum/minimum) secondary threads:
    0120314256374956B7E89FBAE8FCDAGIHCDJGIHKLJMONKLPMONQRPSUQTRVSUWTXYVWZXYZ
    Just after last task submission:
       Number of secondary threads : 6
       State for each secondary thread : 10 9 9 9 10 9

'ThreadDispatching' with 7/0 (maximum/minimum) secondary threads:
    012304152637485967AB8C9EADFBGCDEHFGIJLKHMNIJLKOMNPQSROTPUQSRWTUXYZWVXYZV
    Just after last task submission:
       Number of secondary threads : 7
       State for each secondary thread : 2 2 9 2 2 2 4

'ThreadDispatching' with 8/0 (maximum/minimum) secondary threads:
    01203142563748596AB78C9DAEFBGCDHEFIJGKHLIMJKNOLPMQRNSOPTQURVWSXTUYVZWXYZ
    Just after last task submission:
       Number of secondary threads : 8
       State for each secondary thread : 2 2 2 2 4 2 2 2

'ThreadDispatching' with 9/0 (maximum/minimum) secondary threads:
    0123041526374859A67BC8D9AEBFCGDHEIFJGKHLIMNJOKLPMNQROSPTURQVWSTXUYVWZXYZ
    Just after last task submission:
       Number of secondary threads : 9
       State for each secondary thread : 2 2 2 4 4 2 2 2 4

'ThreadDispatching' with 10/0 (maximum/minimum) secondary threads:
    01203142563478659AB78C9DAEBFCGDHEIFJKGLHMIJNOKLPMNQROSPTQURVSWTXVUYZWXYZ
    Just after last task submission:
       Number of secondary threads : 8
       State for each secondary thread : 2 2 2 2 2 2 2 4

'ThreadDispatching' with 11/0 (maximum/minimum) secondary threads:
    01203142563748956A7BC8D9AECBFGDHIEJFKGLHMINJKOLPMNQRSOTPUQVRSWTXUVYWZXYZ
    Just after last task submission:
       Number of secondary threads : 9
       State for each secondary thread : 2 2 2 2 4 2 4 4 2

'ThreadDispatching' with 12/0 (maximum/minimum) secondary threads:
    01203412536748695AB7C8D9AEBFGCDHEIFJKGHLIMJNKLOMPQNRSOTPUQRVSTWXUVYWZXYZ
    Just after last task submission:
       Number of secondary threads : 9
       State for each secondary thread : 2 2 2 2 2 2 4 4 4

'ThreadDispatching' with 13/0 (maximum/minimum) secondary threads:
    01203145263475896A7B8CD9EAFBCDGHEIFGJKHLIMJNKOPLQMRNSOPQTURVSWTUXYVZWXYZ
    Just after last task submission:
       Number of secondary threads : 9
       State for each secondary thread : 2 2 2 2 2 2 4 4 2

'ThreadDispatching' with 14/0 (maximum/minimum) secondary threads:
    01230145236748956A7B8CD9AEBFCGDHEIJFGKLHMINJKOLPMQNROSPQTURVWSXTYUZVWXYZ
    Just after last task submission:
       Number of secondary threads : 9
       State for each secondary thread : 2 2 2 4 2 2 2 2 4

'ThreadDispatching' with 15/0 (maximum/minimum) secondary threads:
    01203415624378596A7B8C9DAEBCFGDHIEJFKGLHIMJNKOLPMQNROSPTQRUSVWTXUYVZWXYZ
    Just after last task submission:
       Number of secondary threads : 9
       State for each secondary thread : 2 2 2 2 4 4 2 2 4

'ThreadDispatching' with 16/0 (maximum/minimum) secondary threads:
    01230415263478569A7BC8D9EAFBGHCDEIFJGHKLIMNJKOPLQMRNSOTPQURVSWTXUYVZWXYZ
    Just after last task submission:
       Number of secondary threads : 9
       State for each secondary thread : 2 2 2 4 2 2 2 4 4

[deltarho[1859]]

During decryption, my Encrypternet application hashes a 256KiB buffer asynchronously with AES-CBC decryption. A 1GiB file would require, 4096 buffer passes. Thread pooling comes into its own with many passes of short-lived threads. A thread create/destroy environment, elementary threading, would have been comparatively expensive.

[fxm]

Indeed, distributing 4096 passes over for example 8 threads without dead time can easily be programmed like the principle below:

Code: Select all

Dim As ThreadDispatching td = 8
For I As Integer = 0 to 4095
    td.DispatchingSubmit(@task, @fct(I))
Next I
td.DispatchingWait()

[deltarho[1859]]

With Encrypternet, a buffer is hashed, and then another buffer is 'hashed in' and so on. The final hash is as if one large buffer had been hashed.

Parallel hashing, or tree hashing, will give a different final result. It will be blindingly fast for hashing a large amount of data. With a td = 8 we'd need 8 buffers. The 'selling point' of Encrypternet in using a single buffer is that the same amount of memory is used whether we are working on a 256KiB file or a 4GiB file.

Tree hashing has its uses, but not with Encrypternet. My guess is that a lot of Encrypternet users are working on txt files a lot less than 256KiB that is one buffer. SHA256 is expensive compared with AES-CBC. I would like to use BLAKE2, and I am working on that, but it is taking longer than I thought it would. I cannot find any dlls which allow streaming, so I am reduced to first principle coding.

[fxm]

ThreadInitThenMultiStart / ThreadDispatching / ThreadPooling, and CPU time with pending secondary threads (waiting for user tasks)

Once a secondary thread is created and initialized (by creating an instance of ThreadInitThenMultiStart or ThreadPooling or ThreadDispatching), it no longer consumes CPU time as long as it is pending (waiting for a user task):
- This is because the thread code (of 'ThreadInitThenMultiStart._Thread()') is in the 'MutexLock(pThis->_mutex1)' state and it will only wake after a 'MutexUnlock(This._mutex1)' triggered by a user task submission (from 'ThreadInitThenMultiStart.ThreadStart()').
- This is because the thread code (of 'ThreadPooling._Thread()') is in the 'CondWait(pThis->_cond2, pThis->_mutex)' state and it will only wake after a 'CondSignal(This._cond2)' triggered by a user task submission (from 'ThreadPooling.PoolingSubmit()').

For ThreadDispatching the more advanced type, I checked this by forcing in 'ThreadDispatching.DispatchingSubmit()' such a configuration.

So the only interest of the 2nd optional parameter of the ThreadDispatching constructor which allows to set the minimum number of secondary threads (0 by default) is only to start these secondary threads at the earliest at the time of the instance construction, in order to have greater responsiveness at the time of the first user task submissions.

[fxm]

Warning when using dynamic instances of 'ThreadInitThenMultiStart' and 'ThreadPooling' 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.
• No problem for 'ThreadDispatching' Type because over-structure of the 'ThreadPooling' Type but using dynamic pointers to the 'ThreadPooling' instances.

- A solution to remove this constraint is that the data members of the 'ThreadInitThenMultiStart' and 'ThreadPooling' Types are no more included in the instance but only a pointer to these. Thus these data members are moved to a separated Type and are allocated/deallocated by the constructor/destructor.
- The 'ThreadDispatching' Type could therefore be simplified by replacing its internal array of pointers to 'ThreadPooling' instances by a simple array of 'ThreadPooling' instances, and its destructor would become useless.

These 3 below safer versions of 'ThreadInitThenMultiStart', 'ThreadPooling', and 'ThreadDispatching' will only be updated:
- in the wiki (13. Can we emulate a kind of thread pooling feature with FreeBASIC?),
- in the synthetic article in the documentation forum (Can we emulate a kind of thread pooling feature with FreeBASIC?).

Code: Select all

Type ThreadInitThenMultiStartData
    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
End Type

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 ThreadInitThenMultiStartData Ptr _pdata
        Declare Static Sub _Thread(ByVal p As Any Ptr)
End Type

Constructor ThreadInitThenMultiStart()
    This._pdata = New ThreadInitThenMultiStartData
    With *This._pdata
        ._mutex1 = MutexCreate()
        MutexLock(._mutex1)
        ._mutex2 = MutexCreate()
        MutexLock(._mutex2)
        ._mutex3 = MutexCreate()
        MutexLock(._mutex3)
    End With
End Constructor

Sub ThreadInitThenMultiStart.ThreadInit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
    With *This._pdata
        ._pThread = pThread
        ._p = p
        If ._pt = 0 Then
            ._pt= ThreadCreate(@ThreadInitThenMultiStart._Thread, This._pdata)
            MutexUnlock(._mutex3)
            ._state = 1
        End If
    End With
End Sub

Sub ThreadInitThenMultiStart.ThreadStart()
    With *This._pdata
        MutexLock(._mutex3)
        MutexUnlock(._mutex1)
    End With
End Sub

Sub ThreadInitThenMultiStart.ThreadStart(ByVal p As Any Ptr)
    With *This._pdata
        MutexLock(._mutex3)
        ._p = p
        MutexUnlock(._mutex1)
    End With
End Sub

Function ThreadInitThenMultiStart.ThreadWait() As String
    With *This._pdata
        MutexLock(._mutex2)
        MutexUnlock(._mutex3)
        ._state = 1
        Return ._returnF
    End With
End Function

Property ThreadInitThenMultiStart.ThreadState() As UByte
    Return This._pdata->_state
End Property

Sub ThreadInitThenMultiStart._Thread(ByVal p As Any Ptr)
    Dim As ThreadInitThenMultiStartData Ptr pdata = p
    With *pdata
        Do
            MutexLock(._mutex1)
            If ._end = 1 Then Exit Sub
            ._state = 2
            ._returnF = ._pThread(._p)
            ._state = 4
            MutexUnlock(._mutex2)
        Loop
    End With
End Sub

Destructor ThreadInitThenMultiStart()
    With *This._pdata
        If ._pt > 0 Then
            ._end = 1
            MutexUnlock(._mutex1)
            ..ThreadWait(._pt)
        End If
        MutexDestroy(._mutex1)
        MutexDestroy(._mutex2)
        MutexDestroy(._mutex3)
    End With
    Delete This._pdata
End Destructor

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

#include once "crt/string.bi"

Type ThreadPoolingData
        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
End Type

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 ThreadPoolingData Ptr _pdata
        Declare Static Sub _Thread(ByVal p As Any Ptr)
End Type

Constructor ThreadPooling()
    This._pdata = New ThreadPoolingData
    With *This._pdata
        ReDim ._pThread(0)
        ReDim ._p(0)
        ReDim ._returnF(0)
        ._mutex = MutexCreate()
        ._cond1 = CondCreate()
        ._cond2 = CondCreate()
        ._pt= ThreadCreate(@ThreadPooling._Thread, This._pdata)
    End With
End Constructor

Sub ThreadPooling.PoolingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
    With *This._pdata
        MutexLock(._mutex)
        ReDim Preserve ._pThread(UBound(._pThread) + 1)
        ._pThread(UBound(._pThread)) = pThread
        ReDim Preserve ._p(UBound(._p) + 1)
        ._p(UBound(._p)) = p
        CondSignal(._cond2)
        ._state = 1
        MutexUnlock(._mutex)
    End With
End Sub

Sub ThreadPooling.PoolingWait()
    With *This._pdata
        MutexLock(._mutex)
        While (._state And 11) > 0
            CondWait(._Cond1, ._mutex)
        Wend
        ReDim ._returnF(0)
        ._state = 0
        MutexUnlock(._mutex)
    End With
End Sub

Sub ThreadPooling.PoolingWait(values() As String)
    With *This._pdata
        MutexLock(._mutex)
        While (._state And 11) > 0
            CondWait(._Cond1, ._mutex)
        Wend
        If UBound(._returnF) > 0 Then
            ReDim values(1 To UBound(._returnF))
            For I As Integer = 1 To UBound(._returnF)
                values(I) = ._returnF(I)
            Next I
            ReDim ._returnF(0)
        Else
            Erase values
        End If
        ._state = 0
        MutexUnlock(._mutex)
    End With
End Sub

Property ThreadPooling.PoolingState() As UByte
    With *This._pdata
        If UBound(._p) > 0 Then
            Return 8 + ._state
        Else
            Return ._state
        End If
    End With
End Property

Sub ThreadPooling._Thread(ByVal p As Any Ptr)
    Dim As ThreadPoolingData Ptr pdata = p
    With *pdata
        Do
            MutexLock(._mutex)
            If UBound(._pThread) = 0 Then
                ._state = 4
                CondSignal(._cond1)
                While UBound(._pThread) = 0
                    CondWait(._cond2, ._mutex)
                    If ._end = 1 Then Exit Sub
                Wend
            End If
            ._pThread0 = ._pThread(1)
            ._p0 = ._p(1)
            If UBound(._pThread) > 1 Then
                memmove(@._pThread(1), @._pThread(2), (UBound(._pThread) - 1) * SizeOf(._pThread))
                memmove(@._p(1), @._p(2), (UBound(._p) - 1) * SizeOf(._p))
            End If
            ReDim Preserve ._pThread(UBound(._pThread) - 1)
            ReDim Preserve ._p(UBound(._p) - 1)
            MutexUnlock(._mutex)
            ReDim Preserve ._ReturnF(UBound(._returnF) + 1)
            ._state = 2
            ._returnF(UBound(._returnF)) = ._pThread0(._p0)
        Loop
    End With
End Sub

Destructor ThreadPooling()
    With *This._pdata
        MutexLock(._mutex)
        ._end = 1
        CondSignal(._cond2)
        MutexUnlock(._mutex)
        ..ThreadWait(._pt)
        MutexDestroy(._mutex)
        CondDestroy(._cond1)
        CondDestroy(._cond2)
    End With
    Delete This._pdata
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)
    Private:
        Dim As Integer _nbmst
        Dim As Integer _dstnb
        Dim As ThreadPooling _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)
    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)).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

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

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)
    Redim Preserve As ThreadInitThenMultiStart ts(nbThread - 1)
    Scope
        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)
    ReDim Preserve As ThreadPooling tp(nbThread - 1)
    Scope
        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

Note:
From fbc 1.10.0, and in order to have a single structure (for 'ThreadInitThenMultiStart' or 'ThreadPooling'), the additional Type of data ('ThreadInitThenMultiStartData' or 'ThreadPoolingData') can be nested as is in its main Type, just above the declaration of its pointer:

Code: Select all

' For fbc >= 1.10.0

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:
        Type ThreadInitThenMultiStartData
            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
        End Type
        Dim As ThreadInitThenMultiStartData Ptr _pdata
        Declare Static Sub _Thread(ByVal p As Any Ptr)
End Type

Code: Select all

' For fbc >= 1.10.0

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:
        Type ThreadPoolingData
            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
        End Type
        Dim As ThreadPoolingData Ptr _pdata
        Declare Static Sub _Thread(ByVal p As Any Ptr)
End Type

[fxm]

Always for fbc >= 1.10.0 and for the fun, the 'ThreadPooling' structure declaration can be nested in the 'ThreadDispatching' structure, that induces 2 levels of nesting:

Code: Select all

' for fbc >= 1.10.0

#include once "crt/string.bi"
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)
    Private:
        Dim As Integer _nbmst
        Dim As Integer _dstnb
        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:
                Type ThreadPoolingData
                    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
                End Type
            Dim As ThreadPoolingData Ptr _pdata
            Declare Static Sub _Thread(ByVal p As Any Ptr)
        End Type
        Dim As ThreadPooling _tp(Any)
End Type

Constructor ThreadDispatching.ThreadPooling()
    This._pdata = New ThreadPoolingData
    With *This._pdata
        ReDim ._pThread(0)
        ReDim ._p(0)
        ReDim ._returnF(0)
        ._mutex = MutexCreate()
        ._cond1 = CondCreate()
        ._cond2 = CondCreate()
        ._pt= ThreadCreate(@ThreadPooling._Thread, This._pdata)
    End With
End Constructor

Sub ThreadDispatching.ThreadPooling.PoolingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
    With *This._pdata
        MutexLock(._mutex)
        ReDim Preserve ._pThread(UBound(._pThread) + 1)
        ._pThread(UBound(._pThread)) = pThread
        ReDim Preserve ._p(UBound(._p) + 1)
        ._p(UBound(._p)) = p
        CondSignal(._cond2)
        ._state = 1
        MutexUnlock(._mutex)
    End With
End Sub

Sub ThreadDispatching.ThreadPooling.PoolingWait()
    With *This._pdata
        MutexLock(._mutex)
        While (._state And 11) > 0
            CondWait(._Cond1, ._mutex)
        Wend
        ReDim ._returnF(0)
        ._state = 0
        MutexUnlock(._mutex)
    End With
End Sub

Sub ThreadDispatching.ThreadPooling.PoolingWait(values() As String)
    With *This._pdata
        MutexLock(._mutex)
        While (._state And 11) > 0
            CondWait(._Cond1, ._mutex)
        Wend
        If UBound(._returnF) > 0 Then
            ReDim values(1 To UBound(._returnF))
            For I As Integer = 1 To UBound(._returnF)
                values(I) = ._returnF(I)
            Next I
            ReDim ._returnF(0)
        Else
            Erase values
        End If
        ._state = 0
        MutexUnlock(._mutex)
    End With
End Sub

Property ThreadDispatching.ThreadPooling.PoolingState() As UByte
    With *This._pdata
        If UBound(._p) > 0 Then
            Return 8 + ._state
        Else
            Return ._state
        End If
    End With
End Property

Sub ThreadDispatching.ThreadPooling._Thread(ByVal p As Any Ptr)
    Dim As ThreadPoolingData Ptr pdata = p
    With *pdata
        Do
            MutexLock(._mutex)
            If UBound(._pThread) = 0 Then
                ._state = 4
                CondSignal(._cond1)
                While UBound(._pThread) = 0
                    CondWait(._cond2, ._mutex)
                    If ._end = 1 Then Exit Sub
                Wend
            End If
            ._pThread0 = ._pThread(1)
            ._p0 = ._p(1)
            If UBound(._pThread) > 1 Then
                memmove(@._pThread(1), @._pThread(2), (UBound(._pThread) - 1) * SizeOf(._pThread))
                memmove(@._p(1), @._p(2), (UBound(._p) - 1) * SizeOf(._p))
            End If
            ReDim Preserve ._pThread(UBound(._pThread) - 1)
            ReDim Preserve ._p(UBound(._p) - 1)
            MutexUnlock(._mutex)
            ReDim Preserve ._ReturnF(UBound(._returnF) + 1)
            ._state = 2
            ._returnF(UBound(._returnF)) = ._pThread0(._p0)
        Loop
    End With
End Sub

Destructor ThreadDispatching.ThreadPooling()
    With *This._pdata
        MutexLock(._mutex)
        ._end = 1
        CondSignal(._cond2)
        MutexUnlock(._mutex)
        ..ThreadWait(._pt)
        MutexDestroy(._mutex)
        CondDestroy(._cond1)
        CondDestroy(._cond2)
    End With
    Delete This._pdata
End Destructor

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

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

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 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 "'ThreadDispatching' with 1 secondary thread max:"
ThreadDispatchingSequence(1)
Print

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

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

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

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

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

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

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

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

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

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

Sleep

[adeyblue]

These have the same problem. If they are part of an array that resizes and copies, they'll also crash. This code below also deadlocked on me, to see the deadlock more easily put a sleep 200 at the start of ThreadPooling.Thread, though in my VM it locked up without that.

Code: Select all

Function d(byval p as any ptr) as string
    Return ""
End Function

dim as ThreadPooling tp1
Scope
    dim as ThreadPooling tp2 = tp1 '' simulate copy from array resizing
End Scope '' simulate destruction of old one
tp1.PoolingSubmit(@d) '' try to use object

[fxm]

Thanks adeyblue,

1)
First I see another simpler case of blocking which is:

Code: Select all

Scope
    Dim As ThreadPooling ts
End Scope
Print "OK"
Sleep

But works with:

Code: Select all

Scope
    Dim As ThreadPooling ts
    Sleep 100
End Scope
Print "OK"
Sleep

That is a time conflict between the destructor call and the internal thread run start.
Without 'Sleep' keyword, the 'CondSignal(._cond2)' from destructor is activated too early compared to the 'CondWait(._cond2, ._mutex)' of 'ThreadPooling._Thread' which therefore does not see it.
The better solution is in 'ThreadPooling._Thread()' to put the test 'If ._end = 1 Then Exit Sub' before 'CondWait(._cond2, ._mutex)' and not after:

Code: Select all

Sub ThreadPooling._Thread(ByVal p As Any Ptr)
    Dim As ThreadPoolingData Ptr pdata = p
    With *pdata
        Do
            MutexLock(._mutex)
            If UBound(._pThread) = 0 Then
                ._state = 4
                CondSignal(._cond1)
                While UBound(._pThread) = 0
                    If ._end = 1 Then Exit Sub
                    CondWait(._cond2, ._mutex)
                    '' If ._end = 1 Then Exit Sub
                Wend
            End If
            ._pThread0 = ._pThread(1)
            ._p0 = ._p(1)
            If UBound(._pThread) > 1 Then
                memmove(@._pThread(1), @._pThread(2), (UBound(._pThread) - 1) * SizeOf(._pThread))
                memmove(@._p(1), @._p(2), (UBound(._p) - 1) * SizeOf(._p))
            End If
            ReDim Preserve ._pThread(UBound(._pThread) - 1)
            ReDim Preserve ._p(UBound(._p) - 1)
            MutexUnlock(._mutex)
            ReDim Preserve ._ReturnF(UBound(._returnF) + 1)
            ._state = 2
            ._returnF(UBound(._returnF)) = ._pThread0(._p0)
        Loop
    End With
End Sub

Code: Select all

Destructor ThreadPooling()
    With *This._pdata
        MutexLock(._mutex)
        ._end = 1
        CondSignal(._cond2)
        MutexUnlock(._mutex)
        ..ThreadWait(._pt)
        MutexDestroy(._mutex)
        CondDestroy(._cond1)
        CondDestroy(._cond2)
    End With
    Delete This._pdata
End Destructor

2)Your blocking case:

Code: Select all

Scope
    Dim As ThreadPooling ts1
Scope
    Dim As ThreadPooling ts2 = ts1
    Sleep 100
End Scope
Print "OK1"
End Scope
Print "OK2"
Sleep

Or:

Code: Select all

Scope
    Dim As ThreadPooling ts1
Scope
    Dim As ThreadPooling ts2
    ts2 = ts1
    Sleep 100
End Scope
Print "OK1"
End Scope
Print "OK2"
Sleep

Copy-construction and copy-assignment (useless) must be forbidden because the implicit copy-constructor and the implicit copy-assignment operator duplicate the pointer values, so when an instance is destroyed the second is impacted.
The solution is to declare the copy-constructor and the implicit copy-assignment operator in the private section of the Type (without procedure body), but this forbids to use a 'ThreadPooling' array in 'ThreadDispatching' to come back to a pointer arrays.
Therefore to forbid copy-construction and copy-assignement for the 3 structures and maintain a 'ThreadPooling' pointer array for 'ThreadDispatching'.

3)
These 3 safer last versiosn (change#1 + change#2) of 'ThreadInitThenMultiStartData', 'ThreadPoolingData', and 'ThreadPooling' will only be updated:
- in the wiki (13. Can we emulate a kind of thread pooling feature with FreeBASIC?),
- in the synthetic article in the documentation forum (Can we emulate a kind of thread pooling feature with FreeBASIC?).

[fxm]

Using 'ThreadInitThenMultiStart', 'ThreadPooling', and 'ThreadDispatching' instance to run a subroutine as user task (to be executed in a thread)

Presently, every user procedure (to be executed in a thread) must be available under the following function signature:
Function userfct (Byval puserdata As Any Ptr) As String.

1)
If the user want to use an existing thread subroutine ('usersub(byval as any ptr)'), he can interface it by a wrapper function (with an "any pointer" as parameter, calling the thread subroutine, and returning an empty string):

Code: Select all

Function userwrapper (Byval puserdata As Any Ptr) As String
    usersub(puserdata)
    Return ""
End function

2)
One could also improve the 'ThreadInitThenMultiStart', 'ThreadPooling', and 'ThreadDispatching' structures in order to be implicitly compatible with both a subroutine and a function as user procedure to run.
For information, see such 'ThreadInitThenMultiStart', 'ThreadPooling', and 'ThreadDispatching' structures thus improved below, for the fun:

Code: Select all

Type ThreadInitThenMultiStartData
    Dim As Any Ptr _pUserProc
    Dim As Any Ptr _pUserData
    Dim As UByte _subUserProc
    Dim As Any Ptr _mutex1
    Dim As Any Ptr _mutex2
    Dim As Any Ptr _mutex3
    Dim As Any Ptr _pThread
    Dim As Byte _endThread
    Dim As String _returnUserFct
    Dim As UByte _stateThread
End Type

Type ThreadInitThenMultiStart
    Public:
        Declare Constructor()
        Declare Sub ThreadInit(ByVal pThread As Sub(ByVal As Any Ptr), ByVal p As Any Ptr = 0)
        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 ThreadInitThenMultiStartData Ptr _pTITMSdata
        Declare Static Sub _Thread(ByVal p As Any Ptr)
        Declare Constructor(Byref t As ThreadInitThenMultiStartData)
        Declare Operator Let(Byref t As ThreadInitThenMultiStartData)
        Declare Sub _Init(ByVal pThread As Any Ptr, Byval p As Any Ptr)
End Type

Constructor ThreadInitThenMultiStart()
    This._pTITMSdata = New ThreadInitThenMultiStartData
    With *This._pTITMSdata
        ._mutex1 = MutexCreate()
        MutexLock(._mutex1)
        ._mutex2 = MutexCreate()
        MutexLock(._mutex2)
        ._mutex3 = MutexCreate()
        MutexLock(._mutex3)
    End With
End Constructor

Sub ThreadInitThenMultiStart.ThreadInit(ByVal pThread As Sub(ByVal As Any Ptr), ByVal p As Any Ptr = 0)
    With *This._pTITMSdata
        ._subUserProc = 1
        This._Init(pThread, p)
    End With
End Sub

Sub ThreadInitThenMultiStart.ThreadInit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
    With *This._pTITMSdata
        ._subUserProc = 0
        This._Init(pThread, p)
    End With
End Sub

Sub ThreadInitThenMultiStart.ThreadStart()
    With *This._pTITMSdata
        MutexLock(._mutex3)
        MutexUnlock(._mutex1)
    End With
End Sub

Sub ThreadInitThenMultiStart.ThreadStart(ByVal p As Any Ptr)
    With *This._pTITMSdata
        MutexLock(._mutex3)
        ._pUserData = p
        MutexUnlock(._mutex1)
    End With
End Sub

Function ThreadInitThenMultiStart.ThreadWait() As String
    With *This._pTITMSdata
        MutexLock(._mutex2)
        MutexUnlock(._mutex3)
        ._stateThread = 1
        Return ._returnUserFct
    End With
End Function

Property ThreadInitThenMultiStart.ThreadState() As UByte
    Return This._pTITMSdata->_stateThread
End Property

Sub ThreadInitThenMultiStart._Thread(ByVal p As Any Ptr)
    Dim As ThreadInitThenMultiStartData Ptr pdata = p
    With *pdata
        Do
            MutexLock(._mutex1)
            If ._endThread = 1 Then Exit Sub
            ._stateThread = 2
            If ._subUserProc = 1 Then
                Cptr(Sub(ByVal As Any Ptr), ._pUserProc)(._pUserData)
            Else
                ._returnUserFct = Cptr(Function(ByVal As Any Ptr) As String, ._pUserProc)(._pUserData)
            End If
            ._stateThread = 4
            MutexUnlock(._mutex2)
        Loop
    End With
End Sub

Sub ThreadInitThenMultiStart._Init(ByVal pThread As Any Ptr, ByVal p As Any Ptr = 0)
    With *This._pTITMSdata
        ._pUserProc = pThread
        ._pUserData = p
        If ._pThread = 0 Then
            ._pThread= ThreadCreate(@ThreadInitThenMultiStart._Thread, This._pTITMSdata)
            MutexUnlock(._mutex3)
            ._stateThread = 1
        End If
    End With
End Sub

Destructor ThreadInitThenMultiStart()
    With *This._pTITMSdata
        If ._pThread > 0 Then
            ._endThread = 1
            MutexUnlock(._mutex1)
            ..ThreadWait(._pThread)
        End If
        MutexDestroy(._mutex1)
        MutexDestroy(._mutex2)
        MutexDestroy(._mutex3)
        Delete This._pTITMSdata
    End With
End Destructor

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

#include once "crt/string.bi"

Type ThreadPoolingData
    Dim As Any Ptr _pUserProc0
    Dim As Any Ptr _pUserData0
    Dim As UByte _subUserProc0
    Dim As Any Ptr _pUserProc(Any)
    Dim As Any Ptr _pUserData(Any)
    Dim As UByte _subUserProc(Any)
    Dim As Any Ptr _mutex
    Dim As Any Ptr _cond1
    Dim As Any Ptr _cond2
    Dim As Any Ptr _pThread
    Dim As Byte _end
    Dim As String _returnUserFct(Any)
    Dim As UByte _stateThread
End Type

Type ThreadPooling
    Public:
        Declare Constructor()
        Declare Sub PoolingSubmit(ByVal pThread As Sub(ByVal As Any Ptr), ByVal p As Any Ptr = 0)
        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 ThreadPoolingData Ptr _pTPdata
        Declare Static Sub _Thread(ByVal p As Any Ptr)
        Declare Constructor(Byref t As ThreadPooling)
        Declare Operator Let(Byref t As ThreadPooling)
        Declare Sub _Submit(Byval pThread As Any Ptr, Byval p As Any Ptr)
End Type

Constructor ThreadPooling()
    This._pTPdata = New ThreadPoolingData
    With *This._pTPdata
        ReDim ._pUserProc(0)
        ReDim ._pUserData(0)
        ReDim ._returnUserFct(0)
        Redim ._subUserProc(0)
        ._mutex = MutexCreate()
        ._cond1 = CondCreate()
        ._cond2 = CondCreate()
        ._pThread= ThreadCreate(@ThreadPooling._Thread, This._pTPdata)
    End With
End Constructor

Sub ThreadPooling.PoolingSubmit(ByVal pThread As Sub(ByVal As Any Ptr), ByVal p As Any Ptr = 0)
    With *This._pTPdata
        MutexLock(._mutex)
        Redim Preserve ._subUserProc(UBound(._subUserProc) + 1)
        ._subUserProc(UBound(._subUserProc)) = 1
        This._Submit(pThread, p)
        MutexUnlock(._mutex)
    End With
End Sub

Sub ThreadPooling.PoolingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
    With *This._pTPdata
        MutexLock(._mutex)
        Redim Preserve ._subUserProc(UBound(._subUserProc) + 1)
        ._subUserProc(UBound(._subUserProc)) = 0
        This._Submit(pThread, p)
        MutexUnlock(._mutex)
    End With
End Sub

Sub ThreadPooling.PoolingWait()
    With *This._pTPdata
        MutexLock(._mutex)
        While (._stateThread And 11) > 0
            CondWait(._Cond1, ._mutex)
        Wend
        ReDim ._returnUserFct(0)
        ._stateThread = 0
        MutexUnlock(._mutex)
    End With
End Sub

Sub ThreadPooling.PoolingWait(values() As String)
    With *This._pTPdata
        MutexLock(._mutex)
        While (._stateThread And 11) > 0
            CondWait(._Cond1, ._mutex)
        Wend
        If UBound(._returnUserFct) > 0 Then
            ReDim values(1 To UBound(._returnUserFct))
            For I As Integer = 1 To UBound(._returnUserFct)
                values(I) = ._returnUserFct(I)
            Next I
            ReDim ._returnUserFct(0)
        Else
            Erase values
        End If
        ._stateThread = 0
        MutexUnlock(._mutex)
    End With
End Sub

Property ThreadPooling.PoolingState() As UByte
    With *This._pTPdata
        If UBound(._pUserData) > 0 Then
            Return 8 + ._stateThread
        Else
            Return ._stateThread
        End If
    End With
End Property

Sub ThreadPooling._Thread(ByVal p As Any Ptr)
    Dim As ThreadPoolingData Ptr pdata = p
    With *pdata
        Do
            MutexLock(._mutex)
            If UBound(._pUserProc) = 0 Then
                ._stateThread = 4
                CondSignal(._cond1)
                While UBound(._pUserProc) = 0
                    If ._end = 1 Then Exit Sub
                    CondWait(._cond2, ._mutex)
                Wend
            End If
            ._pUserProc0 = ._pUserProc(1)
            ._pUserData0 = ._pUserData(1)
            ._subUserProc0 = ._subUserProc(1)
            If UBound(._pUserProc) > 1 Then
                memmove(@._pUserProc(1), @._pUserProc(2), (UBound(._pUserProc) - 1) * SizeOf(._pUserProc))
                memmove(@._pUserData(1), @._pUserData(2), (UBound(._pUserData) - 1) * SizeOf(._pUserData))
                memmove(@._subUserProc(1), @._subUserProc(2), (UBound(._subUserProc) - 1) * SizeOf(._subUserProc))
            End If
            ReDim Preserve ._pUserProc(UBound(._pUserProc) - 1)
            ReDim Preserve ._pUserData(UBound(._pUserData) - 1)
            ReDim Preserve ._subUserProc(UBound(._subUserProc) - 1)
            MutexUnlock(._mutex)
            ReDim Preserve ._returnUserFct(UBound(._returnUserFct) + 1)
            ._stateThread = 2
            If ._subUserProc0 = 1 Then
                Cptr(Sub(ByVal As Any Ptr), ._pUserProc0)(._pUserData0)
            Else
                ._returnUserFct(UBound(._returnUserFct)) = Cptr(Function(ByVal As Any Ptr) As String, ._pUserProc0)(._pUserData0)
            End If
        Loop
    End With
End Sub

Sub ThreadPooling._Submit(Byval pThread As Any Ptr, Byval p As Any Ptr)
    With *This._pTPdata
        ReDim Preserve ._pUserProc(UBound(._pUserProc) + 1)
        ._pUserProc(UBound(._pUserProc)) = pThread
        ReDim Preserve ._pUserData(UBound(._pUserData) + 1)
        ._pUserData(UBound(._pUserData)) = p
        CondSignal(._cond2)
        ._stateThread = 1
    End With
End Sub

Destructor ThreadPooling()
    With *This._pTPdata
        MutexLock(._mutex)
        ._end = 1
        CondSignal(._cond2)
        MutexUnlock(._mutex)
        ..ThreadWait(._pThread)
        MutexDestroy(._mutex)
        CondDestroy(._cond1)
        CondDestroy(._cond2)
        Delete This._pTPdata
    End With
End Destructor

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

Type ThreadDispatching
    Public:
        Declare Constructor(ByVal nbMaxSecondaryThread As Integer = 1, ByVal nbMinSecondaryThread As Integer = 0)
        Declare Sub DispatchingSubmit(ByVal pThread As Sub(ByVal As Any Ptr), ByVal p As Any Ptr = 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 _nbMaxThread
        Dim As Integer _distribNB
        Dim As ThreadPooling Ptr _pThreadPooling(Any)
        Dim As UByte _subUserProc
        Declare Constructor(Byref t As ThreadDispatching)
        Declare Operator Let(Byref t As ThreadDispatching)
        Declare Sub _Submit(Byval pThread As Any Ptr, Byval p As Any Ptr)
End Type

Constructor ThreadDispatching(ByVal nbMaxSecondaryThread As Integer = 1, ByVal nbMinSecondaryThread As Integer = 0)
    This._nbMaxThread = nbMaxSecondaryThread
    If nbMinSecondaryThread > nbMaxSecondaryThread Then
        nbMinSecondaryThread = nbMaxSecondaryThread
    End If
    If nbMinSecondaryThread > 0 Then
        ReDim This._pThreadPooling(nbMinSecondaryThread - 1)
        For I As Integer = 0 To nbMinSecondaryThread - 1
            This._pThreadPooling(I) = New ThreadPooling
        Next I
    End If
End Constructor

Sub ThreadDispatching.DispatchingSubmit(ByVal pThread As Sub(ByVal As Any Ptr), ByVal p As Any Ptr = 0)
    This._subUserProc = 1
    This._Submit(pThread, p)
End Sub

Sub ThreadDispatching.DispatchingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
    This._subUserProc = 0
    This._Submit(pThread, p)
End Sub

Sub ThreadDispatching.DispatchingWait()
    For I As Integer = 0 To UBound(This._pThreadPooling)
        This._pThreadPooling(I)->PoolingWait()
    Next I
End Sub

Sub ThreadDispatching.DispatchingWait(values() As String)
    Dim As String s()
    For I As Integer = 0 To UBound(This._pThreadPooling)
        This._pThreadPooling(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._pThreadPooling) + 1
End Property

Sub ThreadDispatching.DispatchingState(state() As Ubyte)
    If UBound(This._pThreadPooling) >= 0 Then
        Redim state(1 To UBound(This._pThreadPooling) + 1)
        For I As Integer = 0 To UBound(This._pThreadPooling)
            state(I + 1) = This._pThreadPooling(I)->PoolingState
        Next I
    End If
End Sub

Sub ThreadDispatching._Submit(Byval pThread As Any Ptr, Byval p As Any Ptr)
    For I As Integer = 0 To UBound(This._pThreadPooling)
        If (This._pThreadPooling(I)->PoolingState And 11) = 0 Then
            If This._subUserProc = 1 Then
                This._pThreadPooling(I)->PoolingSubmit(Cptr(Sub(ByVal As Any Ptr), pThread), p)
            Else
                This._pThreadPooling(I)->PoolingSubmit(Cptr(Function(ByVal As Any Ptr) As String, pThread), p)
            End If
            Exit Sub
        End If
    Next I
    If UBound(This._pThreadPooling) < This._nbMaxThread - 1 Then
        ReDim Preserve This._pThreadPooling(UBound(This._pThreadPooling) + 1)
        This._pThreadPooling(UBound(This._pThreadPooling)) = New ThreadPooling
        If This._subUserProc = 1 Then
            This._pThreadPooling(UBound(This._pThreadPooling))->PoolingSubmit(Cptr(Sub(ByVal As Any Ptr), pThread), p)
        Else
            This._pThreadPooling(UBound(This._pThreadPooling))->PoolingSubmit(Cptr(Function(ByVal As Any Ptr) As String, pThread), p)
        End If
    ElseIf UBound(This._pThreadPooling) >= 0 Then
        If This._subUserProc = 1 Then
            This._pThreadPooling(This._distribNB)->PoolingSubmit(Cptr(Sub(ByVal As Any Ptr), pThread), p)
        Else
            This._pThreadPooling(This._distribNB)->PoolingSubmit(Cptr(Function(ByVal As Any Ptr) As String, pThread), p)
        End If
        This._distribNB = (This._distribNB + 1) Mod This._nbMaxThread
    End If
End Sub
    
Destructor ThreadDispatching()
    For I As Integer = 0 To UBound(This._pThreadPooling)
        Delete This._pThreadPooling(I)
    Next I
End Destructor

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

Dim Shared As Double array(1 To 800000)  '' only used by the [For...Next] waiting loop in UserCode()

Sub UserCodeSub (ByVal p As Any Ptr)
    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
End Sub

Function UserCodeFct (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)
    Redim Preserve As ThreadInitThenMultiStart ts(nbThread - 1)
    Scope
        Print "   ";
        Dim As Double t = Timer
        For I As Integer = 0 To 32 - nbThread Step nbThread
            For J As Integer = 0 To nbThread - 1
                Static As Integer count
                If (Count Mod 2) = 0 Then
                    ts(J).ThreadInit(@UserCodeSub, @s(I + J))
                Else
                    ts(J).ThreadInit(@UserCodeFct, @s(I + J))
                End If
                ts(J).ThreadStart()
                count += 1
            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)
    ReDim Preserve As ThreadPooling tp(nbThread - 1)
    Scope
        Print "   ";
        Dim As Double t = Timer
        For I As Integer = 0 To 32 - nbThread Step nbThread
            For J As Integer = 0 To nbThread - 1
                Static As Integer count
                If (Count Mod 2) = 0 Then
                    tp(J).PoolingSubmit(@UserCodeSub, @s(I + J))
                Else
                    tp(J).PoolingSubmit(@UserCodeFct, @s(I + J))
                End If
                count += 1
            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
            Static As Integer count
            If (Count Mod 2) = 0 Then
                td##nbThreadmax.DispatchingSubmit(@UserCodeSub, @s(I))
            Else
                td##nbThreadmax.DispatchingSubmit(@UserCodeFct, @s(I))
            End If
            count += 1
        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

[fxm]

Is there performance degradation with 'ThreadPooling' when many more user threads are started than actual number of available system threads ?

I have often read that performance degrades when the number of user threads started is significantly higher than the actual number of system threads available.

However on my PC, I do not see such consequences, and the execution time becomes asymptotic (nearly constant value) and does not increase more and more when the number of user threads started becomes more and more superior to the actual number of system threads available.

Test program below that starts from 1 to 78 user threads using 'ThreadPooling'.
You can interrupt the sequence at any time by pressing the keyboard:

Code: Select all

#include once "crt/string.bi"

Type ThreadPoolingData
    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
End Type

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 ThreadPoolingData Ptr _pdata
        Declare Static Sub _Thread(ByVal p As Any Ptr)
        Declare Constructor(Byref t As ThreadPooling)
        Declare Operator Let(Byref t As ThreadPooling)
End Type

Constructor ThreadPooling()
    This._pdata = New ThreadPoolingData
    With *This._pdata
        ReDim ._pThread(0)
        ReDim ._p(0)
        ReDim ._returnF(0)
        ._mutex = MutexCreate()
        ._cond1 = CondCreate()
        ._cond2 = CondCreate()
        ._pt= ThreadCreate(@ThreadPooling._Thread, This._pdata)
    End With
End Constructor

Sub ThreadPooling.PoolingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
    With *This._pdata
        MutexLock(._mutex)
        ReDim Preserve ._pThread(UBound(._pThread) + 1)
        ._pThread(UBound(._pThread)) = pThread
        ReDim Preserve ._p(UBound(._p) + 1)
        ._p(UBound(._p)) = p
        CondSignal(._cond2)
        ._state = 1
        MutexUnlock(._mutex)
    End With
End Sub

Sub ThreadPooling.PoolingWait()
    With *This._pdata
        MutexLock(._mutex)
        While (._state And 11) > 0
            CondWait(._Cond1, ._mutex)
        Wend
        ReDim ._returnF(0)
        ._state = 0
        MutexUnlock(._mutex)
    End With
End Sub

Sub ThreadPooling.PoolingWait(values() As String)
    With *This._pdata
        MutexLock(._mutex)
        While (._state And 11) > 0
            CondWait(._Cond1, ._mutex)
        Wend
        If UBound(._returnF) > 0 Then
            ReDim values(1 To UBound(._returnF))
            For I As Integer = 1 To UBound(._returnF)
                values(I) = ._returnF(I)
            Next I
            ReDim ._returnF(0)
        Else
            Erase values
        End If
        ._state = 0
        MutexUnlock(._mutex)
    End With
End Sub

Property ThreadPooling.PoolingState() As UByte
    With *This._pdata
        If UBound(._p) > 0 Then
            Return 8 + ._state
        Else
            Return ._state
        End If
    End With
End Property

Sub ThreadPooling._Thread(ByVal p As Any Ptr)
    Dim As ThreadPoolingData Ptr pdata = p
    With *pdata
        Do
            MutexLock(._mutex)
            If UBound(._pThread) = 0 Then
                ._state = 4
                CondSignal(._cond1)
                While UBound(._pThread) = 0
                    If ._end = 1 Then Exit Sub
                    CondWait(._cond2, ._mutex)
                Wend
            End If
            ._pThread0 = ._pThread(1)
            ._p0 = ._p(1)
            If UBound(._pThread) > 1 Then
                memmove(@._pThread(1), @._pThread(2), (UBound(._pThread) - 1) * SizeOf(._pThread))
                memmove(@._p(1), @._p(2), (UBound(._p) - 1) * SizeOf(._p))
            End If
            ReDim Preserve ._pThread(UBound(._pThread) - 1)
            ReDim Preserve ._p(UBound(._p) - 1)
            MutexUnlock(._mutex)
            ReDim Preserve ._ReturnF(UBound(._returnF) + 1)
            ._state = 2
            ._returnF(UBound(._returnF)) = ._pThread0(._p0)
        Loop
    End With
End Sub

Destructor ThreadPooling()
    With *This._pdata
        MutexLock(._mutex)
        ._end = 1
        CondSignal(._cond2)
        MutexUnlock(._mutex)
        ..ThreadWait(._pt)
        MutexDestroy(._mutex)
        CondDestroy(._cond1)
        CondDestroy(._cond2)
    End With
    Delete This._pdata
End Destructor

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

Dim Shared As Double array(1 To 700000)  '' only used by the [For...Next] waiting loop in UserCode()

Function UserCode (ByVal p As Any Ptr) As String
    Print ".";
    For J As Integer = 1 To 700000
        array(J) = Tan(J) * Atn(J) * Exp(J) * Log(J)  '' [For...Next] waiting loop not freeing any CPU resource
    Next J
    Return ""
End Function

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

While Inkey <> ""
Wend
For N As Integer = 1 To 78
    Scope
        Dim As ThreadPooling tp(0 To N - 1)
        Print " ";
        Dim As Double t = Timer
        For I As Integer = 0 To 77
            tp(I Mod N).PoolingSubmit(@UserCode)
        Next I
        For I As Integer = 0 To N - 1
            tp(I).PoolingWait()
        Next I
        t = Timer - t
        Locate , 11
        Print Using " 'ThreadPooling' with ## secondary threads started:###.## s "; N; t
    End Scope
    If Inkey <> "" Then Exit For
Next N
Print
Print "Completed."
    
Sleep

Results on my PC:
- Windows 10
- AMD Ryzen 5 3500U with Radeon Vega Mobile Gfx 2.10 GHz
- 4 cores and 8 threads

Code: Select all

 ......... 'ThreadPooling' with  1 secondary threads started:  4.94 s .........
 ......... 'ThreadPooling' with  2 secondary threads started:  2.57 s .........
 ......... 'ThreadPooling' with  3 secondary threads started:  1.80 s .........
 ......... 'ThreadPooling' with  4 secondary threads started:  1.66 s .........
 ......... 'ThreadPooling' with  5 secondary threads started:  1.48 s .........
 ......... 'ThreadPooling' with  6 secondary threads started:  1.35 s .........
 ......... 'ThreadPooling' with  7 secondary threads started:  1.18 s .........
 ......... 'ThreadPooling' with  8 secondary threads started:  1.10 s .........
 ......... 'ThreadPooling' with  9 secondary threads started:  1.08 s .........
 ......... 'ThreadPooling' with 10 secondary threads started:  1.15 s .........
 ......... 'ThreadPooling' with 11 secondary threads started:  1.09 s .........
 ......... 'ThreadPooling' with 12 secondary threads started:  1.11 s .........
 ......... 'ThreadPooling' with 13 secondary threads started:  1.09 s .........
 ......... 'ThreadPooling' with 14 secondary threads started:  1.07 s .........
 ......... 'ThreadPooling' with 15 secondary threads started:  1.07 s .........
 ......... 'ThreadPooling' with 16 secondary threads started:  1.10 s .........
 ......... 'ThreadPooling' with 17 secondary threads started:  1.09 s .........
 ......... 'ThreadPooling' with 18 secondary threads started:  1.08 s .........
 ......... 'ThreadPooling' with 19 secondary threads started:  1.10 s .........
 ......... 'ThreadPooling' with 20 secondary threads started:  1.08 s .........
 ......... 'ThreadPooling' with 21 secondary threads started:  1.08 s .........
 ......... 'ThreadPooling' with 22 secondary threads started:  1.10 s .........
 ......... 'ThreadPooling' with 23 secondary threads started:  1.10 s .........
 ......... 'ThreadPooling' with 24 secondary threads started:  1.09 s .........
 ......... 'ThreadPooling' with 25 secondary threads started:  1.08 s .........
 ......... 'ThreadPooling' with 26 secondary threads started:  1.10 s .........
 ......... 'ThreadPooling' with 27 secondary threads started:  1.04 s .........
 ......... 'ThreadPooling' with 28 secondary threads started:  1.06 s .........
 ......... 'ThreadPooling' with 29 secondary threads started:  1.07 s .........
 ......... 'ThreadPooling' with 30 secondary threads started:  1.06 s .........
 ......... 'ThreadPooling' with 31 secondary threads started:  1.09 s .........
 ......... 'ThreadPooling' with 32 secondary threads started:  1.07 s .........
 ......... 'ThreadPooling' with 33 secondary threads started:  1.08 s .........
 ......... 'ThreadPooling' with 34 secondary threads started:  1.09 s .........
 ......... 'ThreadPooling' with 35 secondary threads started:  1.10 s .........
 ......... 'ThreadPooling' with 36 secondary threads started:  1.13 s .........
 ......... 'ThreadPooling' with 37 secondary threads started:  1.12 s .........
 ......... 'ThreadPooling' with 38 secondary threads started:  1.09 s .........
 ......... 'ThreadPooling' with 39 secondary threads started:  1.05 s .........
 ......... 'ThreadPooling' with 40 secondary threads started:  1.04 s .........
 ......... 'ThreadPooling' with 41 secondary threads started:  1.03 s .........
 ......... 'ThreadPooling' with 42 secondary threads started:  1.04 s .........
 ......... 'ThreadPooling' with 43 secondary threads started:  1.04 s .........
 ......... 'ThreadPooling' with 44 secondary threads started:  1.06 s .........
 ......... 'ThreadPooling' with 45 secondary threads started:  1.06 s .........
 ......... 'ThreadPooling' with 46 secondary threads started:  1.07 s .........
 ......... 'ThreadPooling' with 47 secondary threads started:  1.06 s .........
 ......... 'ThreadPooling' with 48 secondary threads started:  1.04 s .........
 ......... 'ThreadPooling' with 49 secondary threads started:  1.03 s .........
 ......... 'ThreadPooling' with 50 secondary threads started:  1.04 s .........
 ......... 'ThreadPooling' with 51 secondary threads started:  1.06 s .........
 ......... 'ThreadPooling' with 52 secondary threads started:  1.11 s .........
 ......... 'ThreadPooling' with 53 secondary threads started:  1.07 s .........
 ......... 'ThreadPooling' with 54 secondary threads started:  1.04 s .........
 ......... 'ThreadPooling' with 55 secondary threads started:  1.02 s .........
 ......... 'ThreadPooling' with 56 secondary threads started:  1.03 s .........
 ......... 'ThreadPooling' with 57 secondary threads started:  1.03 s .........
 ......... 'ThreadPooling' with 58 secondary threads started:  1.04 s .........
 ......... 'ThreadPooling' with 59 secondary threads started:  1.07 s .........
 ......... 'ThreadPooling' with 60 secondary threads started:  1.06 s .........
 ......... 'ThreadPooling' with 61 secondary threads started:  1.05 s .........
 ......... 'ThreadPooling' with 62 secondary threads started:  1.05 s .........
 ......... 'ThreadPooling' with 63 secondary threads started:  1.05 s .........
 ......... 'ThreadPooling' with 64 secondary threads started:  1.09 s .........
 ......... 'ThreadPooling' with 65 secondary threads started:  1.06 s .........
 ......... 'ThreadPooling' with 66 secondary threads started:  1.05 s .........
 ......... 'ThreadPooling' with 67 secondary threads started:  1.07 s .........
 ......... 'ThreadPooling' with 68 secondary threads started:  1.07 s .........
 ......... 'ThreadPooling' with 69 secondary threads started:  1.06 s .........
 ......... 'ThreadPooling' with 70 secondary threads started:  1.10 s .........
 ......... 'ThreadPooling' with 71 secondary threads started:  1.07 s .........
 ......... 'ThreadPooling' with 72 secondary threads started:  1.11 s .........
 ......... 'ThreadPooling' with 73 secondary threads started:  1.06 s .........
 ......... 'ThreadPooling' with 74 secondary threads started:  1.04 s .........
 ......... 'ThreadPooling' with 75 secondary threads started:  1.07 s .........
 ......... 'ThreadPooling' with 76 secondary threads started:  1.05 s .........
 ......... 'ThreadPooling' with 77 secondary threads started:  1.04 s .........
 ......... 'ThreadPooling' with 78 secondary threads started:  1.05 s .........

Completed.

In fact, creating too many threads with 'ThreadPooling' only wastes resources and only costs time creating and ending the unused threads.
Otherwise the unused threads are waiting with the 'CondWait()' keyword, and so the thread execution is suspended and does not consume any CPU time until the condition variable is signaled.

[12val12newakk]

Tell me how to parallelize the Procedure into 4-6 threads.
For example, let there be 100,000 particles
4 threads running 0-24999 25000-49999 50000 -74999 75000-100000
at synchronization points need to wait for lagging threads for temporal coherence

Code: Select all

rem=======================================  
rem datalist  input  output from sub      
rem  SHARED  dt ,dfmax  , Rmin  :Base_Size 
rem  SHARED global   x () : global   y ()
rem  SHARED global  vx () : global vy ()
rem  SHARED global  MATERIAL()  : mass()
rem  SHARED global    Num_neighbour  (n,NM)  element number,(neighbor number   element neighbor number )
rem  SHARED global    Total_neighbour_n ()  number of neighbors
sub Lannard_1  (Byval n_begin As integer ,Byval n_end As integer )
         dim as double  ay,ax
               dim as ushort  n 
         for n=n_begin to n_end    
              y(n)+=0.5*vy(n)*dt
              x(n)+=0.5*vx(n)*dt             
         next n   
         'sync  point
                 
     for n=n_begin to  n_end      '      Nmass-1
          fy(n)=0 :fx(n)=0
      '   if material(n)= 0   then continue  for 
            for NM = 0  to  Total_neighbour_n (n)  
                       dim as double   df_damp=0
                        dim as double df_dampy=0 :dim as double df_dampx=0
                       m = Num_neighbour  (n,NM)  
                    dim as double         dx=x(m)-x(n)
                       if ABS (dx)  >  1.2*Base_Size   then Continue for
                   dim as double         dy=y(m)-y(n)
                       if ABS (dy)  >  1.2*Base_Size   then Continue for
                    dim as double    Rgquadro  =dx*dx+dy*dy
                           if  Rgquadro >  (1.2*Base_Size)^2      then Continue for
                   dim as double         Rglue=sqr(dx*dx+dy*dy) 
                   dim as double           dvx=vx(m)-vx(n)
                   dim as double           dvy=vy(m)-vy(n)
                   dim as double   Ri6 =(Rgquadro*Rgquadro)*(Rgquadro *0.00000000024414)   '  Base_size 40
                   dim as double        df=10000000000*((1/Ri6)-(1/(Ri6*Ri6)))     rem  lennard jones  
                   dim as double       dfy= df*dy :    dim as double       dfx= df*dx                                                                                                       
                                     fy(n)=fy(n)+dfy  :  fx(n)=fx(n)+dfx     'Force  accumulator dx  dy   signed                          
         next NM   
     next n  
     'sync point     
     for n=n_begin to n_end    
                     ay=fy(n)/mass(n) 
                      ay=ay-2000    ' low grav
                     ax=fx(n)/mass(n)  
                     vy(n)=vy(n)+ay*dt :  
                     vx(n)=vx(n)+ax*dt :  
                    vy(n)=vy(n)-vy(n)*.001*dt      rem  visc dampfer
                    vx(n)=vx(n)-vx(n)*.001*dt      rem  visc dampfer    
                    y(n)+=0.5*vy(n)*dt
                    x(n)+=0.5*vx(n)*dt    
                    if y(n)<-1100 then      ' down  boundary
                       vy(n)= -vy(n)   
                    dim as double Dby=-1100-y(n)   
                      y(n)=y(n)+Dby
                    end if
      next n 
      'sync point          
end sub

[fxm]

Tell me how to parallelize the Procedure into 4-6 threads.
For example, let there be 100,000 particles
4 threads running 0-24999 25000-49999 50000 -74999 75000-100000
at synchronization points need to wait for lagging threads for temporal coherence

How can all threads wait for each other before continuing to execute their concomitant sections of code ?

This is the main code that manages the synchronization of concomitant sections of code:
- Each thread signals to main code that it is waiting for synchronization.
- The main code waits for each of all threads, then sends the synchronization signal to all threads.

The synchronization uses the following keywords from threading:
- In each thread : 'Condsignal' (to send signal to main code) then 'Condwait' (to wait signal from main code).
- In main code : 'Condwait' (to wait signal from each thread) then 'Condbroadcast' (to send signal to all threads).
With the associated mutexes and conditional variables and flags.

Test example highlighting the structure of threads and their behaviors, when synchronizing all threads to execute their concomitant sections of code:

Code: Select all

Dim threadnumber As Integer = 4

'' global data for all threads
    Dim Shared restart1 As Integer = 0
    Dim Shared restart2 As Integer = 0
    Dim Shared threadcount As Integer = 0
    
    Dim Shared hmutexrestart As Any Ptr
    Dim Shared hcondrestart As Any Ptr
    Dim Shared hmutexready As Any Ptr
    Dim Shared hcondready As Any Ptr

'' structure for specific data to each thread
    Type UDT
        Dim id As Integer
    End Type

Dim u(1 To threadnumber) As UDT

Sub mythread(ByVal p As Any Ptr)
    
    Dim id As Integer = Cptr(UDT Ptr, p)->id
    
            '' just for visualizing the thread status
                Print "   Thread #" & id & " is started..."
        
    '' instead of starting user code
        Sleep id * 40, 1
        
            '' just for visualizing the thread status
                Print "      Thread #" & id & " is running..."
                Sleep id * 20, 1  '' just to well visualize thread interlacing
                Print "   Thread #" & id & " is waiting 1sr time for synchronization..."
        
    '' send signal to main code
        Mutexlock hmutexready
            threadcount += 1
            Condsignal hcondready
        Mutexunlock hmutexready
   
    '' waiting signal from main code
        Mutexlock hmutexrestart
            Do While restart1 = 0   
                Condwait hcondrestart, hmutexrestart
            Loop
        Mutexunlock hmutexrestart

            '' just for visualizing the thread status
                Print "   Thread #" & id & " is reactivated 1st time..."

    '' instead of 1st time synchronized user code
        Sleep id * 40, 1

            '' just for visualizing the thread status
                Print "      Thread #" & id & " is continuing 1st time..."
                Sleep id * 20, 1  '' just to well visualize thread interlacing
                Print "   Thread #" & id & " is waiting 2nd time for synchronization..."
    
    '' send signal to main code
        Mutexlock hmutexready
            threadcount += 1
            Condsignal hcondready
        Mutexunlock hmutexready
   
    '' waiting signal from main code
        Mutexlock hmutexrestart
            Do While restart2 = 0   
                Condwait hcondrestart, hmutexrestart
            Loop
        Mutexunlock hmutexrestart

            '' just for visualizing the thread status
                Print "   Thread #" & id & " is reactivated 2nd time..."

    '' instead of 2nd time synchronized user code
        Sleep id * 40, 1

            '' just for visualizing the thread status
                Print "      Thread #" & id & " is continuing 2nd time..."
                Sleep id * 20, 1  '' just to well visualize thread interlacing
                Print "   Thread #" & id & " is finishing execution..."
    
End Sub


Dim threads(1 To threadnumber) As Any Ptr

hcondrestart = Condcreate()
hmutexrestart = Mutexcreate()
hcondready = Condcreate()
hmutexready = MutexCreate()

        '' just for visualizing the main code status
            Print "Start all threads from main code :"
        
'' starting all threads
    For i As Integer = 1 To threadnumber
        u(i).id = i
        threads(i) = Threadcreate(@mythread, @u(i))
    Next i

'' waiting for all threads waiting for synchronisation
    Mutexlock hmutexready
        Do Until threadcount = threadnumber
            Condwait(hcondready, hmutexready)
        Loop
        threadcount = 0
    Mutexunlock hmutexready

        '' just for visualizing the main code status
            Print "All thread seen waiting 1st time from main code"
            
        '' just for visualizing the main code status
            Print
            Print "Reactivate 1st time all threads from main code :"
        
'' reactivating all threads
    Mutexlock hmutexrestart
        restart1 = 1
        Condbroadcast hcondrestart
    Mutexunlock hmutexrestart

'' waiting for all threads waiting for synchronisation
    Mutexlock hmutexready
        Do Until threadcount = threadnumber
            Condwait(hcondready, hmutexready)
        Loop
    Mutexunlock hmutexready

        '' just for visualizing the main code status
            Print "All thread seen waiting 2nd time from main code"
            
        '' just for visualizing the main code status
            Print
            Print "Reactivate 2nd time all threads from main code :"
        
'' reactivating all threads
    Mutexlock hmutexrestart
        restart2 = 1
        Condbroadcast hcondrestart
    Mutexunlock hmutexrestart

'' waiting for all threads to be completed
    For i As Integer = 1 To threadnumber
        If threads(i) <> 0 Then
            Threadwait threads(i)
        End If
    Next i
    
        '' just for visualizing the main code status
            Print "All thread seen completed from main code"
            Print

Mutexdestroy hmutexready
Conddestroy hcondready
Mutexdestroy hmutexrestart
Conddestroy hcondrestart

Sleep

• Output (for example):

  Code: Select all

  Start all threads from main code :
     Thread #1 is started...
     Thread #2 is started...
     Thread #3 is started...
     Thread #4 is started...
        Thread #1 is running...
     Thread #1 is waiting 1sr time for synchronization...
        Thread #2 is running...
        Thread #3 is running...
     Thread #2 is waiting 1sr time for synchronization...
        Thread #4 is running...
     Thread #3 is waiting 1sr time for synchronization...
     Thread #4 is waiting 1sr time for synchronization...
  All thread seen waiting 1st time from main code
  
  Reactivate 1st time all threads from main code :
     Thread #4 is reactivated 1st time...
     Thread #3 is reactivated 1st time...
     Thread #2 is reactivated 1st time...
     Thread #1 is reactivated 1st time...
        Thread #1 is continuing 1st time...
     Thread #1 is waiting 2nd time for synchronization...
        Thread #2 is continuing 1st time...
        Thread #3 is continuing 1st time...
     Thread #2 is waiting 2nd time for synchronization...
        Thread #4 is continuing 1st time...
     Thread #3 is waiting 2nd time for synchronization...
     Thread #4 is waiting 2nd time for synchronization...
  All thread seen waiting 2nd time from main code
  
  Reactivate 2nd time all threads from main code :
     Thread #4 is reactivated 2nd time...
     Thread #3 is reactivated 2nd time...
     Thread #2 is reactivated 2nd time...
     Thread #1 is reactivated 2nd time...
        Thread #1 is continuing 2nd time...
     Thread #1 is finishing execution...
        Thread #2 is continuing 2nd time...
     Thread #2 is finishing execution...
        Thread #3 is continuing 2nd time...
        Thread #4 is continuing 2nd time...
     Thread #3 is finishing execution...
     Thread #4 is finishing execution...
  All thread seen completed from main code
  

To get an operational code, just suppress all the blocks tagged "just for visualizing the ...", and replace the blocks tagged "instead of ..." by the true user code.
Example of printing by each thread : "stN" 8 times, then synchronization, then "rtN" 8 times, then synchronization, then "ftN" 8times, with N=thread number:

Code: Select all

Dim threadnumber As Integer = 4

'' global data for all threads
    Dim Shared restart1 As Integer = 0
    Dim Shared restart2 As Integer = 0
    Dim Shared threadcount As Integer = 0
    
    Dim Shared hmutexrestart As Any Ptr
    Dim Shared hcondrestart As Any Ptr
    Dim Shared hmutexready As Any Ptr
    Dim Shared hcondready As Any Ptr

'' structure for specific data to each thread
    Type UDT
        Dim id As Integer
    End Type

Dim u(1 To threadnumber) As UDT

Sub mythread(ByVal p As Any Ptr)
    
    Dim id As Integer = Cptr(UDT Ptr, p)->id
    
    '' instead of starting user code
        For i As Integer = 1 To 8
            Print " st" & id;
            Sleep id * 40, 1
        Next i
        
    '' send signal to main code
        Mutexlock hmutexready
            threadcount += 1
            Condsignal hcondready
        Mutexunlock hmutexready
   
    '' waiting signal from main code
        Mutexlock hmutexrestart
            Do While restart1 = 0   
                Condwait hcondrestart, hmutexrestart
            Loop
        Mutexunlock hmutexrestart

    '' instead of 1st time synchronized user code
        For i As Integer = 1 To 8
            Print " rt" & id;
            Sleep id * 40, 1
        Next i

    '' send signal to main code
        Mutexlock hmutexready
            threadcount += 1
            Condsignal hcondready
        Mutexunlock hmutexready
   
    '' waiting signal from main code
        Mutexlock hmutexrestart
            Do While restart2 = 0   
                Condwait hcondrestart, hmutexrestart
            Loop
        Mutexunlock hmutexrestart

    '' instead of 2nd time synchronized user code
        For i As Integer = 1 To 8
            Print " ft" & id;
            Sleep id * 40, 1
        Next i

End Sub


Dim threads(1 To threadnumber) As Any Ptr

hcondrestart = Condcreate()
hmutexrestart = Mutexcreate()
hcondready = Condcreate()
hmutexready = MutexCreate()

'' starting all threads
    For i As Integer = 1 To threadnumber
        u(i).id = i
        threads(i) = Threadcreate(@mythread, @u(i))
    Next i

'' waiting for all threads waiting for synchronisation
    Mutexlock hmutexready
        Do Until threadcount = threadnumber
            Condwait(hcondready, hmutexready)
        Loop
        threadcount = 0
    Mutexunlock hmutexready

Print
Print
        
'' reactivating all threads
    Mutexlock hmutexrestart
        restart1 = 1
        Condbroadcast hcondrestart
    Mutexunlock hmutexrestart

'' waiting for all threads waiting for synchronisation
    Mutexlock hmutexready
        Do Until threadcount = threadnumber
            Condwait(hcondready, hmutexready)
        Loop
    Mutexunlock hmutexready

Print
Print

'' reactivating all threads
    Mutexlock hmutexrestart
        restart2 = 1
        Condbroadcast hcondrestart
    Mutexunlock hmutexrestart

'' waiting for all threads to be completed
    For i As Integer = 1 To threadnumber
        If threads(i) <> 0 Then
            Threadwait threads(i)
        End If
    Next i

Print
Print
    
Mutexdestroy hmutexready
Conddestroy hcondready
Mutexdestroy hmutexrestart
Conddestroy hcondrestart

Sleep

• Output (for example):

  Code: Select all

   st1 st2 st3 st4 st1 st1 st2 st3 st1 st4 st2 st1 st1 st3 st2 st1 st4 st1 st2 st3 st2 st4 st3 st2 st2 st3 st4 st3 st4 st3 st4 st4
  
   rt2 rt4 rt3 rt1 rt1 rt2 rt1 rt3 rt1 rt4 rt2 rt1 rt3 rt2 rt1 rt1 rt4 rt2 rt1 rt3 rt2 rt4 rt2 rt3 rt2 rt3 rt4 rt3 rt4 rt3 rt4 rt4
  
   ft2 ft3 ft1 ft4 ft1 ft2 ft1 ft3 ft1 ft4 ft2 ft1 ft1 ft3 ft2 ft1 ft4 ft1 ft2 ft3 ft2 ft4 ft3 ft2 ft2 ft3 ft4 ft3 ft4 ft3 ft4 ft4
  

For more information (than the threading keyword documentation pages), see also the 'Multi-Threading' section I wrote in the Programmer's Guide.

[fxm]

Is 'Condwait' (and 'Condsignal' / 'Condbroadcast' + mutexes) still useful when there is already a 'Do While/Until ...Loop' loop for checking a Boolean predicate managed by the other thread(s) ?

If 'CondWait' is not used, it is mandatory to put instead a 'Sleep x, 1' instruction in the 'Do While/Until ...Loop' loop on the Boolean flag, in order to release time-slice when looping.

During 'CondWait', the thread execution is suspended and does not consume any CPU time until the condition variable is signaled.
But if 'Sleep x, 1' is put instead, the waiting time is predetermined and not self adaptive like that of 'CondWait'.

=> 'CondWait' is useful to optimize the execution time