wth -- Thread time .vs Subroutine time

General FreeBASIC programming questions.
Post Reply
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: wth -- Thread time .vs Subroutine time

Post by fxm »

On my PC, I replaced in the user procedure:
Sleep 100, 1
with:
For J As Integer = 1 To 73000000
Next J


Now, I find a parallelism gain up to 4 secondary threads only (I am now reassured!):
'ThreadInitThenMultiStart' with 1 secondary thread:
00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVV
7.47 s

'ThreadPooling' with 1 secondary thread:
00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVV
7.46 s


'ThreadInitThenMultiStart' with 2 secondary threads:
01012323454567678989ABABCDCDEFEFGHGHIJIJKLKLNMNMPOPOQRQRSTSTUVUV
4.08 s

'ThreadPooling' with 2 secondary threads:
01012323454567679898BABACDCDEFEFGHGHJIJILKLKNMNMPOPOQRQRSTTSVUVU
4.28 s


'ThreadInitThenMultiStart' with 4 secondary threads:
012312034576465789BAAB89CDEFECFDGHIJHGIJKLMNMLNKOPQROQPRSTUVTUVS
2.24 s

'ThreadPooling' with 4 secondary threads:
0123123047567456B89AB89AFCDEFCDEJGIHJGHINKMLNKMLROQPROQPVSUTVSUT
2.22 s


'ThreadInitThenMultiStart' with 8 secondary threads:
016345270345612789ABCDFE98ABEDFCGHIJKGLNIMHJLMKNOPQRSUTVPQORUTSV
2.32 s

'ThreadPooling' with 8 secondary threads:
01234567012364578AB9EDF8C9BDEAGCFHILMJNGKIJLHMROQKNPUTRVQSOUTPSV
2.24 s


'ThreadInitThenMultiStart' with 16 secondary threads:
0123546798ABCEDF4036975BACE218DFGHJIKLMNOPQRSTUVGIJHKLQPNOMSTRUV
2.24 s

'ThreadPooling' with 16 secondary threads:
0123456789ABCDEF01237859CD6AB4FENHIPLJSMQOTGVULQHKPNJISRMGTUVKOR
2.29 s


'ThreadInitThenMultiStart' with 32 secondary threads:
0123467589BACDEFGHI043167529CABFD8EGIHJKLMNOPQSRTUVKMNLJSQPRUTOV
2.23 s

'ThreadPooling' with 32 secondary threads:
013245671USTRQPVOMNKLIJGHFECDBA9803267UTVOJMLG4S5QPNKFRIEHA9B8CD
2.24 s
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: wth -- Thread time .vs Subroutine time

Post by deltarho[1859] »

@fxm

Yes, your last timings show what happens when we request more than what our system can accommodate. In fact, your very last test would leave an Intel 10 Core/20 Threads wanting.
adeyblue wrote:...this is becomes #include "threadpool.bi" as an integral part of the distribution feature set rather than an unfortunately under viewed part of the wiki
@coderJeff

Seconded.

I am now tempted to use ThreadPooling in CryptoRndII. It would then be even easier to read. I would then have to do another PractRand test. What a pain that is - fours hours per TB - on my i7 using multithreading!
adeyblue
Posts: 299
Joined: Nov 07, 2019 20:08

Re: wth -- Thread time .vs Subroutine time

Post by adeyblue »

So I took fxms latest ThreadPooling Type code and refactored it a bit so we can wait for individual jobs, an arbitrary group of jobs or all of them as currently. This did necessitate splitting some things into a second type so the user has something to wait with - you don't really want to have to try and guess the array index of the job you want after submitting 25, with 7 of them already having been completed. The slight downside is now that the jobs don't live in the ThreadPool object, the job pointers have to be Delete-d

If FB had a semaphore type, that'd be much better than the condition variable in the main ThreadPool type, but until then...

Code: Select all

#include "fbc-int/memory.bi"
''#include "fbthread.bi"

Type PoolJob
Private:
	Dim _done As Boolean
	Dim _condVar As Any Ptr
	Dim _mutex As Any Ptr
	
