How to Manage a Critical Section of the code of a Thread in FB

[fxm]

FB provides built-in support for multi-threaded programming.
A multi-threaded process contains two or more parts that can run concurrently. Each part of such a program is called a thread, and each thread defines a separate path of execution.

What is the difference between a thread and a process?

Process:
- Intuitively, a process is nothing more than the program placed in memory or running with all the run-time environment (or all the resources) associated with it.
- In other words, when your program is located on the hard disk of your machine it is always a program or a simple application, but once executed (or placed in memory) a set of resources (amount of memory space occupied, used processor registers and its status, the owner of the process, the permitted operations, ...) is assigned to it and it simply changes its name. It becomes a process.
- So to simplify, process rhymes with program running.

Thread:
- A thread is a portion or part of the process and the smallest sequential unit of instructions processed independently by the scheduler of the operating system.
- It is simply an execution or processing unit composed of a set of instructions contained in the process. See it as the smallest task or operation within the process that is manageable by the scheduler.
- A thread shares information such as a data segment, a code segment, ..., with its peer threads spawned by the same base-thread (see below in post), while it contains its own registers, stack, ....
- Obviously, a process can be composed of one or more threads, everything will depend on the programmer. In the case of a single-threaded process we speak of single-threading, in the opposite case of multi-threading.

What kind of algorithm can be applied to handle critical sections?

A critical section is a part of a multi-threading program that has to be executed as atomic actions (no concurrence with other threads executing similar actions):
- It is a piece of a program that requires mutual exclusion of access.
- Typically, the critical section accesses a shared resource, such as a data structure, a peripheral device, or a network connection, that does not allow multiple concurrent accesses.

When a program starts up, one thread already begins running immediately. This is usually called the "main" thread of the program, because it is the one that is executed when a program begins:
- It is the thread from which user may spawn other “child” threads (which in turn may spawn other "sub-child" threads).
- Often, it must be the last thread to finish execution because it performs various shutdown actions (as a "child" thread must also do so with respect to its eventual "sub-child" threads spawned).
- But other than that, it can also compete (with its own critical sections) with all other threads explicitly spawned by user.

The method to ensure exclusive action of a critical section may be designed in a algorithm either asynchronous or synchronous, which applies to the threads.


1) ASYNCHRONOUS ALGORITHM EXAMPLES

1.1) Asynchronous algorithm using one flag (a boolean variable) per thread
By putting 'true' its own flag means that the thread wants take the exclusive control to access the shared resource (when shared resource access is ended, the thread resets its own flag to 'false').

1.1.1) Asynchronous wait for expected condition, including a sleep in order to release CPU time
After putting its own flag to 'true', the thread waits that all other flags are set to 'false' before entering its critical section.
When shared resource access is ended, the thread resets its own flag to 'false'.

Algorithm:

Code: Select all

'   my_thread_flag = true
'   Do
'   |  Sleep 5, 1
'   Loop Until number_of_thread_flag_true = 1
'   .....
'   Critical section of code
'   .....
'   my_thread_flag = false

This algorithm does not work because of the case of infinite blocking of the thread in its waiting loop (as soon as at least 2 threads wait at same time).

1.1.2) Asynchronous jump if not expected condition
After putting its own flag to 'true', the thread verifies if all other flags are set to 'false' before entering its critical section, otherwise the thread jumps its critical section and continues.
In all cases (after running its critical section or only jumping), the thread resets its own flag to 'false'.

Algorithm:

Code: Select all

'   my_thread_flag = true
'   If number_of_thread_flag_true = 1 Then
'   | .....
'   | Critical section of code
'   | .....
'   End If
'   my_thread_flag = false

There is no case of infinite blocking of the thread, but in general, some threads may be strongly advantaged or disadvantaged compared to others for running their critical sections.

1.1.3) Asynchronous repeat awake then sleep, until expected condition
After putting its own flag to 'true', the thread verifies if all other flags are set to 'false' before entering its critical section, otherwise the thread resets its own flag to 'false' before sleeping up to a new attempt.
When shared resource access is ended, the thread resets its own flag to 'false'.

Algorithm:

Code: Select all

'   Do
'   |  my_thread_flag = true
'   |  If number_of_thread_flag_true = 1 Then
'   |  |  Exit Do
'   |  End If
'   |  my_thread_flag = false
'   |  Sleep 5, 1
'   Loop
'   .....
'   Critical section of code
'   .....
'   my_thread_flag = false

There is no case of infinite blocking of the thread, but in general, some threads may be strongly advantaged or disadvantaged compared to others for running their critical sections.

1.2) Asynchronous algorithm using one mutex for all threads
By getting the mutex locking, the thread can take the exclusive control to access the shared resource.
When shared resource access is ended, the thread unlocks the mutex.

Algorithm:

Code: Select all

'   Mutexlock
'   | .....
'   | Critical section of code
'   | .....
'   Mutexunlock

There is no any advantage or disadvantage between threads for running their critical sections.


2) SYNCHRONOUS ALGORITHM EXAMPLES

2.1) Synchronous algorithm using a priority number among the threads
The thread which has the priority runs its critical section, then passes the priority to the next thread.

2.1.1) Synchronous wait for expected condition, including a sleep in order to release CPU time
The thread waits for its turn before executing its critical section.
When shared resource access is ended, the thread passes the priority to the next thread in the thread number list.

Algorithm:

Code: Select all

'   While thread_priority_number <> my_number
'   |  Sleep 5, 1
'   Wend
'   .....
'   Critical section of code
'   .....
'   thread_priority_number = next thread_priority_number

The critical sections of the threads are run synchronously one after the other, with a predefined order.

2.1.2) Synchronous wait for expected condition, including a condwait then a condbroadcast (and mutex) in order to release CPU time
The thread waits for its turn and also a condition signal (condwait) before executing its critical section.
When shared resource access is ended, the thread passes the priority to the next thread in the thread number list, then sends a condition signal to all other threads (condbroadcast).

Algorithm:

Code: Select all

'   Mutexlock
'   |  While thread_priority_number <> my_number
'   |  |  Condwait
'   |  Wend
'   |  .....
'   |  Critical section of code
'   |  .....
'   |  thread_priority_number = next thread_priority_number
'   |  Condbroadcast
'   Mutexunlock

The critical sections of the threads are run synchronously one after the other, with a predefined order.

2.2) Synchronous algorithm using a mutex for each thread, by self lock and mutual unlock
When one thread has run its critical section, it unlocks the mutex of the next thread and attempts to re-obtain its own mutex.
At initialization all mutexes are locked, and the main thread enters directly in its critical section (code of the main thread slightly different of the other thread, with the self lock pushed at end).