Public:
	Dim pThread As Function(Byval As Any Ptr) As String
	Dim pArg As Any Ptr
	Dim returnVal As String
	
	Declare Constructor(ByVal pThread As Function(Byval As Any Ptr) As String, ByVal pArg As Any Ptr)
	Declare Destructor()
	Declare Sub _MarkCompletion(ByRef value As String)
	
	Declare Function WaitForCompletion() As String
	Declare Static Sub WaitForCompletion(jobs() As PoolJob Ptr)
	Declare Property ReturnValue() As String
End Type

Private Constructor PoolJob(ByVal pUserFunc As Function(Byval As Any Ptr) As String, ByVal pUserArg As Any Ptr)
	_condVar = CondCreate()
	_mutex = MutexCreate()
	pThread = pUserFunc
	pArg = pUserArg
End Constructor

Private Destructor PoolJob()
	CondDestroy(_condVar)
	MutexDestroy(_mutex)
End Destructor

Private Sub PoolJob._MarkCompletion(ByRef value As String)
	MutexLock(_mutex)
		returnVal = value
		_done = True
	MutexUnlock(_mutex)
	CondBroadcast(_condVar)
End Sub

Private Function PoolJob.WaitForCompletion() As String
	If _done = False Then
		MutexLock(_mutex)
		While _done = False
			CondWait(_condVar, _mutex)
		Wend
		MutexUnlock(_mutex)
	End If
	Return returnVal 
End Function

Private Sub PoolJob.WaitForCompletion(jobs() As PoolJob Ptr)
	dim As Long arrLBound, arrUBound, arrElems
	arrLBound = LBound(jobs)
	arrUBound = UBound(jobs)
	For i As Long = arrLBound To arrUBound
		jobs(i)->WaitForCompletion()
	Next
End Sub

Private Property PoolJob.ReturnValue() As String
	Return WaitForCompletion()
End Property

Type ThreadPool
    Public:
        Declare Constructor(ByVal numThreads As Long = 4)
        Declare Function Submit(Byval pThread As Function(Byval As Any Ptr) As String, Byval p As Any Ptr = 0) As PoolJob Ptr
        Declare Sub WaitForAllCurrentJobs()
		Declare Sub Shutdown()
        Declare Destructor()
    Private:
		Const _sentinel As Long = &H80000000
		Dim _pendingJobs(Any) As PoolJob Ptr
		Dim _numJobs As Long
		Dim _threads(Any) As Any Ptr
		Dim _jobsMutex As Any Ptr
		Dim _condVar As Any Ptr
        Declare Static Sub _Thread(Byval p As Any Ptr)
        Declare Sub _PushJob(ByVal pJob As PoolJob Ptr)
        Declare Function _PopJob() As PoolJob Ptr
End Type

Constructor ThreadPool(ByVal numThreads As Long)
	Dim i As Long
	Redim This._threads(0 To numThreads - 1)
	Redim This._pendingJobs(0)
	This._numJobs = 0
    This._jobsMutex = MutexCreate()
    This._condVar = CondCreate()
    For i = 0 To numThreads - 1
		This._threads(i) = ThreadCreate(@ThreadPool._Thread, @This)
	Next
End Constructor

Function ThreadPool.Submit(Byval pThread As Function(Byval As Any Ptr) As String, Byval p As Any Ptr = 0) As PoolJob Ptr
    Dim pNewJob As PoolJob Ptr = New PoolJob(pThread, p)
    MutexLock(_jobsMutex)
		_PushJob(pNewJob)
    MutexUnlock(_jobsMutex)
    CondBroadcast(_condVar)
    Return pNewJob
End Function

Sub ThreadPool._PushJob(ByVal pJob As PoolJob Ptr)
	Redim Preserve _pendingJobs(0 To _numJobs + 1)
	_pendingJobs(_numJobs) = pJob
	_numJobs += 1
	''Print "Added job " & Hex(pJob)
End Sub

Sub ThreadPool.WaitForAllCurrentJobs()
	MutexLock(_jobsMutex)
		Dim currentJobs(0 To _numJobs - 1) As PoolJob Ptr
		FBC.memcopy(@currentJobs(0), @_pendingJobs(0), _numJobs * Sizeof(PoolJob Ptr))
	MutexUnlock(_jobsMutex)
	PoolJob.WaitForCompletion(currentJobs())
End Sub

Function ThreadPool._PopJob() As PoolJob Ptr
	Assert(_numJobs > 0)
	
	Dim pJob As PoolJob Ptr = _pendingJobs(0)
	_numJobs -= 1
	FBC.memmove(@_pendingJobs(0), @_pendingJobs(1), _numJobs * Sizeof(pJob))
	Redim Preserve _pendingJobs(0 To _numJobs)
	Return pJob
End Function

Sub ThreadPool._Thread(Byval p As Any Ptr)
    Dim As ThreadPool Ptr pThis = p
    Do
		MutexLock(pThis->_jobsMutex)
		While pThis->_numJobs = 0
			''Print Using "Thread & waiting"; Hex(ThreadSelf())
			CondWait(pThis->_condVar, pThis->_jobsMutex)
		Wend
		If pThis->_numJobs < 0 Then
			''Print Using "Thread & exiting"; Hex(ThreadSelf())
			MutexUnlock(pThis->_jobsMutex)
			Exit Do
		End If
		Dim pNextJob As PoolJob Ptr = pThis->_PopJob()
		MutexUnlock(pThis->_jobsMutex)
		Assert(pNextJob <> 0)
		''Print Using "Thread & got job &"; Hex(ThreadSelf()); Hex(pNextJob)
		Dim retVal As String = pNextJob->pThread(pNextJob->pArg)
		pNextJob->_MarkCompletion(retVal)
    Loop
End Sub

Sub ThreadPool.Shutdown()
	If _numJobs < 0 Then 
		Exit Sub
	End If
	MutexLock(_jobsMutex)
		_numJobs = _sentinel
	MutexUnlock(_jobsMutex)
	CondBroadcast(_condVar)
	Dim i As Long
	For i = 0 To UBound(_threads) - 1
		ThreadWait(_threads(i))
	Next
	Dim emptyString As String
	For i = 0 To UBound(_pendingJobs) - 1
		_pendingJobs(i)->_MarkCompletion(emptyString)
	Next
End Sub

Destructor ThreadPool()
    Shutdown()
    MutexDestroy(_jobsMutex)
    CondDestroy(_condVar)
End Destructor

Code: Select all

#include "threadpool.bi"

Function UserCode (Byval p As Any Ptr) As String
    dim num As Integer = cast(Integer, p)
    dim ret As String = Str(num)
    For I As Integer = 1 To 9
        Print ret;
        Sleep num * 100, 1
    Next I
    Return ret
End Function

Dim numJobs As Long = 8
Dim pool As ThreadPool = 5
Dim items(0 To numJobs - 1) As PoolJob Ptr
Dim returnvalues(0 To numJobs - 1) As String
Dim i As Long

'' I really should start at 1 but my C-based brain won't allow it
For i = 0 To numJobs - 1
    dim arg As Integer = i + 1
    items(i) = pool.Submit(@UserCode, cast(Any Ptr, arg))
Next

'' do whatever

For i = 0 To numJobs - 1
    returnValues(i) = items(i)->WaitForCompletion()
    Delete items(i)
Next

For i = 0 To numJobs - 1
    Print Using "Job & returned &"; i + 1; returnValues(i)
Next
Last edited by adeyblue on Feb 13, 2021 2:07, edited 2 times in total.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: wth -- Thread time .vs Subroutine time

Post by deltarho[1859] »

Yours truly wrote:I am now tempted to use ThreadPooling in CryptoRndII.
I did but TheadPooling was much slower than ThreadInitThenMultiStart. Doing tests in the laboratory is one thing, doing tests out in the streets is another thing. I used one of fxm's earlier versions of ThreadInitThenMultiStart because CryptoRndII did not need the added features of later versions. So I didn't bother with a PractRand test. When using multiple instances of TheadPooling the reduction in statements used compared with ThreadInitThenMultiStart was small.

I think it highly unlikely that ThreadPooling will outperform ThreadInitThenMultiStart no matter how they are used. I think that the rule of thumb will be that ThreadPooling will be as fast or slower than ThreadInitThenMultiStart. I am totally sold on ThreadInitThenMultiStart for all future threading work but will probably not use ThreadPooling. I may be wrong, but I have a feeling that Lost Zergling may reach the same conclusion.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: wth -- Thread time .vs Subroutine time

Post by fxm »