Algorithm for main thread (#0):

Code: Select all

'   |  .....
'   |  Critical section of code
'   |  .....
'   Mutexunlock(next thread mutex (#0+1))
'   Mutexlock(own thread mutex (#0))

Algorithm for user thread (#N):

Code: Select all

'   Mutexlock(own thread mutex (#N))
'   |  .....
'   |  Critical section of code
'   |  .....
'   Mutexunlock(next thread mutex (#N+1))

The critical sections of the threads are run synchronously one after the other, with a predefined order.


See all the examples in the following post.

[fxm]

Full examples of code for the previous post (paragraph: 'What kind of algorithm can be applied to handle critical sections?')

In the following examples, the shared resource is the input/output display device:
- Print its counter for each of 6 user threads (and read the flag 'quit').
- Catching a key-press (any one) for the main thread (and if yes, set the flag 'quit' to 'true').

The outputting procedure ('Sub Counter()') has voluntarily a tempo between cursor positioning and printing, and also a repositioning of text cursor at middle of line before ending, in order to thoroughly check that there is no overlap between the critical sections executions (at opposite, one can see the result by removing some code dedicated to exclusion processing).

- Example for §1.1.1: Asynchronous wait for expected condition, including a sleep in order to release CPU time

Code: Select all

' User thread algorithm (same principle for the main thread):
' 
'   Do
'   |  my_thread_flag = true
'   |  Do
'   |  |  Sleep 5, 1
'   |  Loop Until number_of_thread_flag_true = 1
'   |  .....
'   |  Critical section of code
'   |  .....
'   |  my_thread_flag = false
'   |  Sleep my_tempo, 1
'   Loop Until quit = true
'
' This algorithm does not work because of the case of infinite blocking of the thread in its waiting loop (as soon as at least 2 threads wait at same time).


Type UDT
  Dim As Integer number
  Dim As Integer tempo
  Dim As Any Ptr pThread
  Dim As Ulongint count
  Static As Integer threadFlagArray(Any)
  Static As Integer numberMax
  Static As Integer quit
  Declare Static Function NumberOfThreadFlag () As Integer
End Type
Dim As Integer UDT.threadFlagArray(Any)
Dim As Integer UDT.numberMax
Dim As Integer UDT.quit
Static Function UDT.NumberOfThreadFlag () As Integer
  Dim As Integer n
  For I As Integer = 0 To UDT.numberMax
    n += UDT.threadFlagArray(I)
  Next I
  Return n
End Function

Sub Counter (Byval pt As UDT Ptr)
  With *pt
    Locate .number, .number, 0
    Sleep 5, 1
    .count += 1
    Print .count;
    Locate .number, 30+.number, 0
  End With
End Sub

Sub Thread (Byval p As Any Ptr)
  Dim As Integer quit
  Dim As UDT Ptr pUDT = p
  With *pUDT
    Do
      .threadFlagArray(.number) = 1
      Do
        Sleep 5, 1
      Loop Until .NumberOfThreadFlag() = 1
      Counter(pUDT)
      quit = .quit
      .threadFlagArray(.number) = 0
      Sleep .tempo, 1
    Loop Until quit = 1
  End With
End Sub


UDT.numberMax = 6
Redim UDT.threadFlagArray(0 To UDT.numberMax)
Dim As UDT u(0 To UDT.numberMax)
For I As Integer = 0 To UDT.numberMax
  u(I).number = i
  u(I).tempo = 100 + 15 * I - 95 * Sgn(I)
Next I


Dim As Single t = Timer
For I As Integer = 1 To UDT.numberMax
  u(I).pThread = Threadcreate(@Thread, @u(I))
Next I

Dim As String s
Do
  UDT.threadFlagArray(u(0).number) = 1
  Do
    Sleep 5, 1
  Loop Until UDT.NumberOfThreadFlag() = 1
  s = Inkey
  If s <> "" Then
    UDT.quit = 1
  End If
  UDT.threadFlagArray(u(0).number) = 0
  Sleep u(0).tempo, 1
Loop Until s <> ""

For I As Integer = 1 To UDT.numberMax
  Threadwait(u(I).pThread)
Next I
t = Timer - t

Dim As Ulongint c
For I As Integer = 1 to UDT.numberMax
  c += u(I).count
Next I
Locate UDT.numberMax+2, 1
Print Culngint(c / t) & " increments per second"

Sleep

Code: Select all

Blocking for that process!

- Example for §1.1.2: Asynchronous jump if not expected condition

Code: Select all

' User thread algorithm (same principle for the main thread):
' 
'   Do
'   |  my_thread_flag = true
'   |  If number_of_thread_flag_true = 1 Then
'   |  | .....
'   |  | Critical section of code
'   |  | .....
'   |  End If
'   |  my_thread_flag = false
'   |  Sleep my_tempo, 1
'   Loop Until quit = true
'
' There is no case of infinite blocking of the thread, but in general, some threads are strongly advantaged or disadvantaged compared to others for running their critical sections.


Type UDT
  Dim As Integer number
  Dim As Integer tempo
  Dim As Any Ptr pThread
  Dim As Ulongint count
  Static As Integer threadFlagArray(Any)
  Static As Integer numberMax
  Static As Integer quit
  Declare Static Function NumberOfThreadFlag () As Integer
End Type
Dim As Integer UDT.threadFlagArray(Any)
Dim As Integer UDT.numberMax
Dim As Integer UDT.quit
Static Function UDT.NumberOfThreadFlag () As Integer
  Dim As Integer n
  For I As Integer = 0 To UDT.numberMax
    n += UDT.threadFlagArray(I)
  Next I
  Return n
End Function

Sub Counter (Byval pt As UDT Ptr)
  With *pt
    Locate .number, .number, 0
    Sleep 5, 1
    .count += 1
    Print .count;
    Locate .number, 30+.number, 0
  End With
End Sub

Sub Thread (Byval p As Any Ptr)
  Dim As Integer quit
  Dim As UDT Ptr pUDT = p
  With *pUDT
    Do
      .threadFlagArray(.number) = 1
      If .NumberOfThreadFlag() = 1 Then
        Counter(pUDT)
      End If
      quit =.quit
      .threadFlagArray(.number) = 0
      Sleep .tempo, 1
    Loop Until quit = 1
  End With
End Sub


UDT.numberMax = 6
Redim UDT.threadFlagArray(0 To UDT.numberMax)
Dim As UDT u(0 To UDT.numberMax)
For I As Integer = 0 To UDT.numberMax
  u(I).number = i
  u(I).tempo = 100 + 15 * I - 95 * Sgn(I)
Next I

Dim As Single t = Timer
For I As Integer = 1 To UDT.numberMax
  u(I).pThread = Threadcreate(@Thread, @u(I))
Next I

Dim As String s
Do
  UDT.threadFlagArray(u(0).number) = 1
  If UDT.NumberOfThreadFlag() = 1 Then
    s = Inkey
    If s <> "" Then
      UDT.quit = 1
    End If
  End If
  UDT.threadFlagArray(u(0).number) = 0
  Sleep u(0).tempo, 1
Loop Until s <> ""

For I As Integer = 1 To UDT.numberMax
  Threadwait(u(I).pThread)
Next I
t = Timer - t

Dim As Ulongint c
For I As Integer = 1 to UDT.numberMax
  c += u(I).count
Next I
Locate UDT.numberMax+2, 1
Print Culngint(c / t) & " increments per second"

Sleep

Code: Select all

407
 380
  243
   156
    153
     105

28 increments per second

- Example for §1.1.3: Asynchronous repeat awake then sleep, until expected condition

Code: Select all

' User thread algorithm (same principle for the main thread):
'
'   Do
'   |  Do
'   |  |  my_thread_flag = true
'   |  |  If number_of_thread_flag_true = 1 Then
'   |  |  |  Exit Do
'   |  |  End If
'   |  |  my_thread_flag = false
'   |  |  Sleep 5, 1
'   |  Loop
'   |  .....
'   |  Critical section of code
'   |  .....
'   |  my_thread_flag = false
'   |  Sleep my_tempo, 1
'   Loop Until quit = true
'
' There is no case of infinite blocking of the thread, but in general, some threads are strongly advantaged or disadvantaged compared to others for running their critical sections.


Type UDT
  Dim As Integer number
  Dim As Integer tempo
  Dim As Any Ptr pThread
  Dim As Ulongint count
  Static As Integer threadFlagArray(Any)
  Static As Integer numberMax
  Static As Integer quit
  Declare Static Function NumberOfThreadFlag () As Integer
End Type
Dim As Integer UDT.threadFlagArray(Any)
Dim As Integer UDT.numberMax
Dim As Integer UDT.quit
Static Function UDT.NumberOfThreadFlag () As Integer
  Dim As Integer n
  For I As Integer = 0 To UDT.numberMax
    n += UDT.threadFlagArray(I)
  Next I
  Return n
End Function

Sub Counter (Byval pt As UDT Ptr)
  With *pt
    Locate .number, .number, 0
    Sleep 5, 1
    .count += 1
    Print .count;
    Locate .number, 30+.number, 0
  End With
End Sub

Sub Thread (Byval p As Any Ptr)
  Dim As Integer quit
  Dim As UDT Ptr pUDT = p
  With *pUDT
    Do
      Do
        .threadFlagArray(.number) = 1
        If .NumberOfThreadFlag() = 1 Then
          Exit Do
        End If
        .threadFlagArray(.number) = 0
        Sleep 5, 1
      Loop
      Counter(pUDT)
      quit = .quit
      .threadFlagArray(.number) = 0
      Sleep .tempo, 1
    Loop Until quit = 1
  End With
End Sub


UDT.numberMax = 6
Redim UDT.threadFlagArray(0 To UDT.numberMax)
Dim As UDT u(0 To UDT.numberMax)
For I As Integer = 0 To UDT.numberMax
  u(I).number = i
  u(I).tempo = 100 + 15 * I - 95 * Sgn(I)
Next I

Dim As Single t = Timer
For I As Integer = 1 To UDT.numberMax
  u(I).pThread = Threadcreate(@Thread, @u(I))
Next I

Dim As String s
Do
  Do
    UDT.threadFlagArray(u(0).number) = 1
    If UDT.NumberOfThreadFlag() = 1 Then
      Exit Do
    End If
    UDT.threadFlagArray(u(0).number) = 0
    Sleep 5, 1
  Loop
  s = Inkey
  If s <> "" Then
    UDT.quit = 1
  End If
  UDT.threadFlagArray(u(0).number) = 0
  Sleep u(0).tempo, 1
Loop Until s <> ""

For I As Integer = 1 To UDT.numberMax
  Threadwait(u(I).pThread)
Next I
t = Timer - t

Dim As Ulongint c
For I As Integer = 1 to UDT.numberMax
  c += u(I).count
Next I
Locate UDT.numberMax+2, 1
Print Culngint(c / t) & " increments per second"

Sleep

Code: Select all

416
 132
  283
   120
    242
     104

32 increments per second

- Example for §1.2: Asynchronous algorithm using one mutex for all threads

Code: Select all

' User thread algorithm (same principle for the main thread):
'
'   Do
'   |  Mutexlock
'   |  | .....
'   |  | Critical section of code
'   |  | .....
'   |  Mutexunlock
'   |  Sleep my_tempo, 1
'   Loop Until quit = true
'
' There is no any advantage or disadvantage between threads for running their critical sections.


Type UDT
  Dim As Integer number
  Dim As Integer tempo
  Dim As Any Ptr pThread
  Dim As Ulongint count
  Static As Any Ptr pMutex
  Static As Integer numberMax
  Static As Integer quit
End Type
Dim As Any Ptr UDT.pMutex
Dim As Integer UDT.numberMax
Dim As Integer UDT.quit

Sub Counter (Byval pt As UDT Ptr)
  With *pt
    Locate .number, .number, 0
    Sleep 5, 1
    .count += 1
    Print .count;
    Locate .number, 30+.number, 0
  End With
End Sub

Sub Thread (Byval p As Any Ptr)
  Dim As Integer quit
  Dim As UDT Ptr pUDT = p
  With *pUDT
    Do
      Mutexlock(.pMutex)
        Counter(pUDT)
        quit = .quit
      Mutexunlock(.pMutex)
      Sleep .tempo, 1
    Loop Until quit = 1
  End With
End Sub


UDT.numberMax = 6
Dim As UDT u(0 To UDT.numberMax)
For I As Integer = 0 To UDT.numberMax
  u(I).number = i
  u(I).tempo = 100 + 15 * I - 95 * Sgn(I)
Next I
UDT.pMutex = Mutexcreate

Dim As Single t = Timer
For I As Integer = 1 To UDT.numberMax
  u(I).pThread = Threadcreate(@Thread, @u(I))
Next I

Dim As String s
Do
  Mutexlock(UDT.pMutex)
    s = Inkey
    If s <> "" Then
      UDT.quit = 1
    End If
  Mutexunlock(UDT.pMutex)
  Sleep u(0).tempo, 1
Loop Until s <> ""

For I As Integer = 1 To UDT.numberMax
  Threadwait(u(I).pThread)
Next I
t = Timer - t

Mutexdestroy(UDT.pMutex)
Dim As Ulongint c
For I As Integer = 1 to UDT.numberMax
  c += u(I).count
Next I
Locate UDT.numberMax+2, 1
Print Culngint(c / t) & " increments per second"

Sleep

Code: Select all

220
 188
  147
   130
    114
     104

62 increments per second

- Example for §2.1.1: Synchronous wait for expected condition, including a sleep in order to release CPU time

Code: Select all

' User thread algorithm (same principle for the main thread):
'
'   Do
'   |  While thread_priority_number <> my_number
'   |  |  Sleep 5, 1
'   |  Wend
'   |  .....
'   |  Critical section of code
'   |  .....
'   |  thread_priority_number = next thread_priority_number
'   |  Sleep my_tempo, 1
'   Loop Until quit = true
'
' The critical sections of the threads are run synchronously one after the other, with a predefined order.


Type UDT
  Dim As Integer number
  Dim As Integer tempo
  Dim As Any Ptr pThread
  Dim As Ulongint count
  Static As Integer threadPriorityNumber
  Static As Integer numberMax
  Static As Integer quit
End Type
Dim As Integer UDT.threadPriorityNumber
Dim As Integer UDT.numberMax
Dim As Integer UDT.quit

Sub Counter (Byval pt As UDT Ptr)
  With *pt
    Locate .number, .number, 0
    Sleep 5, 1
    .count += 1
    Print .count;
    Locate .number, 30+.number, 0
  End With
End Sub

Sub Thread (Byval p As Any Ptr)
  Dim As Integer quit
  Dim As UDT Ptr pUDT = p
  With *pUDT
    Do
      While .threadPriorityNumber <> .number
        Sleep 5, 1
      Wend
      Counter(pUDT)
      quit = .quit
      .threadPriorityNumber = (.threadPriorityNumber + 1) Mod (.numberMax+1)
      Sleep .tempo, 1
    Loop Until quit = 1
  End With
End Sub


UDT.numberMax = 6
Dim As UDT u(0 To UDT.numberMax)
For I As Integer = 0 To UDT.numberMax
  u(I).number = i
  u(I).tempo = 100 + 15 * I - 95 * Sgn(I)
Next I

Dim As Single t = Timer
For I As Integer = 1 To UDT.numberMax
  u(I).pThread = Threadcreate(@Thread, @u(I))
Next I

Dim As String s
Do
  While UDT.threadPriorityNumber <> u(0).number
    Sleep 5, 1
  Wend
  s = Inkey
  If s <> "" Then
    UDT.quit = 1
  End If
  UDT.threadPriorityNumber = (UDT.threadPriorityNumber + 1) Mod (UDT.numberMax+1)
  Sleep u(0).tempo, 1
Loop Until s <> ""

For I As Integer = 1 To UDT.numberMax
  Threadwait(u(I).pThread)
Next I
t = Timer - t

Dim As Ulongint c
For I As Integer = 1 to UDT.numberMax
  c += u(I).count
Next I
Locate UDT.numberMax+2, 1
Print Culngint(c / t) & " increments per second"

Sleep

Code: Select all

106
 106
  106
   106
    106
     106

31 increments per second

- Example for §2.1.2: Synchronous wait for expected condition, including a condwait then a condbroadcast (and mutex) in order to release CPU time

Code: Select all

' User thread algorithm (same principle for the main thread):
'
'   Do
'   |  Mutexlock
'   |  |  While thread_priority_number <> my_number
'   |  |  |  Condwait
'   |  |  Wend
'   |  |  .....
'   |  |  Critical section of code
'   |  |  .....
'   |  |  thread_priority_number = next thread_priority_number
'   |  |  Condbroadcast
'   |  Mutexunlock
'   |  Sleep my_tempo, 1
'   Loop Until quit = true
'
' The critical sections of the threads are run synchronously one after the other, with a predefined order.


Type UDT
  Dim As Integer number
  Dim As Integer tempo
  Dim As Any Ptr pThread
  Dim As Ulongint count
  Static As Integer threadPriorityNumber
  Static As Any Ptr pMutex
  Static As Any Ptr pCond
  Static As Integer numberMax
  Static As Integer quit
End Type
Dim As Integer UDT.threadPriorityNumber
Dim As Any Ptr UDT.pMutex
Dim As Any Ptr UDT.pCond
Dim As Integer UDT.numberMax
Dim As Integer UDT.quit

Sub Counter (Byval pt As UDT Ptr)
  With *pt
    Locate .number, .number, 0
    Sleep 5, 1
    .count += 1
    Print .count;
    Locate .number, 30+.number, 0
  End With
End Sub

Sub Thread (Byval p As Any Ptr)
  Dim As Integer quit
  Dim As UDT Ptr pUDT = p
  With *pUDT
    Do
      Mutexlock(.pMutex)
        While .threadPriorityNumber <> .number  '' synchronous condwait for expected condition
          Condwait(.pCond, .pMutex)
        Wend
        Counter(pUDT)
        quit = .quit
        .threadPriorityNumber = (.threadPriorityNumber + 1) Mod (.numberMax+1)
        Condbroadcast(.pCond)
      Mutexunlock(.pMutex)
      Sleep .tempo, 1
    Loop Until quit = 1
  End With
End Sub


UDT.numberMax = 6
Dim As UDT u(0 To UDT.numberMax)
For I As Integer = 0 To UDT.numberMax
  u(I).number = i
  u(I).tempo = 100 + 15 * I - 95 * Sgn(I)
Next I
UDT.pMutex = Mutexcreate
UDT.PCond = Condcreate

Dim As Single t = Timer
For I As Integer = 1 To UDT.numberMax
  u(I).pThread = Threadcreate(@Thread, @u(I))
Next I

Dim As String s
Do
  Mutexlock(UDT.pMutex)
    While UDT.threadPriorityNumber <> u(0).number
      Condwait(UDT.pCond, UDT.pMutex)
    Wend
    s = Inkey
    If s <> "" Then
      UDT.quit = 1
    End If
    UDT.threadPriorityNumber = (UDT.threadPriorityNumber + 1) Mod (UDT.numberMax+1)
    Condbroadcast(UDT.pCond)
  Mutexunlock(UDT.pMutex)
  Sleep u(0).tempo, 1
Loop Until s <> ""

For I As Integer = 1 To UDT.numberMax
  Threadwait(u(I).pThread)
Next I
t = Timer - t

Mutexdestroy(UDT.pMutex)
Conddestroy(UDT.pCond)
Dim As Ulongint c
For I As Integer = 1 to UDT.numberMax
  c += u(I).count
Next I
Locate UDT.numberMax+2, 1
Print Culngint(c / t) & " increments per second"

Sleep

Code: Select all

105
 105
  105
   105
    105
     105

48 increments per second

Compared to previous example, adding 'condwait' and 'condbroadcast' (and mutex) increases the complexity but also improves the execution time.

Example for §2.2: Synchronous algorithm using a mutex for each thread, by self lock and mutual unlock

Code: Select all

' Main thread (#0) algorithm:
'
'   Do
'   |  |  .....
'   |  |  Critical section of code
'   |  |  .....
'   |  Mutexunlock(next thread mutex (#0+1))
'   |  Mutexlock(own thread mutex (#0))
'   |  Sleep my_tempo, 1
'   Loop Until key <> ""

' User thread (#N) algorithm:
'
'   Do
'   |  Mutexlock(own thread mutex (#N))
'   |  |  .....
'   |  |  Critical section of code
'   |  |  .....
'   |  Mutexunlock(next thread mutex (#N+1))
'   |  Sleep tempo, 1
'   Loop Until quit = 1


Type UDT
  Dim As Integer number
  Dim As Integer tempo
  Dim As Any Ptr pThread
  Dim As Ulongint count
  Static As Any Ptr pMutex(Any)
  Static As Integer numberMax
  Static As Integer quit
End Type
Dim As Any Ptr UDT.pMutex(Any)
Dim As Integer UDT.numberMax
Dim As Integer UDT.quit

Sub Counter (Byval pt As UDT Ptr)
  With *pt
    Locate .number, .number, 0
    Sleep 5, 1
    .count += 1
    Print .count;
    Locate .number, 30+.number, 0
  End With
End Sub

Sub Thread (Byval p As Any Ptr)
  Dim As Integer quit
  Dim As UDT Ptr pUDT = p
  With *pUDT
    Do
      Mutexlock(.pMutex(.number))
      Counter(pUDT)
      quit = .quit
      Mutexunlock(.pMutex((.number +1) Mod (UDT.numberMax+1)))
      Sleep .tempo, 1
    Loop Until quit = 1
  End With
End Sub


UDT.numberMax = 6
Redim UDT.pMutex(UDT.numberMax)
Dim As UDT u(0 To UDT.numberMax)
For I As Integer = 0 To UDT.numberMax
  u(I).number = i
  u(I).tempo = 100 + 15 * I - 95 * Sgn(I)
  UDT.pMutex(I) = Mutexcreate
  Mutexlock(UDT.pMutex(I))
Next I

Dim As Single t = Timer
For I As Integer = 1 To UDT.numberMax
  u(I).pThread = Threadcreate(@Thread, @u(I))
Next I

Dim As String s
Do
    s = Inkey
    If s <> "" Then
      UDT.quit = 1
    End If
  Mutexunlock(UDT.pMutex((u(0).number +1) Mod (UDT.numberMax+1)))
  Mutexlock(UDT.pMutex(u(0).number))
  Sleep u(0).tempo, 1
Loop Until s <> ""

For I As Integer = 1 To UDT.numberMax
  Threadwait(u(I).pThread)
Next I
t = Timer - t

For I As Integer = 0 To UDT.numberMax
  Mutexdestroy(UDT.pMutex(I))
Next I
Dim As Ulongint c
For I As Integer = 1 to UDT.numberMax
  c += u(I).count
Next I
Locate UDT.numberMax+2, 1
Print Culngint(c / t) & " increments per second"

Sleep

Code: Select all

103
 103
  103
   103
    103
     103

28 increments per second

The worst execution time among the 3 synchronous algorithms!

[fxm]

What happens if calling 'Condsignal()' or 'Condbroadcast()' without mutex locked?

About the above example for §2.1.2, I take this opportunity to recall that:
- The mutex must always be also locked while executing 'Condsignal()' or 'Condbroadcast()' to wake up a thread (it may be unlocked but only after 'Condsignal()' or 'Condbroadcast()').
- If the mutex is not locked (or even if the mutex is unlocked only just before executing 'Condsignal()' or 'Condbroadcast()'), the behavior may become unpredictable (it may work or not, depending on the threads configuration and execution real time).

In this above example for §2.1.2:
- If one at least 'Mutexunlock()' is moved just before its 'Condbroadcast()', the program hangs very quickly.
- Although some users certify that the mutex can always be unlocked just before 'Condsignal()' or 'Condbroadcast()', and others more cautious assert that one can do it only for a 'Condbroadcast()', experiment shows the opposite!

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.

[fxm]

When is it not mandatory to protect by a Mutex one shared variable between several threads?

When accessing to shared variables between several threads, all their accesses must be generally put inside blocks [Mutexlock ..... Mutexunlock], in all threads:
- When the shared variable is only one simple predefined numeric type of size <= sizeof(integer) (only one assembler instruction for access), Mutex use may be not mandatory.
- But if this is for example one shared variable LongInt with a win32 compilation, it is advised here to use a Mutex (otherwise the reading phase by a thread may be interlaced with the writing phase of another thread).

That is because to access a variable in memory (for reading or for writing), a processor uses its internal registers.
A N-bit processor has N-bit registers but none greater:
- So one only assembler instruction allows it to access a N-bit variable in memory.
- At opposite, to access a 2N-bit variable, it must use 2 assembler instructions.
- If between these two assembler instructions (for writing), another thread accesses this same variable (for reading), the got value may be incoherent (N-bit highest and N-bit lowest incoherent together).

This behavior can be checked with a graphic program using two threads and a shared LongInt (64-bit) without Mutex:
- by compiling in 32-bit, many read values are incoherent.
- by compiling in 64-bit, no read value is incoherent.

Compile the below test program:
- in 32-bit => many erroneous points not on the circle but anywhere in the square containing the circle (if you uncomment the four lines 37/39/58/60 to activate the Mutex, then all the got points are now on the circle only),
- in 64-bit => all points are valid, on the circle only, even if the Mutex is not activated.

Code: Select all

'- The "user-defined thread" computes the points coordinates on a circle,
'  and write those in a LongInt (32-bit & 32-bit = 64-bit)
'- The "main thread" plots the points from the LongInt value.
'
'Behavior:
'- The first point must be pre-determined.
'- Nothing prevents that a same calculated point could be plotted several times
'(depends on execution times of the loops between main thread and user thread).
'- Nothing prevents that a calculated point could be not plotted
'(same remark on the loop times).
'
'Remark:
'Voluntarily, there is no Sleep in the loop of each thread (normally strongly discouraged),
'but this is just in this special case to amplify the behavior effects to observe.


Union Point2D
    Dim As Longint xy
    Type
        Dim As Long y
        Dim As Long x
    End Type
End Union

Dim As Any Ptr handle
Dim Shared As Any Ptr mutex
Dim Shared As Integer quit

Sub Thread (ByVal param As Any Ptr)
    Const pi As Single = 4 * Atn(1)
    Dim As Point2D Ptr p = param
    Do
        Dim As Point2D P2D0
        Dim As Single teta = 2 * pi * Rnd
        P2D0.x = 320 + 200 * Cos(teta)
        P2D0.y = 240 + 200 * Sin(teta)
'        Mutexlock(mutex)
        p->xy = P2D0.xy
'        Mutexunlock(mutex)
'        Sleep 5, 1
    Loop Until quit = 1
End Sub


Screen 12

Dim As Point2D P2D
P2D.x = 520
P2D.y = 240

mutex = MutexCreate
handle = ThreadCreate(@Thread, @P2D)

Dim As Integer c

Do
    Dim As Point2D P2D0
'    Mutexlock(mutex)
    P2D0.xy = P2D.xy
'    Mutexunlock(mutex)
    PSet (P2D0.x, P2D0.y), c
    c = (c Mod 15) + 1
'    Sleep 5, 1
Loop Until Inkey <> ""
 
quit = 1
ThreadWait(handle)
Mutexdestroy(mutex)

[fxm]

Why it is mandatory to put CondWait within a While loop for checking a Boolean predicate (set by other thread before activate CondSignal or CondBroadcast)?

Code: Select all

While predicate <> true
  Condwait(handle, mutex)
Wend

In all documentations, it is highly advisable to do so, mainly justified to fight against eventual spurious wake-ups.

This is probably true, but it is also advisable to do so to avoid to loose a CondSignal (or CondBroadcast) if it is prematurely activated while the receiving thread is not yet waiting on CondWait (the signal is lost forever):
- In that case, the receiving thread has even not yet locked the mutex before that CondSignal (or CondBroadcast) is activated.
- So the predicate will already true before the receiving thread reaches the While loop, inducing that CondWait is downright skipped, so avoiding a definitive blocking phenomenon.

Let two threads (thread #0 in main program, thread #1 in a user procedure, each that prints its number in a loop), having about the same execution time, and each one synchronizing the other in order to well interlace their numbers (by using one mutex, two condition variables and CondSignal/CondWait):

- Without a While loop on predicate, the program hangs quickly (Ctrl-C to quit):

Code: Select all

'          Thread#0               XOR + <==>             Thread#1
'.....                                          .....
'MutexLock(mut)                                 MutexLock(mut)
'  Do_something_with_exclusion                    Do_something_with_exclusion
'  CondWait(cond#1, mut) <----------------------- CondSignal(cond#1)
'  Do_something_with_exclusion <---------.        Do_something_with_exclusion
'  CondSignal(cond#2) ------------------ | -----> CondWait(cond#2, mut)
'  Do_something_with_exclusion     .---- | -----> Do_something_with_exclusion
'MutexUnlock(mut) -----------------'     '----- MutexUnlock(mut)
'.....                                          .....


Dim As Any Ptr handle
Dim Shared As Any Ptr mutex
Dim Shared As Any Ptr cond1
Dim Shared As Any Ptr cond2
Dim Shared As Integer quit

Sub Thread (ByVal param As Any Ptr)
    Do
        Mutexlock(mutex)
        Print "1";
        CondSignal(cond1)
        CondWait(cond2, mutex)
        If quit = 1 Then
            Mutexunlock(mutex)
            Exit DO
        End If
        Mutexunlock(mutex)
        Sleep 1, 1
    Loop
End Sub


mutex = MutexCreate
cond1 = CondCreate
cond2 = CondCreate
handle = ThreadCreate(@Thread)

Do
    Mutexlock(mutex)
    CondWait(cond1, mutex)
    Print "0";
    CondSignal(cond2)
    If Inkey <> "" Then
        quit = 1
        Mutexunlock(mutex)
        Exit Do
    End If
    Mutexunlock(mutex)
    Sleep 1, 1
Loop
 
ThreadWait(handle)
Mutexdestroy(mutex)
CondDestroy(cond1)
CondDestroy(cond2)
Print

Sleep

- With a While loop on predicate around each CondWait, no blocking phenomenon:

Code: Select all

'          Thread#0               XOR + <==>             Thread#1
'.....                                          .....
'MutexLock(mut)                                 MutexLock(mut)
'  Do_something_with_exclusion                    Do_something_with_exclusion
'  While bool#1 <> true <------------------------ bool#1 = true
'    CondWait(cond#1, mut) <--------------------- CondSignal(cond#1)
'  Wend <-----------------------------------.     Do_something_with_exclusion
'  bool#1 = false               .---------- | --> While bool#2 <> true
'  Do_something_with_exclusion  |   .------ | ----> CondWait(cond#2, mut)
'  bool#2 = true ---------------'   |   .-- | --> Wend
'  CondSignal(cond#2) --------------'   |   |     bool#2 = false
'  Do_something_with_exclusion          |   |     Do_something_with_exclusion
'MutexUnlock(mut) ----------------------'   '-- MutexUnlock(mut)
'.....                                          .....


Dim As Any Ptr handle
Dim Shared As Any Ptr mutex
Dim Shared As Any Ptr cond1
Dim Shared As Any Ptr cond2
Dim Shared As Integer new1
Dim Shared As Integer new2
Dim Shared As Integer quit

Sub Thread (ByVal param As Any Ptr)
    Do
        Mutexlock(mutex)
        Print "1";
        new1 = 1
        CondSignal(cond1)
        While new2 <> 1
            CondWait(cond2, mutex)
        Wend
        new2 = 0
        If quit = 1 Then
            Mutexunlock(mutex)
            Exit DO
        End If
        Mutexunlock(mutex)
        Sleep 1, 1
    Loop
End Sub


mutex = MutexCreate
cond1 = CondCreate
cond2 = CondCreate
handle = ThreadCreate(@Thread)

Do
    Mutexlock(mutex)
    While new1 <> 1
        CondWait(cond1, mutex)
    Wend
    new1 = 0
    Print "0";
    new2 = 1
    CondSignal(cond2)
    If Inkey <> "" Then
        quit = 1
        Mutexunlock(mutex)
        Exit Do
    End If
    Mutexunlock(mutex)
    Sleep 1, 1
Loop
 
ThreadWait(handle)
Mutexdestroy(mutex)
CondDestroy(cond1)
CondDestroy(cond2)
Print

Sleep

[fxm]

What is the chronology of code execution of 2 critical sections (with a mutex locking and a conditional variable signaling) that compete between 2 threads?

Chronology for one thread signaling which occurs:
1) while another thread is waiting (within a While loop on predicate),
2) before another thread is waiting (within a While loop on predicate).

Code: Select all

#define while_loop_on_predicate

Dim As Any Ptr handle
Dim Shared As Any Ptr mutex
Dim Shared As Any Ptr cond
Dim As Integer sleep0
Dim As Integer sleep1
#ifdef while_loop_on_predicate
Dim Shared As Integer ready
#endif


Sub Thread1 (ByVal param As Any Ptr)
  Sleep *Cast(Integer Ptr, param), 1
  Mutexlock(mutex)
  Color 11 : Print "    Thread#1 locks the mutex"
  Color 11 : Print "    Thread#1 executes code with exclusion"
  #ifdef while_loop_on_predicate
  ready = 1
  #endif
  Color 11 : Print "    Thread#1 is signaling"
  CondSignal(cond)
  Color 11 : Print "    Thread#1 executes post-code with exclusion"
  Color 11 : Print "    Thread#1 unlocks the mutex"
  Mutexunlock(mutex)
End Sub

Sub Thread0 (ByVal param As Any Ptr)
  Sleep *Cast(Integer Ptr, param), 1
  Mutexlock(mutex)
  Color 10 : Print "  Thread#0 locks the mutex"
  Color 10 : Print "  Thread#0 executes pre-code with exclusion"
  #ifdef while_loop_on_predicate
  While ready <> 1
  #endif
    Color 10 : Print "  Thread#0 is waiting"
    CondWait(cond, mutex)
    Color 10 : Print "  Thread#0 is waked"
  #ifdef while_loop_on_predicate
  Wend
  #endif
  Color 10 : Print "  Thread#0 executes code with exclusion"
  #ifdef while_loop_on_predicate
  ready = 0
  #endif
  Color 10 : Print "  Thread#0 unlocks the mutex"
  Mutexunlock(mutex)
End Sub


mutex = MutexCreate
cond = CondCreate

sleep0 = 0
sleep1 = 1000
Color 7 : Print "Chronology for Thread#1 signaling while Thread#0 is waiting:"
handle = ThreadCreate(@Thread1, @sleep1)
Thread0(@sleep0)
ThreadWait(handle)
Color 7 : Print "Thread#1 finished": Print
Sleep 1000

sleep0 = 1000
sleep1 = 0
Color 7 : Print "Chronology for Thread#1 signaling before Thread#0 is waiting:"
handle = ThreadCreate(@Thread1, @sleep1)
Thread0(@sleep0)
ThreadWait(handle)
Color 7 : Print "Thread#1 finished": Print


Mutexdestroy(mutex)
CondDestroy(cond)
Sleep

Output part 1 - Chronology for Thread#1 signaling while Thread#0 is waiting:

Code: Select all

Chronology for Thread#1 signaling while Thread#0 is waiting:
  Thread#0 locks the mutex
  Thread#0 executes pre-code with exclusion
  Thread#0 is waiting
    Thread#1 locks the mutex
    Thread#1 executes code with exclusion
    Thread#1 is signaling
    Thread#1 executes post-code with exclusion
    Thread#1 unlocks the mutex
  Thread#0 is waked
  Thread#0 executes code with exclusion
  Thread#0 unlocks the mutex
Thread#1 finished

Output part 2 - Chronology for Thread#1 signaling before Thread#0 is waiting:

Code: Select all

Chronology for Thread#1 signaling before Thread#0 is waiting:
    Thread#1 locks the mutex
    Thread#1 executes code with exclusion
    Thread#1 is signaling
    Thread#1 executes post-code with exclusion
    Thread#1 unlocks the mutex
  Thread#0 locks the mutex
  Thread#0 executes pre-code with exclusion
  Thread#0 executes code with exclusion
  Thread#0 unlocks the mutex
Thread#1 finished

If CondWait is not within a While loop on predicate (by putting in comment the first line of above program), one can check in the second case (thread#1 signaling before thread#0 waiting), that thread#0 remains blocked in its waiting phase (Ctrl-C to quit).

[fxm]

User input-line function, but fully thread-safe!

The "Input" keyword may be not thread-safe, when another thread must also access to input/output resource:
- When executing the "Input" statement, the other running threads must not change the position of the text cursor, which prohibits instructions such as "Locate", "Print", ... Only graphic instructions using the position of the graphic cursor, including "Draw String", are compatible during this time.
- Moreover, we cannot enclosed the "Input" keyword inside a mutex locking (as we can do it for the "Inkey" keyword), because while the inputting line would be not completed and validated, the other threads that want to also access to input/output would be fully blocked (waiting for mutex unlocking).

Thread-safe input-line function (versus input/output resource)
Input position, prompt message, sleeping time, line-blanking command, mutex pointer can be passed to the following "threadInput()" function that simulates a simplified input function, but thread-safe, by using a looping around the "Inkey" keyword (all input/output keywords must be enclosed inside a mutex locking block, and the cursor position must be restored at each mutex locking block ending):

Code: Select all

Function threadInput (ByVal row As Integer, ByVal column As Integer, ByRef prompt As String = "", _
                      ByVal sleeptime As Integer = 15, ByVal blank As Integer = 0, ByVal mutex As Any Ptr = 0 _
                      ) As String
    Dim As String inputchr
    Dim As String inputline
    Dim As Integer cursor
    Dim As Integer cursor0
    Dim As Integer r
    Dim As Integer c

 
    MutexLock(mutex)
    r = CsrLin()
    c = Pos()
    Locate row, column
    Print prompt & " _";
    cursor0 = Pos() - 1
    Locate r, c
    MutexUnlock(mutex)

    Do
        MutexLock(mutex)
        r = CsrLin()
        c = Pos()
        inputchr = Inkey
        If inputchr <> "" Then
            If inputchr >= Chr(32) And inputchr < Chr(255) Then
                inputline = Left(inputline, cursor) & inputchr & Mid(inputline, cursor + 1)
                cursor += 1
            ElseIf inputchr = Chr(08) And Cursor > 0 Then                         'BkSp
                cursor -= 1
                inputline = Left(inputline, cursor) & Mid(inputline, cursor + 2)
            ElseIf inputchr = Chr(255) & "S" And Cursor < Len(inputline) Then     'Del
                inputline = Left(inputline, cursor) & Mid(inputline, cursor + 2)
            ElseIf inputchr = Chr(255) + "M" And Cursor < Len(inputline) Then     'Right
                Cursor += 1
            ElseIf inputchr = Chr(255) + "K" And Cursor > 0 Then                  'Left
                Cursor -= 1
            End If
            If inputchr = Chr(27) Then                                            'Esc
                Locate row, cursor0
                Print Space(Len(inputline) + 1);
                inputline = ""
                cursor = 0
            End If
            Locate row, cursor0
            Print Left(inputline, cursor) & Chr(95) & Mid(inputline, cursor + 1) & " ";
        End If
        Locate r, c
        MutexUnlock(mutex)
        Sleep sleeptime, 1
    Loop Until inputchr = Chr(13)

    If blank <> 0 Then
        MutexLock(mutex)
        r = CsrLin()
        c = Pos()
        Locate row, cursor0
        Print Space(Len(inputline) + 1);
        Locate r, c
        MutexUnlock(mutex)
    End If

    Return inputline
End Function

From the previous code "Example for §1.2: Asynchronous algorithm using one mutex for all threads", now the running multi-threading code is waiting for the "quit" command in order to exit the program:

Code: Select all

' User thread algorithm:
'
'   Do
'   |  Mutexlock
'   |  | .....
'   |  | Critical section of code
'   |  | .....
'   |  Mutexunlock
'   |  Sleep my_tempo, 1
'   Loop Until quit = true
'
' There is no any advantage or disadvantage between threads for running their critical sections.


Function threadInput (ByVal row As Integer, ByVal column As Integer, ByRef prompt As String = "", _
                      ByVal sleeptime As Integer = 15, ByVal blank As Integer = 0, ByVal mutex As Any Ptr = 0 _
                      ) As String
    Dim As String inputchr
    Dim As String inputline
    Dim As Integer cursor
    Dim As Integer cursor0
    Dim As Integer r
    Dim As Integer c

 
    MutexLock(mutex)
    r = CsrLin()
    c = Pos()
    Locate row, column
    Print prompt & " _";
    cursor0 = Pos() - 1
    Locate r, c
    MutexUnlock(mutex)

    Do
        MutexLock(mutex)
        r = CsrLin()
        c = Pos()
        inputchr = Inkey
        If inputchr <> "" Then
            If inputchr >= Chr(32) And inputchr < Chr(255) Then
                inputline = Left(inputline, cursor) & inputchr & Mid(inputline, cursor + 1)
                cursor += 1
            ElseIf inputchr = Chr(08) And Cursor > 0 Then                         'BkSp
                cursor -= 1
                inputline = Left(inputline, cursor) & Mid(inputline, cursor + 2)
            ElseIf inputchr = Chr(255) & "S" And Cursor < Len(inputline) Then     'Del
                inputline = Left(inputline, cursor) & Mid(inputline, cursor + 2)
            ElseIf inputchr = Chr(255) + "M" And Cursor < Len(inputline) Then     'Right
                Cursor += 1
            ElseIf inputchr = Chr(255) + "K" And Cursor > 0 Then                  'Left
                Cursor -= 1
            End If
            If inputchr = Chr(27) Then                                            'Esc
                Locate row, cursor0
                Print Space(Len(inputline) + 1);
                inputline = ""
                cursor = 0
            End If
            Locate row, cursor0
            Print Left(inputline, cursor) & Chr(95) & Mid(inputline, cursor + 1) & " ";
        End If
        Locate r, c
        MutexUnlock(mutex)
        Sleep sleeptime, 1
    Loop Until inputchr = Chr(13)

    If blank <> 0 Then
        MutexLock(mutex)
        r = CsrLin()
        c = Pos()
        Locate row, cursor0
        Print Space(Len(inputline) + 1);
        Locate r, c
        MutexUnlock(mutex)
    End If

    Return inputline
End Function

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

Type UDT
    Dim As Integer number
    Dim As Integer tempo
    Dim As Any Ptr pThread
    Dim As ULongInt count
    Static As Any Ptr pMutex
    Static As Integer numberMax
    Static As Integer quit
End Type
Dim As Any Ptr UDT.pMutex
Dim As Integer UDT.numberMax
Dim As Integer UDT.quit

Sub Counter (ByVal pt As UDT Ptr)
    With *pt
        Locate .number, .number, 0
        Sleep 5, 1
        .count += 1
        Print .count;
    End With
End Sub

Sub Thread (ByVal p As Any Ptr)
    Dim As Integer myquit
    Dim As UDT Ptr pUDT = p
    With *pUDT
        Do
            MutexLock(.pMutex)
            Counter(pUDT)
            myquit = .quit
            MutexUnlock(.pMutex)
            Sleep .tempo, 1
        Loop Until myquit = 1
    End With
End Sub


Screen 12
UDT.numberMax = 6

Dim As UDT u(0 To UDT.numberMax)
For I As Integer = 0 To UDT.numberMax
    u(I).number = i
    u(I).tempo = 100 + 15 * I - 95 * Sgn(I)
Next I
UDT.pMutex = MutexCreate

Dim As Single t = Timer
For I As Integer = 1 To UDT.numberMax
    u(I).pThread = ThreadCreate(@Thread, @u(I))
Next I

Do
Loop Until LCase(threadInput(8, 1, """quit"" for exit?", 10, 1, UDT.pMutex)) = "quit"

UDT.quit = 1

For I As Integer = 1 To UDT.numberMax
    ThreadWait(u(I).pThread)
Next I
t = Timer - t

MutexDestroy(UDT.pMutex)
Dim As ULongInt c
For I As Integer = 1 To UDT.numberMax
    c += u(I).count
Next I
Locate UDT.numberMax + 4, 1
Print CULngInt(c / t) & " increments per second"

Sleep

Note
Otherwise, by using only graphics keywords (using the only position of the graphic cursor) as 'Line', 'Draw String', 'Put' in the thread, induces a thread-safe procedure that is compatible with the 'Line Input' keyword in the main code with no mutex:

Code: Select all

Type UDT
    Dim As Integer number
    Dim As Integer tempo
    Dim As Any Ptr pThread
    Dim As ULongInt count
    Dim As Any Ptr img
    Static As Integer numberMax
    Static As Integer quit
End Type
Dim As Integer UDT.numberMax
Dim As Integer UDT.quit

Const As String prompt = "Enter ""quit"" for exit"
Dim As String s

Sub Counter (ByVal pt As UDT Ptr)  ' for a graphic character size 8x8
    With *pt
        Line .img, (0, 0)-(20 * 8 - 1, 16 - 1), 0, BF            ' clearing the image buffer
        Sleep 5, 1
        .count += 1
        Draw String .img, (0, 0), Str(.count)                    ' drawing in the image buffer
        Put ((.number - 1) * 8, (.number - 1) * 16), .img, Pset  ' copying the image buffer to screen
    End With
End Sub

Sub Thread (ByVal p As Any Ptr)  ' for a graphic character size 8x8
    Dim As UDT Ptr pUDT = p
    With *pUDT
        .img = ImageCreate(20 * 8, 16)  ' using an image buffer to avoid flickering
        Do
            Counter(pUDT)
            Sleep .tempo, 1
        Loop Until .quit = 1
        ImageDestroy .img  ' destroying the image buffer
    End With
End Sub


Screen 12
UDT.numberMax = 6

Dim As UDT u(0 To UDT.numberMax)
For I As Integer = 0 To UDT.numberMax
    u(I).number = i
    u(I).tempo = 100 + 15 * I - 95 * Sgn(I)
Next I

Dim As Single t = Timer
For I As Integer = 1 To UDT.numberMax
    u(I).pThread = ThreadCreate(@Thread, @u(I))
Next I

Do
    Locate 8, 1, 0
    Line Input; prompt; s
    Locate , Len(prompt) + 3
    Print Space(Len(s));
Loop Until LCase(s) = "quit"
UDT.quit = 1

For I As Integer = 1 To UDT.numberMax
    ThreadWait(u(I).pThread)
Next I
t = Timer - t

Dim As ULongInt c
For I As Integer = 1 To UDT.numberMax
    c += u(I).count
Next I
Locate UDT.numberMax + 4, 1
Print CULngInt(c / t) & " increments per second"

Sleep

[fxm]

Beware when using SCREENLOCK with multi-threading!

- [ScreenLock...ScrennUnlock] blocks are not compatible with multi-threading (otherwise, the program hangs). This is why a mutex block must be used around each such block to ensure the exclusion.
- The input keywords (like for keyboard, mouse) cannot be safely run when the screen is locked, therefore a such keyword must be outside of any [Screenlock...Screenunlock] block, so outside any [Screenlock...Screenunlock] block in its own thread, and protected of all [Screenlock...Screenunlock] blocks of other threads by a mutex block. Therefore, Getkey and Input, the statements that wait for keypress or line input are unusable, but Inkey that does not wait can work.

By applying some rules scrupulously, one can use ScreenLock/Unlock inside the threads.
Principle of coding for all threads including the main code (main thread):

Code: Select all

Do
  ' instructions without display (printing/drawing, ...) neither input (input/inkey/mouse getting, ...)
  MutexLock(m)
    Screenlock
      ' instructions with only display (printing/drawing, ...)
    Screenunlock
    ' instructions with only input without waiting (inkey/mouse getting, ...)
  MutexUnlock(m)
  Sleep tempo, 1
Loop Until condition

For example, it is mandatory to use one [Mutexlock...Mutexunlock] block around each [Screenlock...Screenunlock] block, and one other around the "Inkey" instruction which itself must always be outside of any [Screenlock...Screenunlock] bloc:

Code: Select all

Type ThreadUDT
  Dim handle As Any Ptr
  Static sync As Any Ptr
  Static quit As Byte
End Type
Dim ThreadUDT.sync As Any Ptr
Dim ThreadUDT.quit As Byte

Function ClockTime () As String
  Return Time
End Function

Function Counter () As Integer
  Static C As Integer
  C = (C + 1) MOD 1000000
  Return C
End Function

Sub ProcedureThread (Byval param As Any Ptr)
  With *Cast(ThreadUDT Ptr, param)
    Do
      MutexLock(.sync)
        Screenlock
          Line (544, 0)-(639, 49), 0, BF  'clear the print area
          Sleep 100, 1
          Locate 2, 71
          Print ClockTime();
        Screenunlock
      MutexUnlock(.sync)
      Sleep 100, 1
    Loop Until .quit = 1
  End With
End Sub

Screen 12
Locate 30, 2
Print "<q/Q> : quit";

Dim TTptr As ThreadUDT Ptr = New ThreadUDT
ThreadUDT.sync = MutexCreate
TTptr->handle = ThreadCreate(@ProcedureThread, TTptr)

Dim As String s
Do
  MutexLock(ThreadUDT.sync)
    Screenlock
      Line (296, 208)-(376, 256), 0, BF  'clear the print area
      Sleep 100, 1
      Locate 15,40
      Print Using "######"; Counter();
    Screenunlock
    s = Inkey
  MutexUnlock(ThreadUDT.sync)
  Sleep 100, 1
Loop Until Lcase(s) = "q"
 
ThreadUDT.quit = 1
ThreadWait(TTptr->handle)
MutexDestroy(ThreadUDT.sync)
Delete TTptr

• Note: The Sleep keyword just after the 'clear the print area' lines is only here to highlight the flickering if no screen locking is used.

[fxm]

Beware when using "video paging (double buffering or page flipping)" with multi-threading!

Instead of "screen locking" (see the above post), "video paging (double buffering or page flipping)" can more simply be used with multi-threading, but be careful that many states in the gfxlib2 are thread-dependent like SCREENSET (and also VIEW settings, graphic cursor position, graphic colors, ...).
Therefore, the setting for the working page and the visible page must always be controlled in each thread code which want to work with a multi-video page configuration.

- Example for a double buffering method (at each step, each thread needs to update the working page and copy it to the visible page, from within an exclusion mutex code block):

Code: Select all

Type ThreadUDT
  Dim handle As Any Ptr
  Static sync As Any Ptr
  Static quit As Byte
End Type
Dim ThreadUDT.sync As Any Ptr
Dim ThreadUDT.quit As Byte

Function ClockTime () As String
  Return Time
End Function

Function Counter () As Integer
  Static C As Integer
  C = (C + 1) MOD 1000000
  Return C
End Function

Sub ProcedureThread (Byval param As Any Ptr)
  Screenset 1, 0  '' setting to define in each thread
  With *Cast(ThreadUDT Ptr, param)
    Do
      MutexLock(.sync)
        Line (544, 0)-(639, 49), 0, BF  '' clear the print area
        Sleep 100, 1
        Locate 2, 71
        Print ClockTime();
        Screencopy
      MutexUnlock(.sync)
      Sleep 100, 1
    Loop Until .quit = 1
  End With
End Sub

Screen 12, , 2
Screenset 1, 0  '' setting to define in each thread
Locate 30, 2
Print "<q/Q> : quit";
Screencopy

Dim TTptr As ThreadUDT Ptr = New ThreadUDT
ThreadUDT.sync = MutexCreate
TTptr->handle = ThreadCreate(@ProcedureThread, TTptr)

Dim s As String
Do
  MutexLock(ThreadUDT.sync)
    Line (296, 208)-(376, 256), 0, BF  '' clear the print area
    Sleep 100, 1
    Locate 15,40
    Print Using "######"; Counter();
    Screencopy
    s = Inkey
  MutexUnlock(ThreadUDT.sync)
  Sleep 100, 1
Loop Until Lcase(s) = "q"
 
ThreadUDT.quit = 1
ThreadWait(TTptr->handle)
MutexDestroy(ThreadUDT.sync)
Delete TTptr

• Note: The Sleep keyword just after the 'clear the print area' lines is only here to highlight the flickering if no double buffering is used.

- Example for a two page flipping method (at each step, each thread needs to update and flip, from within the same exclusion mutex code block, the two screen pages):

Code: Select all

Type ThreadUDT
  Dim handle As Any Ptr
  Static sync As Any Ptr
  Static quit As Byte
End Type
Dim ThreadUDT.sync As Any Ptr
Dim ThreadUDT.quit As Byte

Function ClockTime () As String
  Return Time
End Function

Function Counter () As Integer
  Static C As Integer
  C = (C + 1) MOD 1000000
  Return C
End Function

Sub ProcedureThread (Byval param As Any Ptr)
  Dim p0 As Integer = 0
  Dim p1 As Integer = 1
  Screenset 1, 0  '' setting to define in each thread
  With *Cast(ThreadUDT Ptr, param)
    Do
      MutexLock(.sync)
        Dim s As String = ClockTime()
        For I As Integer = 1 To 2  '' updating the two screen pages
          Line (544, 0)-(639, 49), 0, BF  '' clear the print area
          Sleep 100, 1
          Locate 2, 71
          Print s;
          Screenset p0, p1
          Swap p0, p1
        Next I
      MutexUnlock(.sync)
      Sleep 100, 1
    Loop Until .quit = 1
  End With
End Sub

Screen 12, , 2
Dim p0 As Integer = 0
Dim p1 As Integer = 1
Screenset 1, 0  '' setting to define in each thread
For I As Integer = 1 To 2  '' updating the two screen pages
  Locate 30, 2
  Print "<q/Q> : quit";
  Screenset p0, p1
  Swap p0, p1
Next I

Dim TTptr As ThreadUDT Ptr = New ThreadUDT
ThreadUDT.sync = MutexCreate
TTptr->handle = ThreadCreate(@ProcedureThread, TTptr)

Dim s As String
Do
  MutexLock(ThreadUDT.sync)
    Dim C As Integer = Counter()
    For I As Integer = 1 To 2  '' updating the two screen pages
      Line (296, 208)-(376, 256), 0, BF  '' clear the print area
      Sleep 100, 1
      Locate 15,40
      Print Using "######"; c;
      Screenset p0, p1
      Swap p0, p1
    Next I
    s = Inkey
  MutexUnlock(ThreadUDT.sync)
  Sleep 100, 1
Loop Until Lcase(s) = "q"
 
ThreadUDT.quit = 1
ThreadWait(TTptr->handle)
MutexDestroy(ThreadUDT.sync)
Delete TTptr

• Note: The Sleep keyword just after the 'clear the print area' lines is only here to highlight the flickering if no two page flipping is used.

Note: In these two examples, an exclusion mutex code block is mandatory in the two threads, not only because of using console statements + Inkey, but around also the graphics statements + Screencopy only because of using double buffering method (without anti-flickering process, the graphics statements could be outside the exclusion mutex code block).

[fxm]

When using the FB runtime library for multi-threaded applications, gfxlib2 is thread-safe :-)

The source code of gfxlib2 uses TLS (Thread Local Storage) to store many states, so many things are thread-specific.
Since gfxlib2 is thread-safe, mutex exclusion between threads is not necessary for the graphics statements themselves (including Draw String).
In contrast, console statements such as Locate, Print, ... are not thread-safe as previously mentioned (for example, text cursor position is common to all threads).

- Simple example showing that graphic states (such as graphic cursor position, graphic colors) are thread-dependent:

Code: Select all

Screen 12

Sub thread(Byval p As Any Ptr)
  Color 10
  Pset(150, 10)
  For I As Integer = 1 To 40
    Line -Step(10, 10)
    Sleep 150, 1
  Next I
  Draw String Step (-40, 10), "user thread"
End Sub

Dim As Any Ptr p = Threadcreate(@thread)

Color 14
Pset(10, 100)
For I As Integer = 1 To 24
  Line -Step(10, 10)
  Sleep 250, 1
Next I
Draw String Step (-40, 10), "main thread"

Threadwait(p)

Color 15
Locate 4, 2
Print "Any key for exit"

Sleep

- Example showing that graphics statements (such as Line and Draw String and Screencopy) in a thread can compete with console statements (such as Inkey) in another thread, without using any exclusion (by mutex):

Code: Select all

#include "vbcompat.bi"

Screen 12, , 2
Screenset 1, 0   
Color 0, 7
Cls

Dim Shared terminate As Integer = 0

Sub thread (byval param As Any Ptr)   
  Screenset 1, 0
  Do
    Line (16, 432)-Step(96, 32), 11, BF  'clear print area
    Sleep 100, 1
    Draw String (24, 432), Format(Now,"dd/mm/yyyy"), 0
    Draw String (32, 448), Format(Now,"hh:mm:ss"), 0
    Screencopy
    Sleep 100, 1
  Loop Until terminate = 1
End Sub

Dim As String reply
Locate 2, 2
Print "Enter ""q"" to quit"
Screencopy

Dim p As Any Ptr = ThreadCreate(@thread)

Do
  reply = Inkey
  Sleep 100, 1
Loop Until Lcase(reply) = "q"

Print " Stop the thread"
Screencopy
terminate=1
Threadwait (p)
Print " Thread terminated"
Screencopy

Sleep

• Note: The Sleep keyword just after the 'clear the print area' line is only here to highlight the flickering if no double buffering is used.

- From the above example, if the date displaying and the time displaying are now two separate threads, an exclusion mutex code block between these two threads is mandatory, not due to the graphics statements themselves competing, but only due to the double buffering method used (against flickering) that puts competing these two threads:

Code: Select all

#include "vbcompat.bi"

Screen 12, , 2
Screenset 1, 0   
Color 0, 7
Cls

Dim Shared terminate As Integer = 0
Dim Shared mutex As Any Ptr

Sub thread1 (byval param As Any Ptr)   
  Screenset 1, 0
  Do
    Mutexlock(mutex)
      Line (16, 432)-Step(96, 16), 11, BF  'clear the print area
      Sleep 200, 1
      Draw String (24, 432), Format(Now,"dd/mm/yyyy"), 0
      Screencopy
    Mutexunlock(mutex)
    Sleep 100, 1
  Loop Until terminate = 1
End Sub

Sub thread2 (byval param As Any Ptr)   
  Screenset 1, 0
  Do
    Mutexlock(mutex)
      Line (16, 448)-Step(96, 16), 11, BF  'clear the print area
      Sleep 100, 1
      Draw String (32, 448), Format(Now,"hh:mm:ss"), 0
      Screencopy
    Mutexunlock(mutex)
    Sleep 100, 1
  Loop Until terminate = 1
End Sub

Dim As String reply
Locate 2, 2
Print "Enter ""q"" to quit"
Screencopy

mutex = Mutexcreate
Dim p1 As Any Ptr = ThreadCreate(@thread1)
Dim p2 As Any Ptr = ThreadCreate(@thread2)

Do
  reply = Inkey
  Sleep 100, 1
Loop Until Lcase(reply) = "q"

Print " Stop the threads"
Screencopy
terminate=1
Threadwait (p1)
Threadwait (p2)
Mutexdestroy(mutex)
Print " Threads terminated"
Screencopy

Sleep

• Note: The Sleep keyword just after the 'clear the print area' lines is only here to highlight the flickering if no double buffering is used, or if no mutex is used.

[fxm]

How to use console statements and keyboard inputs with multi-threading?

• Console statements (such as Locate, Print, Color, ...), as well as Locate and Print on Graphics window (but not Color on Graphics Window), and keyboard inputs (such as Inkey, Getkey, Input, ...) are not thread-safe:
  • Thus when they are used in competing sections of different threads, mutual exclusion is mandatory by means of mutex locking blocks in which in addition code can restore states (such as text cursor position, console color, ...) at end of the block (after its own usage), as they were before (at begin of the block).
  • But the GetKey or Input keyword cannot be enclosed inside a mutex locking block (as it can be do with the Inkey keyword), because as long as the keyboard input is not completed, the other threads in compete would be fully blocked (waiting for the mutex unlocking).
  - Example showing that the keywords Locate and Print are not thread-safe both when applied on a console window or when applied on a graphics window (the text cursor states being not thread dependent in the two cases):

  Code: Select all

  Sub Thread (Byval p As Any Ptr)
    Locate Cast(Integer, p), Cast(Integer, p)
    For I As Integer = 1 To 50 - 2 * Cast(Integer, p)
      Sleep 20 * Cast(Integer, p), 1
      Print Str(Cast(Integer, p));
    Next I
  End Sub
  
  Sub test ()
    Dim As Any Ptr p(1 To 9)
    For I As Integer = 1 To 9
      p(I) = Threadcreate(@Thread, Cast(Any Ptr, I))
      Sleep 25, 1
    Next I
    For I As Integer = 1 To 9
      Threadwait(p(I))
    Next I
  End Sub
  
  Screen 0
  test()
  Locate 15, 1
  Print "Any key to continue"
  Sleep
  
  Screen 12
  test()
  Locate 15, 1
  Print "Any key to quit"
  Sleep
  

  • Note: One can see that each thread does not write on its own line corresponding to its thread number (id between 1 and 9), on the console window and on the graphics window.
  - From the above example, the thread code has been completed in its competing sections by mutex locking blocks and by saving/restoring cursor states before/after its own cursor moving:

  Code: Select all

  Dim Shared As Any Ptr mutex
  
  Sub Thread (Byval p As Any Ptr)
    Mutexlock(mutex)
      Dim As Long l0 = Locate()
      Locate Cast(Integer, p), Cast(Integer, p)
      Dim As Long l = Locate()
      Locate Hibyte(Loword(l0)), Lobyte(Loword(l0)), Hiword(l0)
    Mutexunlock(mutex)
    For I As Integer = 1 To 50 - 2 * Cast(Integer, p)
      Sleep 20 * Cast(Integer, p), 1
      Mutexlock(mutex)
        l0 = Locate()
        Locate Hibyte(Loword(l)), Lobyte(Loword(l)), Hiword(l)
        Print Str(Cast(Integer, p));
        l = Locate()
        Locate Hibyte(Loword(l0)), Lobyte(Loword(l0)), Hiword(l0)
      Mutexunlock(mutex)
    Next I
  End Sub
  
  Sub test ()
    Dim As Any Ptr p(1 To 9)
    For I As Integer = 1 To 9
      p(I) = Threadcreate(@Thread, Cast(Any Ptr, I))
      Sleep 25, 1
    Next I
    For I As Integer = 1 To 9
      Threadwait(p(I))
    Next I
  End Sub
  
  mutex = Mutexcreate
  
  Screen 0
  test()
  Locate 15, 1
  Print "Any key to continue"
  Sleep
  
  Screen 12
  test()
  Locate 15, 1
  Print "Any key to quit"
  Sleep
  
  Mutexdestroy(mutex)
  

  • Note: One can see that each thread writes now on its own line corresponding to its thread number (id between 1 and 9), on the console window and on the graphics window.
  - Example showing that the Color keyword is not thread-safe when applied on a console window, but is thread-safe when applied on a graphics window (the color states being thread dependent in that case):

  Code: Select all

  Sub Thread (Byval p As Any Ptr)
    Color Cast(Integer, p) + 8, Cast(Integer, p)
    For I As Integer = 1 To 50 - 2 * Cast(Integer, p)
      Print " " & Cast(Integer, p) & " ";
      Sleep 20 * Cast(Integer, p), 1
    Next I
  End Sub
  
  Sub test ()
    Dim As Any Ptr p(1 To 9)
    Locate 1, 1
    For I As Integer = 1 To 9
      p(I) = Threadcreate(@Thread, Cast(Any Ptr, I))
      Sleep 25, 1
    Next I
    For I As Integer = 1 To 9
      Threadwait(p(I))
    Next I
    Locate 16, 1
  End Sub
  
  Screen 0
  test()
  Print "Any key to continue"
  Sleep
  
  Screen 12
  test()
  Print "Any key to quit"
  Sleep
  

  • Note: One can see that the foreground/background colors are not specific to the thread number (id between 1 and 9) on the console window, but this works great on the graphics window.
  - From the above example, the thread code has been completed in its competing sections by mutex locking blocks and by saving/restoring color states before/after its own color values usage:

  Code: Select all

  Dim Shared As Any Ptr mutex
  
  Sub Thread (Byval p As Any Ptr)
    Mutexlock(mutex)
      Dim As Ulong c0 = Color(Cast(Integer, p) + 8, Cast(Integer, p))
      Dim As Ulong c = Color()
      Color(Loword(c0), Hiword(c0))
    Mutexunlock(mutex)
    For I As Integer = 1 To 50 - 2 * Cast(Integer, p)
      Mutexlock(mutex)
        c0 = Color(Loword(c), Hiword(c))
        Print " " & Cast(Integer, p) & " ";
        Color(Loword(c0), Hiword(c0))
      Mutexunlock(mutex)
      Sleep 20 * Cast(Integer, p), 1
    Next I
  End Sub
  
  Sub test ()
    Dim As Any Ptr p(1 To 9)
    Locate 1, 1
    For I As Integer = 1 To 9
      p(I) = Threadcreate(@Thread, Cast(Any Ptr, I))
      Sleep 25, 1
    Next I
    For I As Integer = 1 To 9
      Threadwait(p(I))
    Next I
    Locate 16, 1
  End Sub
  
  mutex = Mutexcreate
  
  Screen 0
  test()
  Print "Any key to continue"
  Sleep
  
  Screen 12
  test()
  Print "Any key to quit"
  Sleep
  
  Mutexdestroy(mutex)
  

  • Note: One can see that the foreground/background colors are now specific to the thread number (id between 1 and 9) on the console window (obviously this always works on the graphics window).
• Therefore, for using Getkey or Input in competing sections of threads:
  • Only a single thread (for example, the main thread) can uses Getkey or Input in addition to console statements (such as Locate, Print, Color, ...) and also Inkey, in its competing sections.
  • The other threads must not to use in their competing sections any console statement neither any keyboard input keyword, but can use by cons graphics statements (such as Pset, Line, Circle, Draw String, graphic Color, ...) which are themselves thread-safe (they can interlace graphically with the main thread without any problem).
  • Input and Getkey also exclude the screen locking usage in competing sections of threads (double buffering is recommended as anti-flickering method).
  - Example showing that graphics statements (such as Line and Draw String and Screencopy) in a thread (user thread here) can compete with console statements (such as Locate and Print and Input) in another thread (main thread here), without using any exclusion (by mutex):

  Code: Select all

  #include "vbcompat.bi"
  
  Screen 12, , 2
  Screenset 1, 0   
  Color 0, 7
  Cls
  
  Dim Shared terminate As Integer = 0
  
  Sub thread (byval param As Any Ptr)   
    Screenset 1, 0
    Do
      Line (16, 432)-Step(96, 32), 11, BF  'clear the print area
      Sleep 100, 1
      Draw String (24, 432), Format(Now,"dd/mm/yyyy"), 0
      Draw String (32, 448), Format(Now,"hh:mm:ss"), 0
      Screencopy
      Sleep 100, 1
    Loop Until terminate = 1
  End Sub
  
  Dim As String reply
  Locate 2, 2
  Print "Enter ""quit"" to quit"
  Screencopy
  
  Dim p As Any Ptr = ThreadCreate(@thread)
  
  Do
    Locate 3, 2
    Print Space(Len(reply) + 2);
    Locate 3, 2
    Input reply
  Loop Until Lcase(reply) = "quit"
  
  Print " Stop the thread"
  Screencopy
  terminate=1
  Threadwait (p)
  Print " Thread terminated"
  Screencopy
  
  Sleep
  

  • Note: The Sleep keyword just after the 'clear the print area' line is only here to highlight the flickering if no double buffering is used (screen locking being forbidden by Input usage).
  - From the above example, if the date displaying and the time displaying are now two separate user threads, an exclusion mutex code block between these two threads only is mandatory, not due to the graphics statements themselves competing, but only due to the double buffering method used (against flickering) that puts competing these two user threads only:

  Code: Select all

  #include "vbcompat.bi"
  
  Screen 12, , 2
  Screenset 1, 0   
  Color 0, 7
  Cls
  
  Dim Shared terminate As Integer = 0
  Dim Shared mutex As Any Ptr
  
  Sub thread1 (byval param As Any Ptr)   
    Screenset 1, 0
    Do
      Mutexlock(mutex)
        Line (16, 432)-Step(96, 16), 11, BF  'clear the print area
        Sleep 200, 1
        Draw String (24, 432), Format(Now,"dd/mm/yyyy"), 0
        Screencopy
      Mutexunlock(mutex)
      Sleep 100, 1
    Loop Until terminate = 1
  End Sub
  
  Sub thread2 (byval param As Any Ptr)   
    Screenset 1, 0
    Do
      Mutexlock(mutex)
        Line (16, 448)-Step(96, 16), 11, BF  'clear the print area
        Sleep 100, 1
        Draw String (32, 448), Format(Now,"hh:mm:ss"), 0
        Screencopy
      Mutexunlock(mutex)
      Sleep 100, 1
    Loop Until terminate = 1
  End Sub
  
  Dim As String reply
  Locate 2, 2
  Print "Enter ""quit"" to quit"
  Screencopy
  
  mutex = Mutexcreate
  Dim p1 As Any Ptr = ThreadCreate(@thread1)
  Dim p2 As Any Ptr = ThreadCreate(@thread2)
  
  Do
    Locate 3, 2
    Print Space(Len(reply) + 2);
    Locate 3, 2
    Input reply
  Loop Until Lcase(reply) = "quit"
  
  Print " Stop the threads"
  Screencopy
  terminate=1
  Threadwait (p1)
  Threadwait (p2)
  Mutexdestroy(mutex)
  Print " Threads terminated"
  Screencopy
  
  Sleep
  

  • Note: The Sleep keyword just after the 'clear the print area' lines is only here to highlight the flickering if no double buffering is used (screen locking being forbidden by Input usage).

[fxm]

Can we emulate a kind of TLS (Thread Local Storage) with FreeBASIC?

Preamble

• Static variables are normally shared across all the threads. If we modify a static variable, it is visible so modified to all the threads.
  Unlike normal static variable, if we create a TLS static variable, every thread must have its own copy of the variable (but with the same access name), i.e. any change to the variable is local to the thread (locally stored).
  
  This allows to create a thread-safe procedure, because each call to this procedure gets its own copy of the same declared static variables.
  In normal procedure with static variables, the content of that variables can be updated by multiple threads, but with TLS, we can think of these as static data but local to each thread.
  
  TLS data is similar to static data, but the only difference is that TLS data are unique to each thread.

Description

• The principle of this TLS emulation for FreeBASIC is to use a static array for each requested TLS variable, where each thread has its own unique index (hidden) to access the array element.
  This unique index relating to the thread is deduced from the thread handle value:
  • With fbc version >= 1.08, the thread handle value is simply returned from the 'Threadself()' function calling (new function) from any thread.
  • With fbc version < 1.08, the code is more twisted:
    • - The thread handle value is only accessible from the 'ThreadCreate()' return in the parent (or main) thread when creating it.
      - There is no way to properly emulate the 'Threadself()' function, but only by a twisted method.
      - In the example below (for fbc version < 1.08), a 'Threadself()' function (returning by reference) value is initialized before each use by the thread (with its own thread handle), and all of this (initialization + use) protected by a mutex as for its corresponding 'ThreadCreate()'.

Example

• In the below example, the TLS static variable is an integer which is used in a single and generic counting procedure ('counter()') with none passed parameter). This counting procedure is called by each thread (thus each thread counts independently of each other but by calling the same single counting procedure).
  A single macro allows to define any TLS variable (except array) of any type.
  
  Code with preprocessor conditional directives depending on fbc version:

  Code: Select all

  #include once "crt/string.bi"
  
  #if __fb_version__ < "1.08"
      ' Emulation of the function Threadself() of FreeBASIC
      ' Before each use, the thread must refresh this function value with its own thread handle,
      ' and all of this (refreshing + use) protected by a mutex.
      Function Threadself () Byref As Any Ptr
          Static As Any Ptr handle
          Return handle
      End Function
  #else
      #include once "fbthread.bi"
  #endif
  
  #macro CreateTLSdatatypeVariableFunction (variable_function_name, variable_datatype)
  ' Creation of a "variable_function_name" function to emulate a static datatype variable (not an array),
  ' with a value depending on the thread using it.
      Function variable_function_name (Byval cd As Boolean = True) ByRef As variable_datatype
      ' Function emulating (creation/access/destruction) a static datatype variable with value depending on thread using it:
          ' If calling without parameter (or with 'True') parameter, this allows to [create and] access the static datatype variable.
          ' If calling with the 'False' parameter, this allows to destroy the static datatype variable.
          Dim As Integer bound = 0
          Static As Any Ptr TLSindex(bound)
          Static As variable_datatype TLSdata(bound)
          Dim As Any Ptr Threadhandle = Threadself()
          Dim As Integer index = 0
          For I As Integer = 1 To UBound(TLSindex)  ' search existing TLS variable (existing array element) for the running thread
              If TLSindex(I) = Threadhandle Then
                  index = I
                  Exit For
              End If
          Next I
          If index = 0 And cd = True Then  ' create a new TLS variable (new array element) for a new thread
              index = UBound(TLSindex) + 1
              Redim Preserve TLSindex(index)
              TLSindex(index) = Threadhandle
              Redim Preserve TLSdata(index)
          Elseif index > 0 And cd = False Then  ' destroy a TLS variable (array element) and compact the array
              If index < UBound(TLSindex) Then  ' reorder the array elements
                  memmove(@TLSindex(index), @TLSindex(index + 1), (UBound(TLSindex) - index) * Sizeof(Any Ptr))
                  Dim As variable_datatype Ptr p = Allocate(Sizeof(variable_datatype))  ' for compatibility to object with destructor
                  memmove(p, @TLSdata(index), Sizeof(variable_datatype))                ' for compatibility to object with destructor
                  memmove(@TLSdata(index), @TLSdata(index + 1), (UBound(TLSdata) - index) * Sizeof(variable_datatype))
                  memmove(@TLSdata(UBound(TLSdata)), p, Sizeof(variable_datatype))      ' for compatibility to object with destructor
                  Deallocate(p)                                                         ' for compatibility to object with destructor
              End If
              Redim Preserve TLSindex(UBound(TLSindex) - 1)
              Redim Preserve TLSdata(UBound(TLSdata) - 1)
              index = 0
          End If
          Return TLSdata(index)
      End Function
  #endmacro
  
  '------------------------------------------------------------------------------
  
  Type threadData
      Dim As Any Ptr handle
      Dim As String prefix
      Dim As String suffix
      Dim As Double tempo
      #if __fb_version__ < "1.08"
          Static As Any Ptr mutex
      #endif
  End Type
  #if __fb_version__ < "1.08"
      Dim As Any Ptr threadData.mutex
  #endif
  
  CreateTLSdatatypeVariableFunction (TLScount, Integer)  ' create a TLS static integer function
  
  Function counter() As Integer  ' definition of a generic counter with counting depending on thread calling it
      TLScount() += 1            ' increment the TLS static integer
      Return TLScount()          ' return the TLS static integer
  End Function
  
  Sub Thread(ByVal p As Any Ptr)
      Dim As threadData Ptr ptd = p
      Dim As UInteger c
      Do
          #if __fb_version__ < "1.08"
              MutexLock(threadData.mutex)
              Threadself() = ptd->handle
          #endif
              c = counter()
          #if __fb_version__ < "1.08"
              MutexUnlock(threadData.mutex)
          #endif
          Print ptd->prefix & c & ptd->suffix & " ";  ' single print with concatenated string avoids using a mutex
          Sleep ptd->tempo, 1
      Loop Until c = 12
      #if __fb_version__ < "1.08"
          MutexLock(threadData.mutex)
          Threadself() = ptd->handle
      #endif
      TLScount(False)  ' destroy the TLS static integer
      #if __fb_version__ < "1.08"
          MutexUnlock(threadData.mutex)
      #endif
  End Sub
  
  '------------------------------------------------------------------------------
  
  Print "|x| : counting from thread a"
  Print "(x) : counting from thread b"
  Print "[x] : counting from thread c"
  Print
  
  #if __fb_version__ < "1.08"
      threadData.mutex = MutexCreate()
  #endif
  
  Dim As threadData mtlsa
  mtlsa.prefix = "|"
  mtlsa.suffix = "|"
  mtlsa.tempo = 100
  #if __fb_version__ < "1.08"
      MutexLock(threadData.mutex)
  #endif
  mtlsa.handle = ThreadCreate(@Thread, @mtlsa)
  #if __fb_version__ < "1.08"
      MutexUnlock(threadData.mutex)
  #endif
  
  Dim As threadData mtlsb
  mtlsb.prefix = "("
  mtlsb.suffix = ")"
  mtlsb.tempo = 150
  #if __fb_version__ < "1.08"
      MutexLock(threadData.mutex)
  #endif
  mtlsb.handle = ThreadCreate(@Thread, @mtlsb)
  #if __fb_version__ < "1.08"
      MutexUnlock(threadData.mutex)
  #endif
  
  Dim As threadData mtlsc
  mtlsc.prefix = "["
  mtlsc.suffix = "]"
  mtlsc.tempo = 250
  #if __fb_version__ < "1.08"
      MutexLock(threadData.mutex)
  #endif
  mtlsc.handle = ThreadCreate(@Thread, @mtlsc)
  #if __fb_version__ < "1.08"
      MutexUnlock(threadData.mutex)
  #endif
  
  ThreadWait(mtlsa.handle)
  ThreadWait(mtlsb.handle)
  ThreadWait(mtlsc.handle)
  #if __fb_version__ < "1.08"
      MutexDestroy(threadData.mutex)
  #endif
  
  Print
  Print
  Print "end of threads"
  
  Sleep
  

  Example of output:

  |x| : counting from thread a
  (x) : counting from thread b
  [x] : counting from thread c
  
  |1| (1) [1] |2| (2) |3| [2] |4| (3) |5| (4) [3] |6| (5) |7| [4] |8| (6) |9| (7) |10| [5] (8) |11| |12| [6] (9) (10) [7] (11) (12) [8] [9] [10] [11] [12]
  
  end of threads

[edit]
16 Dec 2020 - Corrected some errors in the two examples.
16 Dec 2020 - Other correction to take into account TLS datatypes with destructor.

[VANYA]

Can we emulate a kind of TLS

As soon as I learned about the Threadself function, I immediately thought about the benefits of getting the thread ID in a procedure. And the first thought was just such a realization. When I was using streams, I always lacked the delimitation of static variables in different streams. Well done fxm for documenting this!

[fxm]

Can we emulate a kind of thread pooling feature with FreeBASIC?

Content

• Two Type structures are first proposed below:
  • ThreadInitThenMultiStart.
  • ThreadPooling.
  These two structures make it possible to use one thread per instance created, and to chain on this dedicated thread the execution of user procedures one after the other, but without the thread stopping between each:
  • - The 'ThreadInitThenMultiStart' structure requires a manual start after initialization (and manual wait for completion) for each user procedure to be executed in sequence in the thread.
    - The 'ThreadPooling' structure allows to register a sequence of user thread procedure submissions in a queue, while at same time the user procedures start to be executed in the thread without waiting (a last registered wait command is enough to test for full sequence completion).
  By creating and using several instances, these two structures make it possible to execute sequences of user procedures in several threads, therefore executed in parallel (temporally).
  
  A last structure is finally proposed:
  • ThreadDispatching.
  This last structure is an over-structure of the ThreadPooling structure, dispatching user thread procedures over a given max number of secondary threads.

ThreadInitThenMultiStart Type

• Principle
  • The 'ThreadInitThenMultiStart' Type below operationally provides to user 3 (4 actually) main public methods (plus a constructor and a destructor), and internally uses 9 private data members plus 1 private subroutine (static) member.
    
    The public methods are:
    • ThreadInit : Initialize the instance with the parameters of the requested user procedure to be executed in a thread.
    • ThreadStart : Start the user procedure execution in the thread (2 overload methods).
    • ThreadWait : Wait for the completion of the user procedure in the thread.
    By creating several instances each associated with a thread, we can obtain a kind of thread pooling feature.
    The 'ThreadInitThenMultiStart' Type does not manage any pending thread queue.
    It is up to the user to choose an existing instance or to create a new instance with which to run his thread procedure.
  Description
  • Each user procedure (to be executed in a thread) must be available under the following function signature:
    Function userproc (Byval puserdata As Any Ptr) As String
    in order to be compatible with the parameters of the 'ThreadInit()' method:
    Declare Sub ThreadInit (Byval pThread As Function (Byval As Any Ptr) As String, Byval p As Any Ptr = 0)
    and perform the instance ('t') initialization by:
    t.ThreadInit(@userproc [, puserdata])
    
    The other methods are called on the instance ('t'):
    t.ThreadStart() or t.ThreadStart(puserdata)
    t.ThreadWait()
    
    The different methods must be called respecting the order of the following sequence:
    ThreadInit, [user code,] ThreadStart, [user code,] ThreadWait, [user code,] ThreadStart, [user code,] ThreadWait, [user code,] .....
    
    After any 'ThreadStart'...'ThreadWait' sequence, a new user thread procedure can be initialized by calling the 'ThreadInit' method again on the same instance.
    On the other hand, 'ThreadStart'...'ThreadWait' sequences can also be chained on different instances already initialized.
    If using several instances (so several threads), the ordered sequences on each instance can be interlaced between instances because calling methods on different instances.
    The overload method 'ThreadStart(Byval p As Any Ptr)' allows to start the user thread procedure by specifying a new parameter value, without having to call 'ThreadInit' first. The overload method 'ThreadStart()' starts the user thread procedure without modifying the parameter value.
    
    The 'ThreadWait' method returns a 'As String' Type (by value), like the user thread function is declared (a string variable return allows to also pass a numeric value).
    This user data return from the user function is accessed through the 'ThreadWait' return. It is always safe (because in this case, the user thread function has been always fully executed).
    If the user doesn't want to use the return value of his thread function (to be used like for a subroutine):
    • - He ends his user thread function with 'Return ""' for example.
      - He calls 'ThreadWait' as a subroutine and not as a function (not accessing the value potentially returned by 'ThreadWait').
    Warning: The information supplied to the user thread procedure via the passed pointer (by 'ThreadInit' or 'ThreadStart') should not be changed between 'ThreadStart' and 'ThreadWait' due to the time uncertainty on the real call of the user thread procedure in this interval.
  Under the hood
  • In fact, each instance is associated with an internal thread that runs continuously in a loop as soon as a first initialization ('ThreadInit') has taken place. This internal thread runs the private subroutine (static) member.
    It is this private subroutine (static) member that will call (on a 'ThreadStart') the user procedure to be executed, like a classic function call. The value returned by the user function is stored to be subsequently returned to the user through the returned value by 'ThreadWait'.
    
    So, for each new 'ThreadInitThenMultiStart' instance, an internal thread is started on the first 'ThreadInit' method (calling the 'ThreadCreate' FreeBASIC keyword), then the user thread procedure is started on the 'ThreadStart' method request.
    As each initialized instance is associated with a running internal thread, using local scopes or dynamic instances allow to stop internal threads that are no longer used.
    
    In the 'ThreadInitThenMultiStart' Type, an additional property 'ThreadState' is available to returns (in a Ubyte) the current internal state of the process.
    This property allows to sample at any time the state of the internal thread.
    This property can also be used during the debugging phase (allowing in addition to identify the case of blocking in the user thread procedure running).
    
    ThreadState flags:
    • 0 -> disabled (internal thread stopped, waiting for 'ThreadInit')
      1 -> available (waiting for 'ThreadStart' or another 'ThreadInit')
      2 -> busy (user thread procedure running)
      4 -> completing (user thread procedure completed, but waiting for 'ThreadWait')
      (possible Ubyte values : 0, 1, 2, 4)
    Internally, the Type uses 3 mutexes (by self locking and mutual unlocking) to ensure the ordered sequence of methods called as defined above and wait for the end of the user thread function or for a new user thread function to call.
    So, no waiting loop is used in the methods coding but only mutexes locking/unlocking requests, so that the halted thread (on a mutex to be locked) has its execution suspended and does not consume any CPU time until the mutex is unlocked.
    The constructor is responsible for creating and locking the 3 mutexes, while the destructor stops the thread (if it exists) then destroys the 3 mutexes.
    
    Note: An advised user can stop the internal thread (linked to instance 't') by using the non-breaking sequence: 't.Destructor() : t.Constructor()'. Then a 't.ThreadInit(...)' is necessary to start a new internal thread.
  Example
  • Chronology of the user code:
    • - A single 'ThreadInitThenMultiStart' instance is created in order to use a single thread.
      - The instance is initialized ('ThreadInit') with a first user thread function: 'UserThreadS' (internal thread creation by using the 'ThreadCreate' FreeBASIC keyword).
      - A sequence of 9 'ThreadStart...ThreadWait' is requested for this first user thread function, used like a thread subroutine.
      - The same instance is reinitialized ('ThreadInit') with a second user thread function: 'UserThreadF' (the previous pending thread will be reused).
      - A sequence of 9 'ThreadStart...ThreadWait' is also requested for this second user thread function, used like a thread function.
    Full code with the 'ThreadInitThenMultiStart' Type:

    • 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)
              Declare Constructor(Byref t As ThreadInitThenMultiStart)
              Declare Operator Let(Byref t As ThreadInitThenMultiStart)
      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
      
      '---------------------------------------------------
      
      Function UserThreadS(ByVal p As Any Ptr) As String
          Dim As UInteger Ptr pui = p
          Print *pui * *pui
          Return ""
      End Function
      
      Function UserThreadF(ByVal p As Any Ptr) As String
          Dim As UInteger Ptr pui = p
          Dim As UInteger c = (*pui) * (*pui)
          Return Str(c)
      End Function
      
      Dim As ThreadInitThenMultiStart t
      
      Print "First user function executed like a thread subroutine:"
      t.ThreadInit(@UserThreadS)  '' initializes the user thread function (used as subroutine)
      For I As UInteger = 1 To 9
          Print I & "^2 = ";
          t.ThreadStart(@I)       '' starts the user thread procedure code body
          t.ThreadWait()          '' waits for the user thread procedure code end
      Next I
      Print
      
      Print "Second user function executed like a thread function:"
      t.ThreadInit(@UserThreadF)  '' initializes the user thread function (used as function)
      For I As UInteger = 1 To 9
          Print I & "^2 = ";
          t.ThreadStart(@I)       '' starts the user thread procedure code body
          Print t.ThreadWait()    '' waits for the user thread procedure code end and prints result
      Next I
      Print
      
      Sleep
      

    Output:

    • Code: Select all

      First user function executed like a thread subroutine:
      1^2 = 1
      2^2 = 4
      3^2 = 9
      4^2 = 16
      5^2 = 25
      6^2 = 36
      7^2 = 49
      8^2 = 64
      9^2 = 81
      
      Second user function executed like a thread function:
      1^2 = 1
      2^2 = 4
      3^2 = 9
      4^2 = 16
      5^2 = 25
      6^2 = 36
      7^2 = 49
      8^2 = 64
      9^2 = 81

ThreadPooling Type

• Principle
  • The 'ThreadPooling' Type below operationally provides to user 2 (3 actually) main public methods (plus a constructor and a destructor), and internally uses 11 private data members plus 1 private subroutine (static) member.
    
    The public methods are:
    • PoolingSubmit : Enter a user thread procedure in the queue.
    • PoolingWait : Wait for full emptying of the queue (with last user procedure executed).
    By creating several instances each associated with a thread, we can obtain a kind of thread pooling feature.
    The 'ThreadPooling' Type manages a pending thread queue by instance (so, by thread).
    It is up to the user to choose an existing instance or to create a new instance with which to run his thread procedure sequence.
    
    On each 'ThreadPooling' Type instance, the submitted user thread procedures are immediately entered in a queue specific to the instance.
    These buffered user thread procedures are sequentially as soon as possible executed in the thread dedicated to the instance.
  Description
  • Each user procedure (to be executed in a thread) must be available under the following function signature:
    Function userproc (Byval puserdata As Any Ptr) As String
    in order to be compatible with the parameters of the 'PoolingSubmit()' method:
    Declare Sub PoolingSubmit (Byval pThread As Function (Byval As Any Ptr) As String, Byval p As Any Ptr = 0)
    and perform the instance ('t') submission in the queue by:
    t.PoolingSubmit(@userproc [, puserdata])
    
    The other method is called on the instance ('t'):
    t.PoolingWait() or t.PoolingWait(returndata())
    
    The different methods must be called respecting the order of the following sequence:
    PoolingSubmit, [user code,] [PoolingSubmit, [user code,] [PoolingSubmit, [user code, ...]] PoolingWait, [user code,] ...
    
    After any 'PoolingSubmit'...'PoolingWait' sequence, a new user thread procedure sequence can be submitted by calling another 'PoolingSubmit'...'PoolingWait' sequence again on the same instance.
    On the other hand, 'PoolingSubmit'...'PoolingWait' sequences can also be chained on different instances already initialized.
    If using several instances (so several threads), the ordered sequences on each instance can be interlaced between instances because calling methods on different instances.
    
    The 'PoolingWait(returndata())' method fills in a String array with the user thread function returns (a string variable return allows to also pass a numeric value).
    These user data returns from the user functions is accessed through the argument of 'PoolingWait(returndata())' method. It is always safe (because in this case, the user thread functions has been always fully executed).
    If the user doesn't want to use the return values of his thread functions (to be used like for subroutines):
    • - He ends his user thread functions with 'Return ""' for example.
      - He calls the 'PoolingWait()' method without parameter.
    Warning: The information supplied to the user thread procedure via the passed pointer (by 'PoolingSubmit') should not be changed between 'PoolingSubmit' and 'PoolingWait' due to the time uncertainty on the real call of the user thread procedure in this interval.
  Under the hood
  • In fact, each instance is associated with an internal thread that runs continuously in a loop as soon as the instance is constructed. This internal thread runs the private subroutine (static) member.
    It is this private subroutine (static) member that will call the user procedures of the sequence to be executed, like classic function calls. The value returned by each user function is stored in an internal string array to be finally returned to the user through the argument of 'PoolingWait(returndata())'.
    
    So, for each new 'ThreadPooling' instance, an internal thread is started by the constructor, then each user thread procedure is started on each dequeuing of the registered submissions.
    As each initialized instance is associated with a running internal thread, using local scopes or dynamic instances allow to stop internal threads that are no longer used.
    
    In the 'ThreadPooling' Type, an additional property 'PoolingState' is available to returns (in a Ubyte) the current internal state of the process.
    This property allows to sample at any time the state of the internal thread.
    This property can also be used during the debugging phase (allowing in addition to identify the case of blocking in the user thread procedure running).
    
    PoolingState flags:
    • 0 -> User thread procedures sequence execution completed (after 'PoolingWait' acknowledge or new instance creation)
      1 -> Beginning of user thread procedure sequence submitted but no still executing (after first 'PoolingSubmit')
      2 -> User thread procedure running
      4 -> User thread procedure sequence execution pending (for 'PoolingWait' acknowledge or new user thread procedure submission)
      8 -> User thread procedure submission queue not empty
      (possible Ubyte values : 0, 1, 2, 4, 9, 10)
    An overload method 'PoolingWait(values() As String)' is added.
    'PoolingWait(values() As String)' fills out a user-supplied dynamic array with the return value sequence from the latest user thread functions (then internally clear these same supplied return data).
    The other overload method 'PoolingWait()' (without passed parameter) also clears the internal return values.
    
    'ThreadPooling' Type allows to manage kind of "FIFOs" (First In First Out) via dynamic arrays:
    • - Arrays are filled in as user submissions (from the main thread).
      - Arrays are automatically emptied on the fly by the secondary thread which executes their requests as and when.
      - So, the inputs and outputs of the "FIFOs" are therefore asynchronous with an optimized throughput on each side.
    With 'ThreadPooling' the execution time of a 'PoolingSubmit' method in the main thread, corresponds only to the time spent to register the user procedure submission.
    
    It is necessary to be able to do (for the 'PoolingSubmit', 'PoolingWait' and 'Destructeur' methods, all in competition with '_Thread' subroutine) atomic mutex unlockings, which is not possible with simple mutexlocks / mutexunlocks.
    This therefore requires the use of conditional variables (condwait / condsignal).
    
    The constructor is responsible for creating the 2 conditional variables and the associated mutex, while the destructor stops the thread then destroys the 2 conditional variables and the associated mutex.
  Example
  • Chronology of the user code:
    • - A single 'ThreadPooling' instance is created in order to use a single thread.
      - A first sequence (a) of 3 'PoolingSubmit' is requested for the first three user thread functions, ended by a 'PoolingWait' without parameter.
      - A second sequence (b) of 3 'PoolingSubmit' is requested for the last three user thread functions, ended by a 'PoolingWait' with a dynamic string array as argument (so, only the returns from the last three user thread functions will fill out in the dynamic string array).
    Full code with the 'ThreadPooling' Type:

    • 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
      
      '---------------------------------------------------
      
      Sub Prnt (ByRef s As String, ByVal p As Any Ptr)
          Dim As String Ptr ps = p
          If ps > 0 Then Print *ps;
          For I As Integer = 1 To 10
              Print s;
              Sleep 100, 1
          Next I
      End Sub
      
      Function UserCode1 (ByVal p As Any Ptr) As String
          Prnt("1", p)
          Return "UserCode #1"
      End Function
      
      Function UserCode2 (ByVal p As Any Ptr) As String
          Prnt("2", p)
          Return "UserCode #2"
      End Function
      
      Function UserCode3 (ByVal p As Any Ptr) As String
          Prnt("3", p)
          Return "UserCode #3"
      End Function
      
      Function UserCode4 (ByVal p As Any Ptr) As String
          Prnt("4", p)
          Return "UserCode #4"
      End Function
      
      Function UserCode5 (ByVal p As Any Ptr) As String
          Prnt("5", p)
          Return "UserCode #5"
      End Function
      
      Function UserCode6 (ByVal p As Any Ptr) As String
          Prnt("6", p)
          Return "UserCode #6"
      End Function
      
      Dim As String sa = "  Sequence #a: "
      Dim As String sb = "  Sequence #b: "
      Dim As String s()
      
      Dim As ThreadPooling t
      
      t.PoolingSubmit(@UserCode1, @sa)
      t.PoolingSubmit(@UserCode2)
      t.PoolingSubmit(@UserCode3)
      Print " Sequence #a of 3 user thread functions fully submitted "
      t.PoolingWait()
      Print
      Print " Sequence #a completed"
      Print
      
      t.PoolingSubmit(@UserCode4, @sb)
      t.PoolingSubmit(@UserCode5)
      t.PoolingSubmit(@UserCode6)
      Print " Sequence #b of 3 user thread functions fully submitted "
      t.PoolingWait(s())
      Print
      Print " Sequence #b completed"
      Print
      
      Print " List of returned values from sequence #b only"
      For I As Integer = LBound(s) To UBound(s)
          Print "  " & I & ": " & s(I)
      Next I
      Print
      
      Sleep
      

    Output example:

    • Code: Select all

       Sequence #a of 3 user thread functions fully submitted
        Sequence #a: 111111111122222222223333333333
       Sequence #a completed
      
       Sequence #b of 3 user thread functions fully submitted
        Sequence #b: 444444444455555555556666666666
       Sequence #b completed
      
       List of returned values from sequence #b only
        1: UserCode #4
        2: UserCode #5
        3: UserCode #6

      Note: If the first user thread procedure of each sequence starts very quickly, the acknowledgement message of each sequence of 3 submissions may appear inserted after the beginning of the text printed by the first user procedure of the sequence.
      That is not the case here.

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

• Principle
  • The maximum number of secondary threads that can be used is fixed when constructing the 'ThreadDispatching' instance (1 secondary thread by default), and also the minimum number of initialized secondary threads (0 secondary thread by default).
    'ThreadDispatching' manages an internal dynamic array of pointers to 'ThreadPooling' instances.
    
    If a secondary thread is available (already existing instance of 'ThreadPooling' pending), it is used to submit the user thread procedure.
    Otherwise, a new secondary thread is created (new instance of 'ThreadPooling' created) by respecting the number of secondary threads allowed.
    As long as all potential secondary threads are already in use, each new user thread procedure is distributed evenly over them.
  Description
  • Methods:
    • Constructor : Construct a 'ThreadDispatching' instance and set the maximum number of usable secondary threads (1 by default) and set the minimum number of initialized secondary thread (0 by default).
    • DispatchingSubmit : Enter a user thread procedure in the queue of the "best" secondary thread among the usable ones.
    • DispatchingWait : Wait for the complete emptying of the queues of all secondary threads used (with all last user procedures executed).
    • DispatchingThread : Return the number of internal threads really started.
    • Destructor : Stop and complete the secondary threads used.
    In the 'ThreadDispatching' Type, an additional sub 'DispatchingState(state() As Ubyte)' is available to returns (in a Ubyte array) the current state of each internal thread started.
    This sub allows to sample at any time the state of the internal threads started.
    This sub can also be used during the debugging phase (allowing in addition to identify the case of blocking in the user thread procedure running).
    
    DispatchingState flags (a Ubyte for each internal thread started):
    • 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
      (possible Ubyte values : 0, 1, 2, 4, 9, 10)
    The 'DispatchingWait(returndata())' method fills in a String array with the user thread function returns (a string variable return allows to also pass a numeric value). In the array, the user thread function returns are grouped by internal threads really used, in the order they were started.
    These user data returns from the user functions is accessed through the argument of 'DispatchingWait(returndata())' method. It is always safe (because in this case, the user thread functions has been always fully executed).
    If the user doesn't want to use the return values of his thread functions (to be used like for subroutines):
    • - He ends his user thread functions with Return "" for example.
      - He calls the 'DispatchingWait()' method without parameter.
  Example
  • Example of use of 'ThreadDispatching' (whatever the allowed number of secondary threads, the submission sequence syntax is always the same):

    • Code: Select all

      #include once "crt/string.bi"
      
      Type 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
      
      '---------------------------------------------------
      
      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)
              Declare Constructor(Byref t As ThreadDispatching)
              Declare Operator Let(Byref t As ThreadDispatching)
      End Type
      
      Constructor ThreadDispatching(ByVal nbMaxSecondaryThread As Integer = 1, ByVal nbMinSecondaryThread As Integer = 0)
          This._nbmst = nbMaxSecondaryThread
          If nbMinSecondaryThread > nbMaxSecondaryThread Then
              nbMinSecondaryThread = nbMaxSecondaryThread
          End If
          If nbMinSecondaryThread > 0 Then
              ReDim This._tp(nbMinSecondaryThread - 1)
              For I As Integer = 0 To nbMinSecondaryThread - 1
                  This._tp(I) = New ThreadPooling
              Next I
          End If
      End Constructor
      
      Sub ThreadDispatching.DispatchingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
          For I As Integer = 0 To UBound(This._tp)
              If (This._tp(I)->PoolingState And 11) = 0 Then
                  This._tp(I)->PoolingSubmit(pThread, p)
                  Exit Sub
              End If
          Next I
          If UBound(This._tp) < This._nbmst - 1 Then
              ReDim Preserve This._tp(UBound(This._tp) + 1)
              This._tp(UBound(This._tp)) = New ThreadPooling
              This._tp(UBound(This._tp))->PoolingSubmit(pThread, p)
          ElseIf UBound(This._tp) >= 0 Then
              This._tp(This._dstnb)->PoolingSubmit(pThread, p)
              This._dstnb = (This._dstnb + 1) Mod This._nbmst
          End If
      End Sub
      
      Sub ThreadDispatching.DispatchingWait()
          For I As Integer = 0 To UBound(This._tp)
              This._tp(I)->PoolingWait()
          Next I
      End Sub
      
      Sub ThreadDispatching.DispatchingWait(values() As String)
          Dim As String s()
          For I As Integer = 0 To UBound(This._tp)
              This._tp(I)->PoolingWait(s())
              If UBound(s) >= 1 Then
                  If UBound(values) = -1 Then
                      ReDim Preserve values(1 To UBound(values) + UBound(s) + 1)
                  Else
                      ReDim Preserve values(1 To UBound(values) + UBound(s))
                  End If
                  For I As Integer = 1 To UBound(s)
                      values(UBound(values) - UBound(s) + I) = s(I)
                  Next I
              End If
          Next I
      End Sub
      
      Property ThreadDispatching.DispatchingThread() As Integer
          Return UBound(This._tp) + 1
      End Property
      
      Sub ThreadDispatching.DispatchingState(state() As Ubyte)
          If UBound(This._tp) >= 0 Then
              Redim state(1 To UBound(This._tp) + 1)
              For I As Integer = 0 To UBound(This._tp)
                  state(I + 1) = This._tp(I)->PoolingState
              Next I
          End If
      End Sub
      
      Destructor ThreadDispatching()
          For I As Integer = 0 To UBound(This._tp)
              Delete This._tp(I)
          Next I
      End Destructor
      
      '---------------------------------------------------
      
      Sub Prnt (ByRef s As String, ByVal p As Any Ptr)
          Dim As String Ptr ps = p
          If ps > 0 Then Print *ps;
          For I As Integer = 1 To 10
              Print s;
              Sleep 100, 1
          Next I
      End Sub
      
      Function UserCode1 (ByVal p As Any Ptr) As String
          Prnt("1", p)
          Return "UserCode #1"
      End Function
      
      Function UserCode2 (ByVal p As Any Ptr) As String
          Prnt("2", p)
          Return "UserCode #2"
      End Function
      
      Function UserCode3 (ByVal p As Any Ptr) As String
          Prnt("3", p)
          Return "UserCode #3"
      End Function
      
      Function UserCode4 (ByVal p As Any Ptr) As String
          Prnt("4", p)
          Return "UserCode #4"
      End Function
      
      Function UserCode5 (ByVal p As Any Ptr) As String
          Prnt("5", p)
          Return "UserCode #5"
      End Function
      
      Function UserCode6 (ByVal p As Any Ptr) As String
          Prnt("6", p)
          Return "UserCode #6"
      End Function
      
      Sub SubmitSequence(ByRef t As ThreadDispatching, ByVal ps As String Ptr)
          t.DispatchingSubmit(@UserCode1, ps)
          t.DispatchingSubmit(@UserCode2)
          t.DispatchingSubmit(@UserCode3)
          t.DispatchingSubmit(@UserCode4)
          t.DispatchingSubmit(@UserCode5)
          t.DispatchingSubmit(@UserCode6)
      End Sub  
      
      Dim As String sa = "  Sequence #a: "
      Dim As String sb = "  Sequence #b: "
      Dim As String sc = "  Sequence #c: "
      Dim As String sd = "  Sequence #d: "
      Dim As String se = "  Sequence #e: "
      Dim As String sf = "  Sequence #f: "
      Dim As String s()
      
      Dim As ThreadDispatching t1, t2 = 2, t3 = 3, t4 = 4, t5 = 5, t6 = 6
      
      Print " Sequence #a of 6 user thread functions dispatched over 1 secondary thread:"
      SubmitSequence(t1, @sa)
      t1.DispatchingWait()
      Print
      Print
      
      Print " Sequence #b of 6 user thread functions dispatched over 2 secondary threads:"
      SubmitSequence(t2, @sb)
      t2.DispatchingWait()
      Print
      Print
      
      Print " Sequence #c of 6 user thread functions dispatched over 3 secondary threads:"
      SubmitSequence(t3, @sc)
      t3.DispatchingWait()
      Print
      Print
      
      Print " Sequence #d of 6 user thread functions dispatched over 4 secondary threads:"
      SubmitSequence(t4, @sd)
      t4.DispatchingWait()
      Print
      Print
      
      Print " Sequence #e of 6 user thread functions dispatched over 5 secondary threads:"
      SubmitSequence(t5, @se)
      t5.DispatchingWait()
      Print
      Print
      
      Print " Sequence #f of 6 user thread functions dispatched over 6 secondary threads:"
      SubmitSequence(t6, @sf)
      t6.DispatchingWait(s())
      Print
      
      Print "  List of returned values from sequence #f:"
      For I As Integer = LBound(s) To UBound(s)
          Print "   " & I & ": " & s(I)
      Next I
      
      Sleep
      

    Output:

    • Code: Select all

       Sequence #a of 6 user thread functions dispatched over 1 secondary thread:
        Sequence #a: 111111111122222222223333333333444444444455555555556666666666
      
       Sequence #b of 6 user thread functions dispatched over 2 secondary threads:
        Sequence #b: 122112121212122112213434344343344343344356566565565656565665
      
       Sequence #c of 6 user thread functions dispatched over 3 secondary threads:
        Sequence #c: 123123312321213132321231213321465654546465546546456654654564
      
       Sequence #d of 6 user thread functions dispatched over 4 secondary threads:
        Sequence #d: 134243211234432114322341413241233124413256655656566556655656
      
       Sequence #e of 6 user thread functions dispatched over 5 secondary threads:
        Sequence #e: 134255243141235325415143215234342511524343521251346666666666
      
       Sequence #f of 6 user thread functions dispatched over 6 secondary threads:
        Sequence #f: 534126216354456132241365563142421365316524245613361245365421
        List of returned values from sequence #f:
         1: UserCode #1
         2: UserCode #2
         3: UserCode #3
         4: UserCode #4
         5: UserCode #5
         6: UserCode #6
      

ThreadInitThenMultiStart, ThreadPooling, and ThreadDispatching Types comparison

• Execution time gain checking with different multi-threading configurations
  • A user task is defined:
    • - Display 64 characters (2*32) on the screen, each separated by an identical time achieved by a [For ... Next] loop (no Sleep keyword so as not to free up CPU resources).
      - For 'ThreadInitThenMultiStart' and 'ThreadPooling': Depending on the number of threads chosen 1/2/4/8/16/32, this same user task is split in 1/2/4/8/16/32 sub-tasks, each being executed on a thread.
      - For 'ThreadDispatching': 32 sub-tasks are always used and the distribution of these sub-tasks over the available threads (max = 1/2/4/8/16/32) is automatic.
    Full code with the 'ThreadInitThenMultiStart', 'ThreadPooling', and 'ThreadDispatching' Types:

    • 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)
              Declare Constructor(Byref t As ThreadInitThenMultiStart)
              Declare Operator Let(Byref t As ThreadInitThenMultiStart)
      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)
              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
      
      '---------------------------------------------------
      
      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)
              Declare Constructor(Byref t As ThreadDispatching)
              Declare Operator Let(Byref t As ThreadDispatching)
      End Type
      
      Constructor ThreadDispatching(ByVal nbMaxSecondaryThread As Integer = 1, ByVal nbMinSecondaryThread As Integer = 0)
          This._nbmst = nbMaxSecondaryThread
          If nbMinSecondaryThread > nbMaxSecondaryThread Then
              nbMinSecondaryThread = nbMaxSecondaryThread
          End If
          If nbMinSecondaryThread > 0 Then
              ReDim This._tp(nbMinSecondaryThread - 1)
              For I As Integer = 0 To nbMinSecondaryThread - 1
                  This._tp(I) = New ThreadPooling
              Next I
          End If
      End Constructor
      
      Sub ThreadDispatching.DispatchingSubmit(ByVal pThread As Function(ByVal As Any Ptr) As String, ByVal p As Any Ptr = 0)
          For I As Integer = 0 To UBound(This._tp)
              If (This._tp(I)->PoolingState And 11) = 0 Then
                  This._tp(I)->PoolingSubmit(pThread, p)
                  Exit Sub
              End If
          Next I
          If UBound(This._tp) < This._nbmst - 1 Then
              ReDim Preserve This._tp(UBound(This._tp) + 1)
              This._tp(UBound(This._tp)) = New ThreadPooling
              This._tp(UBound(This._tp))->PoolingSubmit(pThread, p)
          ElseIf UBound(This._tp) >= 0 Then
              This._tp(This._dstnb)->PoolingSubmit(pThread, p)
              This._dstnb = (This._dstnb + 1) Mod This._nbmst
          End If
      End Sub
      
      Sub ThreadDispatching.DispatchingWait()
          For I As Integer = 0 To UBound(This._tp)
              This._tp(I)->PoolingWait()
          Next I
      End Sub
      
      Sub ThreadDispatching.DispatchingWait(values() As String)
          Dim As String s()
          For I As Integer = 0 To UBound(This._tp)
              This._tp(I)->PoolingWait(s())
              If UBound(s) >= 1 Then
                  If UBound(values) = -1 Then
                      ReDim Preserve values(1 To UBound(values) + UBound(s) + 1)
                  Else
                      ReDim Preserve values(1 To UBound(values) + UBound(s))
                  End If
                  For I As Integer = 1 To UBound(s)
                      values(UBound(values) - UBound(s) + I) = s(I)
                  Next I
              End If
          Next I
      End Sub
      
      Property ThreadDispatching.DispatchingThread() As Integer
          Return UBound(This._tp) + 1
      End Property
      
      Sub ThreadDispatching.DispatchingState(state() As Ubyte)
          If UBound(This._tp) >= 0 Then
              Redim state(1 To UBound(This._tp) + 1)
              For I As Integer = 0 To UBound(This._tp)
                  state(I + 1) = This._tp(I)->PoolingState
              Next I
          End If
      End Sub
      
      Destructor ThreadDispatching()
          For I As Integer = 0 To UBound(This._tp)
              Delete This._tp(I)
          Next I
      End Destructor
      
      '---------------------------------------------------
      
      Dim Shared As Double array(1 To 800000)  '' only used by the [For...Next] waiting loop in UserCode()
      
      Function UserCode (ByVal p As Any Ptr) As String
          Dim As String Ptr ps = p
          For I As Integer = 1 To 2
              Print *ps;
              For J As Integer = 1 To 800000
                  array(J) = Tan(J) * Atn(J) * Exp(J) * Log(J)  '' [For...Next] waiting loop not freeing any CPU resource
              Next J
          Next I
          Return ""
      End Function
      
      Dim As String s(0 To 31)
      For I As Integer = 0 To 15
          s(I) = Str(Hex(I))
      Next I
      For I As Integer = 16 To 31
          s(I) = Chr(55 + I)
      Next I
      
      '---------------------------------------------------
      
      #macro ThreadInitThenMultiStartSequence(nbThread)
      Scope
          ReDim As ThreadInitThenMultiStart ts(nbThread - 1)
          Print "   ";
          Dim As Double t = Timer
          For I As Integer = 0 To 32 - nbThread Step nbThread
              For J As Integer = 0 To nbThread - 1
                  ts(J).ThreadInit(@UserCode, @s(I + J))
                  ts(J).ThreadStart()
              Next J
              For J As Integer = 0 To nbThread - 1
                  ts(J).ThreadWait()
              Next J
          Next I
          t = Timer - t
          Print Using " : ####.## s"; t
      End Scope
      #endmacro
      
      #macro ThreadPoolingSequence(nbThread)
      Scope
          ReDim As ThreadPooling tp(nbThread - 1)
          Print "   ";
          Dim As Double t = Timer
          For I As Integer = 0 To 32 - nbThread Step nbThread
              For J As Integer = 0 To nbThread - 1
                  tp(J).PoolingSubmit(@UserCode, @s(I + J))
              Next J
          Next I
          For I As Integer = 0 To nbThread - 1
              tp(I).PoolingWait()
          Next I
          t = Timer - t
          Print Using " : ####.## s"; t
      End Scope
      #endmacro
      
      #macro ThreadDispatchingSequence(nbThreadmax)
      Scope
          Dim As ThreadDispatching td##nbThreadmax = nbThreadmax
          Print "   ";
          Dim As Double t = Timer
          For I As Integer = 0 To 31
              td##nbThreadmax.DispatchingSubmit(@UserCode, @s(I))
          Next I
          td##nbThreadmax.DispatchingWait()
          t = Timer - t
          Print Using " : ####.## s"; t
      End Scope
      #endmacro
         
      '---------------------------------------------------
      
      Print "'ThreadInitThenMultiStart' with 1 secondary thread:"
      ThreadInitThenMultiStartSequence(1)
      
      Print "'ThreadPooling' with 1 secondary thread:"
      ThreadPoolingSequence(1)
      
      Print "'ThreadDispatching' with 1 secondary thread max:"
      ThreadDispatchingSequence(1)
      Print
      
      '---------------------------------------------------
      
      Print "'ThreadInitThenMultiStart' with 2 secondary threads:"
      ThreadInitThenMultiStartSequence(2)
      
      Print "'ThreadPooling' with 2 secondary threads:"
      ThreadPoolingSequence(2)
      
      Print "'ThreadDispatching' with 2 secondary threads max:"
      ThreadDispatchingSequence(2)
      Print
      
      '---------------------------------------------------
      
      Print "'ThreadInitThenMultiStart' with 4 secondary threads:"
      ThreadInitThenMultiStartSequence(4)
      
      Print "'ThreadPooling' with 4 secondary threads:"
      ThreadPoolingSequence(4)
      
      Print "'ThreadDispatching' with 4 secondary threads max:"
      ThreadDispatchingSequence(4)
      Print
      
      '---------------------------------------------------
      
      Print "'ThreadInitThenMultiStart' with 8 secondary threads:"
      ThreadInitThenMultiStartSequence(8)
      
      Print "'ThreadPooling' with 8 secondary threads:"
      ThreadPoolingSequence(8)
      
      Print "'ThreadDispatching' with 8 secondary threads max:"
      ThreadDispatchingSequence(8)
      Print
      
      '---------------------------------------------------
      
      Print "'ThreadInitThenMultiStart' with 16 secondary threads:"
      ThreadInitThenMultiStartSequence(16)
      
      Print "'ThreadPooling' with 16 secondary threads:"
      ThreadPoolingSequence(16)
      
      Print "'ThreadDispatching' with 16 secondary threads max:"
      ThreadDispatchingSequence(16)
      Print
      
      '---------------------------------------------------
      
      Print "'ThreadInitThenMultiStart' with 32 secondary threads:"
      ThreadInitThenMultiStartSequence(32)
      
      Print "'ThreadPooling' with 32 secondary threads:"
      ThreadPoolingSequence(32)
      
      Print "'ThreadDispatching' with 32 secondary threads max:"
      ThreadDispatchingSequence(32)
      Print
      
      Sleep
      

    Output example:

    • Code: Select all

      'ThreadInitThenMultiStart' with 1 secondary thread:
         00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVV :    5.40 s
      'ThreadPooling' with 1 secondary thread:
         00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVV :    5.39 s
      'ThreadDispatching' with 1 secondary thread max:
         00112233445566778899AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVV :    5.42 s
      
      'ThreadInitThenMultiStart' with 2 secondary threads:
         01012323454567768998ABABCDCDEFEFGHGHIJJIKLKLMNNMOPOPQRRQSTSTUVVU :    2.88 s
      'ThreadPooling' with 2 secondary threads:
         01012323455476769898BAABCDCDFEFEHGHGJIJILKLKNMNMPOPORQRQTSTSVUVU :    2.83 s
      'ThreadDispatching' with 2 secondary threads max:
         01103232545476769898BABADCDCFEFHEGHJGJILILKNKNMPMPORORQTQTSVSVUU :    2.96 s
      
      'ThreadInitThenMultiStart' with 4 secondary threads:
         012312304576645789ABA98BCEDFCEFDGIHJGIJHLKMNNLKMOQPRPOQRSTVUTSUV :    1.72 s
      'ThreadPooling' with 4 secondary threads:
         012313204576457689AB89ABCDFECFDEGJHIGJHINKLMNKMLROPQROQPVSUTVSUT :    1.71 s
      'ThreadDispatching' with 4 secondary threads max:
         012320316475674A5B89AB98EFDCEFDCIJHGIJHMGNLKMNLKQRPORQPOVTUSVTUS :    1.76 s
      
      'ThreadInitThenMultiStart' with 8 secondary threads:
         01324567706415328B9ACDEFBE8D9CAFGHIJKNMLGNLMKHIJOQRPSVUTVOQRUTPS :    1.19 s
      'ThreadPooling' with 8 secondary threads:
         01234567032415678BAEC9DF8BEA9CDFGJIHLMKNGJIHLMKNORQTPSUVORTPQSUV :    1.05 s
      'ThreadDispatching' with 8 secondary threads max:
         0123456776415032FE9CABD8FE9ACB8DNMIHKJLGMNIHKGLJVUQPSTORVUQPSOTR :    1.09 s
      
      'ThreadInitThenMultiStart' with 16 secondary threads:
         013A4567892BCDEF1A2B7903C8465DEFGHIJKNMLPOQRSTVULJGKNMIRHTSOPUQV :    1.14 s
      'ThreadPooling' with 16 secondary threads:
         0124356789ABCDEF512A04D639E7B8CKJNGILHFQTPMOURSGJNQHLTKIVORPUMSV :    1.10 s
      'ThreadDispatching' with 16 secondary threads max:
         0123456B897ACDEFFEDA798031C56B42TPOGJQNUKVMSILRHJQGTUOPKLMINSVHR :    1.11 s
      
      'ThreadInitThenMultiStart' with 32 secondary threads:
         01243675AB89ECFDGHIJKLMNOPQ146RSTGVBA3IEFJTSNM5082CDHU7KLO9RQPVU :    1.06 s
      'ThreadPooling' with 32 secondary threads:
         0I32456789ABCDEFHG1JKLMNOPRSQTVUN7260534FKBEGIHCD98A1OJLQTSRUPVM :    1.07 s
      'ThreadDispatching' with 32 secondary threads max:
         012345A7896BCDFGE4C89D76B5A0321EGHIJKLMNOQRUVPSTFLKHMIJNOTSPVUQR :    1.07 s

[fxm]

What is the execution delay of the code of a thread after the thread is created by 'ThreadCreate'?

One might think that the first code line of the thread is always executed at least after the 'Threadcreate()' returns, but this is neither guaranteed nor even observed.

One can estimate the delay (positive or negative) between the 'Threadcreate()' return and the the thread start, by a time memorization as similar as possible between the line following 'Threadcreate()' and the first thread code line (the delay calculation is executed after the end of the thread).
After a while of observation, one can find both small negative values and large positive values.

Interesting to see the min time, mean time, and max time, between the executing start of thread body and the returning point of 'Threadcreate()':

• Code: Select all

  Dim As Any Ptr ptid
  Dim As Double t0
  Dim As Any Ptr p0 = @t0
  Dim As Double t1
  Dim As Double count
  Dim As Single tmean
  Dim As Single tmin = 10   '' start value
  Dim As Single tmax = -10  '' start value
  
  Sub myThread (Byval p As Any Ptr)
      *Cast(Double Ptr, p) = Timer  '' similar code line as in main code
  End Sub
  
  Print "Tmin/Tmean/Tmax between begin of thread code and return from ThreadCreate() :"
  Do
      count += 1
      ptid = Threadcreate(@myThread, @t1)
      *Cast(Double Ptr, p0) = Timer  '' similar code line as in thread code
     
      Threadwait(ptid)
     
      tmean = (tmean * (count - 1) + (t1 - t0)) / count
      If t1 - t0 < tmin Or t1 - t0 > tmax Then
          If t1 - t0 < tmin Then
              tmin = t1 - t0
          End If
          If t1 - t0 > tmax Then
              tmax = t1 - t0
          End If
          Print Time; Using "    Tmin=+###.###### ms    Tmean=+###.###### ms    Tmax=+###.###### ms"; tmin * 1000; tmean * 1000; tmax * 1000
      End If
  Loop Until Inkey <> ""
  

  Output (for example):

  Code: Select all

  Tmin/Tmean/Tmax between begin of thread code and return from ThreadCreate() :
  21:30:13    Tmin=  +0.151800 ms    Tmean=  +0.151800 ms    Tmax=  +0.151800 ms
  21:30:13    Tmin=  +0.006000 ms    Tmean=  +0.078900 ms    Tmax=  +0.151800 ms
  21:30:13    Tmin=  +0.006000 ms    Tmean=  +0.098394 ms    Tmax=  +0.172500 ms
  21:30:13    Tmin=  +0.006000 ms    Tmean=  +0.121555 ms    Tmax=  +0.884900 ms
  21:30:45    Tmin=  +0.006000 ms    Tmean=  +0.055810 ms    Tmax=  +1.104200 ms
  21:30:54    Tmin=  +0.006000 ms    Tmean=  +0.055764 ms    Tmax=  +4.056600 ms
  21:31:44    Tmin=  -0.116300 ms    Tmean=  +0.055516 ms    Tmax=  +4.056600 ms
  21:32:10    Tmin=  -0.136800 ms    Tmean=  +0.057177 ms    Tmax=  +4.056600 ms
  21:32:12    Tmin=  -0.150300 ms    Tmean=  +0.057265 ms    Tmax=  +4.056600 ms
  21:33:17    Tmin=  -0.150300 ms    Tmean=  +0.060048 ms    Tmax=  +4.979900 ms
  21:33:18    Tmin=  -0.150300 ms    Tmean=  +0.060157 ms    Tmax=  +7.086300 ms
  21:33:23    Tmin=  -0.150600 ms    Tmean=  +0.060347 ms    Tmax=  +7.086300 ms
  21:33:38    Tmin=  -0.205900 ms    Tmean=  +0.060878 ms    Tmax=  +7.086300 ms
  21:35:30    Tmin=  -0.208700 ms    Tmean=  +0.061315 ms    Tmax=  +7.086300 ms
  

Note:

• If the user safely wish to always delay the thread execution at least after some code lines following the 'ThreadCreate()' line, a mutual exclusion between the 'Threadcreate()' line and the start of the thread body can be used as this principle follows:

  Code: Select all

  Dim Shared As Any Ptr pMutexForThreadStart
  
  '-------------------------------------------
  
  Sub Thread (Byval p As Any Ptr)
      Mutexlock(pMutexForThreadStart)
      Mutexunlock(pMutexForThreadStart)
      '
      ' user thread body
      '
  End Sub
  
  '--------------------------------------------
  
  '
  ' user main code
  '
  pMutexForThreadStart = Mutexcreate()
  '
  ' user main code continues
  '
  Mutexlock(pMutexForThreadStart)
  Dim As Any Ptr pThread = Threadcreate(@Thread)
  '
  ' lines of code to be executed before the executing start of the user body of the thread
  '
  Mutexunlock(pMutexForThreadStart)
  '
  ' user main code continues
  '
  Threadwait(pThread)
  MutexDestroy(pMutexForThreadStart)