Maybe I am pedantic too about your above code, but 'Condsignal()' or 'Condbroadcast()' must be called while mutex is locked (the same as used for the corresponding 'Condwait()'):
The general rule is that:
- The condition must not be signaled (by Condsignal() or Condbroadcast()) between the time a thread locks the mutex and the time it waits on the condition variable (CondWait()), otherwise it seems that it may damage the waiting queue of threads on that condition variable.
- Thus to avoid that and follow this rule, it is necessary that the mutex remains locked when the condition is signaled.
So I would prefer:

Code: Select all

.....
   MutexLock(_mutex)
      returnVal = value
      _done = True
      CondBroadcast(_condVar)
   MutexUnlock(_mutex)
.....
    MutexLock(_jobsMutex)
      _PushJob(pNewJob)
       CondBroadcast(_condVar)
    MutexUnlock(_jobsMutex)
.....
   MutexLock(_jobsMutex)
      _numJobs = _sentinel
      CondBroadcast(_condVar)
   MutexUnlock(_jobsMutex)
.....
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: wth -- Thread time .vs Subroutine time

Post by fxm »

deltarho[1859] wrote:I used one of fxm's earlier versions of ThreadInitThenMultiStart because CryptoRndII did not need the added features of later versions.
What are these additional features that you might find penalizing ?

As for the 'ThreadState' property, I think the only interesting case we could keep is:
- completing (user thread procedure completed, but waiting for 'ThreadWait')
with a value of '1' if true, and call it for example: 'ThreadCompletingState'.
Last edited by fxm on Feb 13, 2021 7:21, edited 1 time in total.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: wth -- Thread time .vs Subroutine time

Post by deltarho[1859] »

fxm wrote:What are these additional features that you might find penalizing ?
None of them. My last post in 'A fast CPRNG' thread says: "fxm has been developing even more powerful code, but the code used above is just right for CryptoRndII purposes." In other words there was no need to rip out code and replace it with newer code with features not needed, and I'd have to test it with PractRand again.
As for the 'ThreadState' property, I think the only interesting case we could keep is:
- completing (user thread procedure completed, but waiting for 'ThreadWait')
with a value of '1' if true.
The others may be useful in debugging, so I would be inclined to leave them in. I can imagine some folk writing User procedures that do not behave as planned.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: wth -- Thread time .vs Subroutine time

Post by fxm »

deltarho[1859] wrote:
Yours truly wrote:I am now tempted to use ThreadPooling in CryptoRndII.
I did but TheadPooling was much slower than ThreadInitThenMultiStart
As 'ThreadPooling' uses arrays internally, comparison with 'ThreadInitThenMultiStart' must be done without the '-exx' compile option.

'ThreadPooling' is not adapted to work piecemeal (PoolingSubmit : PoolingWait : PoolingSubmit : PoolingWait ...) like 'ThreadInitThenMultiStart' (ThreadInit : ThreadStart : ThreadWait : ThreadInit : ThreadStart : ThreadWait ...) due to the principle chosen in 'PoolingWait' (stopping then restarting the internal thread).
But from a sequence of 10 'PoolingSubmit' followed by 1 'PoolingWait', the performance becomes equivalent to 10 'ThreadInit: ThreadStart: ThreadWait', then a little better after.

The execution time of 'ThreadPooling' can be improved a little by changing in 'ThreadPooling._Thread()' the way of shifting the content of the two arrays by one step:
In 'ThreadPooling._Thread()':
replace:

Code: Select all

        For I As Integer = 2 To Ubound(pThis->_pThread)
            pThis->_pThread(I - 1) = pThis->_pThread(I)
            pThis->_p(I - 1) = pThis->_p(I)
        Next I
with:

Code: Select all

        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
  • plus: #include once "crt/string.bi"
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: wth -- Thread time .vs Subroutine time

Post by deltarho[1859] »

fxm wrote:The execution time of 'ThreadPooling' can be improved a little ...
It was but TheadPooling was still some way behind ThreadInitThenMultiStart.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: wth -- Thread time .vs Subroutine time

Post by fxm »

fxm wrote:ThreadPooling' is not adapted to work piecemeal (PoolingSubmit : PoolingWait : PoolingSubmit : PoolingWait ...) like 'ThreadInitThenMultiStart' (ThreadInit : ThreadStart : ThreadWait : ThreadInit : ThreadStart : ThreadWait ...) due to the principle chosen in 'PoolingWait' (stopping then restarting the internal thread).
But from a sequence of 10 'PoolingSubmit' followed by 1 'PoolingWait', the performance becomes equivalent to 10 'ThreadInit: ThreadStart: ThreadWait', then a little better after.
I modified 'PoolingWait' to no longer restart the internal thread, by adding a mutex only (_mutex3).
Now, the 'ThreadPooling' results are more similar with 'ThreadInitThenMultiStart' and even a little better when filling in the internal queue with several submissions before request 'PoolingWait'.

- Testing with the current version of 'ThreadPooling' (worst case with an empty user procedure):

Code: Select all

Type ThreadInitThenMultiStart
    Public:
        Declare Constructor()
        Declare Sub ThreadInit(Byval pThread As Function(Byval As Any Ptr) As String, Byval p As Any Ptr = 0)
        Declare Sub ThreadStart()
        Declare Sub ThreadStart(Byval p As Any Ptr)
        Declare Function ThreadWait() As String
        
        Declare Property ThreadState() As Ubyte
        
        Declare Destructor()
    Private:
        Dim As Function(Byval p As Any Ptr) As String _pThread
        Dim As Any Ptr _p
        Dim As Any Ptr _mutex1
        Dim As Any Ptr _mutex2
        Dim As Any Ptr _mutex3
        Dim As Any Ptr _pt
        Dim As Byte _end
        Dim As String _returnF
        Dim As Ubyte _state
        Declare Static Sub _Thread(Byval p As Any Ptr)
End Type

Constructor ThreadInitThenMultiStart()
    This._mutex1 = Mutexcreate()
    Mutexlock(This._mutex1)
    This._mutex2 = Mutexcreate()
    Mutexlock(This._mutex2)
    This._mutex3 = Mutexcreate()
    Mutexlock(This._mutex3)
End Constructor

Sub ThreadInitThenMultiStart.ThreadInit(Byval pThread As Function(Byval As Any Ptr) As String, Byval p As Any Ptr = 0)
    This._pThread = pThread
    This._p = p
    If This._pt = 0 Then
        This._pt= Threadcreate(@ThreadInitThenMultiStart._Thread, @This)
        Mutexunlock(This._mutex3)
        This._state = 1
    End If
End Sub

Sub ThreadInitThenMultiStart.ThreadStart()
    Mutexlock(This._mutex3)
    Mutexunlock(This._mutex1)
End Sub

Sub ThreadInitThenMultiStart.ThreadStart(Byval p As Any Ptr)
    Mutexlock(This._mutex3)
    This._p = p
    Mutexunlock(This._mutex1)
End Sub

Function ThreadInitThenMultiStart.ThreadWait() As String
    Mutexlock(This._mutex2)
    Mutexunlock(This._mutex3)
    This._state = 1
    Return This._returnF
End Function

Property ThreadInitThenMultiStart.ThreadState() As Ubyte
    Return This._state
End Property

Sub ThreadInitThenMultiStart._Thread(Byval p As Any Ptr)
    Dim As ThreadInitThenMultiStart Ptr pThis = p
    Do
        Mutexlock(pThis->_mutex1)
        If pThis->_end = 1 Then Exit Sub
        pThis->_state = 2
        pThis->_returnF = pThis->_pThread(pThis->_p)
        pThis->_state = 4
        Mutexunlock(pThis->_mutex2)
    Loop
End Sub

Destructor ThreadInitThenMultiStart()
    If This._pt > 0 Then
        This._end = 1
        Mutexunlock(This._mutex1)
        .ThreadWait(This._pt)
    End If
    Mutexdestroy(This._mutex1)
    Mutexdestroy(This._mutex2)
    Mutexdestroy(This._mutex3)
End Destructor

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

Type 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 _mutex1
        Dim As Any Ptr _mutex2
        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._mutex1 = Mutexcreate()
    This._mutex2 = Mutexcreate()
    Mutexlock(This._mutex2)
    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._mutex1)
    If Ubound(This._pThread) = 0 Then
        Mutexunlock(This._mutex2)
    End If
    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
    Mutexunlock(This._mutex1)
    This._state = 1
End Sub

Sub ThreadPooling.PoolingWait()
    This._end = 1
    Mutexunlock(This._mutex2)
    .ThreadWait(This._pt)
    This._end = 0
    Redim This._returnF(0)
    This._state = 0
    This._pt= Threadcreate(@ThreadPooling._Thread, @This)
End Sub

Sub ThreadPooling.PoolingWait(values() As String)
    This._end = 1
    Mutexunlock(This._mutex2)
    .ThreadWait(This._pt)
    This._end = 0
    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
    This._pt= Threadcreate(@ThreadPooling._Thread, @This)
End Sub

Property ThreadPooling.PoolingState() As Ubyte
    Return This._state
End Property

Sub ThreadPooling._Thread(Byval p As Any Ptr)
    Dim As ThreadPooling Ptr pThis = p
    Do
        Mutexlock(pThis->_mutex1)
        While Ubound(pThis->_pThread) = 0
            Mutexunlock(pThis->_mutex1)
            pThis->_state = 4
            Mutexlock(pThis->_mutex2)
            If pThis->_end = 1 And Ubound(pThis->_pThread) = 0 Then Exit Sub
            Mutexlock(pThis->_mutex1)
        Wend
        pThis->_pThread0 = pThis->_pThread(1)
        pThis->_p0 = pThis->_p(1)
        For I As Integer = 2 To Ubound(pThis->_pThread)
            pThis->_pThread(I - 1) = pThis->_pThread(I)
            pThis->_p(I - 1) = pThis->_p(I)
        Next I
        Redim Preserve pThis->_pThread(Ubound(pThis->_pThread) - 1)
        Redim Preserve pThis->_p(Ubound(pThis->_p) - 1)
        Mutexunlock(pThis->_mutex1)
        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()
    This._end = 1
    Mutexunlock(This._mutex2)
    .ThreadWait(This._pt)
    Mutexdestroy(This._mutex1)
    Mutexdestroy(This._mutex2)
End Destructor

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

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


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

Print "Sequence of 10000 [ta.ThreadInit(@UserCode):ta.ThreadStart():ta.ThreadWait()]"
t = Timer
For I As Integer = 1 To 10000
    ta.ThreadInit(@UserCode)
    ta.ThreadStart()
    ta.ThreadWait()
Next I
t = Timer - t
Print t; " s"
Print

Print "Sequence of 10000 [tb.PoolingSubmit(@UserCode):tb.PoolingWait()]"
t = Timer
For I As Integer = 1 To 10000
    tb.PoolingSubmit(@UserCode)
    tb.PoolingWait()
Next I
t = Timer - t
Print t; " s"
Print

Print "Sequence of 10000 [tb.PoolingSubmit(@UserCode)] ended by 1 [tb.PoolingWait()]
t = Timer
For I As Integer = 1 To 10000
    tb.PoolingSubmit(@UserCode)
Next I
tb.PoolingWait()
t = Timer - t
Print t; " s"

Sleep
Sequence of 10000 [ta.ThreadInit(@UserCode):ta.ThreadStart():ta.ThreadWait()]
0.1496771000024921 s

Sequence of 10000 [tb.PoolingSubmit(@UserCode):tb.PoolingWait()]
1.224177599985183 s


Sequence of 10000 [tb.PoolingSubmit(@UserCode)] ended by 1 [tb.PoolingWait()]
0.1206457999761597 s
- Testing with the new version of 'ThreadPooling' (worst case with an empty user procedure):

Code: Select all

Type ThreadInitThenMultiStart
    Public:
        Declare Constructor()
        Declare Sub ThreadInit(Byval pThread As Function(Byval As Any Ptr) As String, Byval p As Any Ptr = 0)
        Declare Sub ThreadStart()
        Declare Sub ThreadStart(Byval p As Any Ptr)
        Declare Function ThreadWait() As String
        
        Declare Property ThreadState() As Ubyte
        
        Declare Destructor()
    Private:
        Dim As Function(Byval p As Any Ptr) As String _pThread
        Dim As Any Ptr _p
        Dim As Any Ptr _mutex1
        Dim As Any Ptr _mutex2
        Dim As Any Ptr _mutex3
        Dim As Any Ptr _pt
        Dim As Byte _end
        Dim As String _returnF
        Dim As Ubyte _state
        Declare Static Sub _Thread(Byval p As Any Ptr)
End Type

Constructor ThreadInitThenMultiStart()
    This._mutex1 = Mutexcreate()
    Mutexlock(This._mutex1)
    This._mutex2 = Mutexcreate()
    Mutexlock(This._mutex2)
    This._mutex3 = Mutexcreate()
    Mutexlock(This._mutex3)
End Constructor

Sub ThreadInitThenMultiStart.ThreadInit(Byval pThread As Function(Byval As Any Ptr) As String, Byval p As Any Ptr = 0)
    This._pThread = pThread
    This._p = p
    If This._pt = 0 Then
        This._pt= Threadcreate(@ThreadInitThenMultiStart._Thread, @This)
        Mutexunlock(This._mutex3)
        This._state = 1
    End If
End Sub

Sub ThreadInitThenMultiStart.ThreadStart()
    Mutexlock(This._mutex3)
    Mutexunlock(This._mutex1)
End Sub

Sub ThreadInitThenMultiStart.ThreadStart(Byval p As Any Ptr)
    Mutexlock(This._mutex3)
    This._p = p
    Mutexunlock(This._mutex1)
End Sub

Function ThreadInitThenMultiStart.ThreadWait() As String
    Mutexlock(This._mutex2)
    Mutexunlock(This._mutex3)
    This._state = 1
    Return This._returnF
End Function

Property ThreadInitThenMultiStart.ThreadState() As Ubyte
    Return This._state
End Property

Sub ThreadInitThenMultiStart._Thread(Byval p As Any Ptr)
    Dim As ThreadInitThenMultiStart Ptr pThis = p
    Do
        Mutexlock(pThis->_mutex1)
        If pThis->_end = 1 Then Exit Sub
        pThis->_state = 2
        pThis->_returnF = pThis->_pThread(pThis->_p)
        pThis->_state = 4
        Mutexunlock(pThis->_mutex2)
    Loop
End Sub

Destructor ThreadInitThenMultiStart()
    If This._pt > 0 Then
        This._end = 1
        Mutexunlock(This._mutex1)
        .ThreadWait(This._pt)
    End If
    Mutexdestroy(This._mutex1)
    Mutexdestroy(This._mutex2)
    Mutexdestroy(This._mutex3)
End Destructor

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

#include once "crt/string.bi"
Type ThreadPooling  '' new version
    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 _mutex1
        Dim As Any Ptr _mutex2
        Dim As Any Ptr _mutex3
        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._mutex1 = Mutexcreate()
    This._mutex2 = Mutexcreate()
    Mutexlock(This._mutex2)
    This._mutex3 = Mutexcreate()
    Mutexlock(This._mutex3)
    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._mutex1)
    If Ubound(This._pThread) = 0 Then
        Mutexunlock(This._mutex2)
    End If
    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
    Mutexunlock(This._mutex1)
    This._state = 1
End Sub

Sub ThreadPooling.PoolingWait()
    Mutexlock(This._mutex3)
    Redim This._returnF(0)
    This._state = 0
    Mutexunlock(This._mutex3)
End Sub

Sub ThreadPooling.PoolingWait(values() As String)
    Mutexlock(This._mutex3)
    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._mutex3)
End Sub

Property ThreadPooling.PoolingState() As Ubyte
    Return This._state
End Property

Sub ThreadPooling._Thread(Byval p As Any Ptr)
    Dim As ThreadPooling Ptr pThis = p
    Do
        Mutexlock(pThis->_mutex1)
        While Ubound(pThis->_pThread) = 0
            Mutexunlock(pThis->_mutex1)
            Mutexunlock(pThis->_mutex3)
            pThis->_state = 4
            Mutexlock(pThis->_mutex2)
            If pThis->_end = 1 And Ubound(pThis->_pThread) = 0 Then Exit Sub
            Mutexlock(pThis->_mutex3)
            Mutexlock(pThis->_mutex1)
        Wend
        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->_mutex1)
        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()
    This._end = 1
    Mutexunlock(This._mutex2)
    .ThreadWait(This._pt)
    Mutexdestroy(This._mutex1)
    Mutexdestroy(This._mutex2)
    Mutexdestroy(This._mutex3)
End Destructor

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

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


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

Print "Sequence of 10000 [ta.ThreadInit(@UserCode):ta.ThreadStart():ta.ThreadWait()]"
t = Timer
For I As Integer = 1 To 10000
    ta.ThreadInit(@UserCode)
    ta.ThreadStart()
    ta.ThreadWait()
Next I
t = Timer - t
Print t; " s"
Print

Print "Sequence of 10000 [tb.PoolingSubmit(@UserCode):tb.PoolingWait()]"
t = Timer
For I As Integer = 1 To 10000
    tb.PoolingSubmit(@UserCode)
    tb.PoolingWait()
Next I
t = Timer - t
Print t; " s"
Print

Print "Sequence of 10000 [tb.PoolingSubmit(@UserCode)] ended by 1 [tb.PoolingWait()]
t = Timer
For I As Integer = 1 To 10000
    tb.PoolingSubmit(@UserCode)
Next I
tb.PoolingWait()
t = Timer - t
Print t; " s"

Sleep
Sequence of 10000 [ta.ThreadInit(@UserCode):ta.ThreadStart():ta.ThreadWait()]
0.1384070999896494 s

Sequence of 10000 [tb.PoolingSubmit(@UserCode):tb.PoolingWait()]
0.152863899992866 s


Sequence of 10000 [tb.PoolingSubmit(@UserCode)] ended by 1 [tb.PoolingWait()]
0.1222732999936227 s
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: wth -- Thread time .vs Subroutine time

Post by deltarho[1859] »

Going from 0.153s to 0.122s is a significant improvement but not enough for my CryptoRndII UserCode. I have used gas and gcc without optimization and found 'ThreadInitThenMultiStart' at least twice as fast as 'ThreadPooling'. An empty UserCode is not a good test.

What we need is a better benchmarking suite with a variety of UserCodes. What we need is a group of members to get involved with their UserCodes, but I regret that hell with freeze over before we see that. I am not having a go at the forum. As with cryptography threading is not an area of interest with many FreeBASIC members who probably don't understand your achievement. Many of the PowerBASIC forum would be very excited if you were developing in PowerBASIC. However I don't think that PowerBASIC would lend itself to your ideas - FreeBASIC has a clear edge over PowerBASIC in this context. I am also a member of the PureBASIC forum, but I am not active there. They also, I guess, would be very excited with your work.

I will see what I can do with different UserCodes but, on my own, it will take quite some time to produce a decent benchmarking suite.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: wth -- Thread time .vs Subroutine time

Post by fxm »

But my main improvement to take into account is between the 2 values ​​in bold:
from 1.22 to 0.15
(a factor of 8 in the best case)
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: wth -- Thread time .vs Subroutine time

Post by deltarho[1859] »

fxm wrote:But my main improvement to take into account is between the 2 values ​​in bold:
Your timings confused me but I can now see what you are getting at.
Yours truly wrote:but not enough for my CryptoRndII UserCode.
So, I didn't try it.

However, I am 'too long in the tooth' to make assumptions, so I did try it.

The difference between the version published in 'A fast CPRNG', using an early version of 'ThreadInitThenMultiStartand', and the new version of 'ThreadPooling' is now negligible; less than 1%.

Wow!

We still need more people involved and a good bunch of UserCodes.

I am going to have to get PractRand out again.

Added: BTW, my latest timing tests are showing both 'ThreadInitThenMultiStartand' and the new 'ThreadPooling' are faster than Microsoft's threadpooling but not by a significant amount according to my definition of significance which is >= 7%; which I have been using for many years.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: wth -- Thread time .vs Subroutine time

Post by fxm »

As soon as I have a bit of time (soon, no doubt!), I will also document this new 'ThreadPooling' following 'ThreadInitThenMultiStart', both in:
- Documentation Forum
- Programmer's Guide.
(I have already booked the locations of this new part!)
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: wth -- Thread time .vs Subroutine time

Post by deltarho[1859] »

@fxm

In your post Feb 13, 2021 where you use " the current version of 'ThreadPooling' " and " the new version of 'ThreadPooling' " I put the new version to PractRand and got a catastrophic failure at 256MB; three times.

I then tried "the current version" and pulled out at 8GB - that seemed to be ticking over OK.

BCryptGenRandom cannot fail on randomness grounds. If the buffers do not switch properly, then we will get into trouble. However, for "the new version" to get to 128MB in one piece tells me that at least 1024 buffers had been switched.

I am guessing here but perhaps adding _mutex3 has created an issue?
Post Reply