Platforms to show: All Mac Windows Linux Cross-Platform
/Util/Preemptive Threading/Mutlithreading test
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Util/Preemptive Threading/Mutlithreading test
This example is the version from Wed, 28th Feb 2023.
Project "Mutlithreading test.xojo_binary_project"
Class App Inherits DesktopApplication
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
EventHandler Sub Opening()
#If Target32Bit Then
#Pragma error "Needs 64-bit!"
#EndIf
RegisterPlugins
// test declares, so Xojo preloads the pointers
#If TargetWindows
Declare Function GetCurrentThreadId Lib "kernel32" () As UInt32
Dim n As Integer = GetCurrentThreadId
#Else
Declare Function pthread_self Lib "/usr/lib/libpthread.dylib" () As UInt64
Dim n As Integer = pthread_self
#EndIf
End EventHandler
End Class
Class MainWindow Inherits DesktopWindow
Control StartButton Inherits DesktopButton
ControlInstance StartButton Inherits DesktopButton
EventHandler Sub Pressed()
CreateJobs
End EventHandler
End Control
Control List Inherits DesktopListBox
ControlInstance List Inherits DesktopListBox
End Control
EventHandler Sub Opening()
CreateJobs
End EventHandler
Sub CreateJobs()
Dim FillJobs() As Job
Dim CopyJobs() As Job
#If DebugBuild Then
Dim TestSize As Integer = 1024 * 1024 * 16 // 16 MB
#Else
Dim TestSize As Integer = 1024 * 1024 * 1024 // 1 GB
#EndIf
// make some jobs to fill memory
For i As Integer = 0 To 3
Dim j As New job
j.Func = AddressOf FillJob
j.label = "FillJob"+i.ToString
j.Output = New MemoryBlock(TestSize)
j.FinishedHandler = AddressOf JobFinished
j.StartedHandler = AddressOf JobStarted
Job.addJob j
FillJobs.Add j
Next
// and a copy job to waste some CPU
For i As Integer = 0 To 3
Dim j As New job
j.Func = AddressOf CopyJob
j.label = "CopyJob"+i.ToString
// we use memoryblock from FillJob as input here
j.Input = FillJobs(i).Output
j.Output = New MemoryBlock(TestSize)
j.FinishedHandler = AddressOf JobFinished
j.StartedHandler = AddressOf JobStarted
j.AfterJob = FillJobs(i) // <- wait until FillJob is done
job.addJob j
CopyJobs.add j
Next
// and sum the memory
For i As Integer = 0 To 3
Dim j As New job
j.Func = AddressOf SumJob
j.label = "SumJob"+i.ToString
// we use memoryblock from CopyJob as input here
j.Input = CopyJobs(i).Output
j.Output = New MemoryBlock(8) // output
j.FinishedHandler = AddressOf JobFinished
j.StartedHandler = AddressOf JobStarted
j.AfterJob = CopyJobs(i) // <- wait until CopyJob is done
job.addJob j
Next
// start them
Job.RunJobs
End Sub
Sub JobFinished(j as job)
Log "Job "+j.ID.ToString+": "+j.label+" finished on thread: "+j.ThreadID.ToString
If j.Output.Size = 8 Then
Log "Sum: "+j.Output.UInt64Value(0).ToString
End If
End Sub
Sub JobStarted(j as job)
Log "Job "+j.ID.ToString+": "+j.label+" started on thread."
End Sub
Private Sub Log(s as string)
System.DebugLog s
List.AddRow s
End Sub
End Class
MenuBar MainMenuBar
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem EditSeparator1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem EditSeparator2 = "-"
MenuItem EditSelectAll = "Select &All"
MenuItem HelpMenu = "&Help"
End MenuBar
Class Job
Delegate Sub JobFinished(j as job)
Shared Sub AddJob(j as job)
jobs.Add j
End Sub
Function CanRun() As Boolean
If Started Then
return false
ElseIf AfterJob = Nil Then
Return True
Else
Return AfterJob.Finished
End If
End Function
Sub Constructor()
// assign unique ID
IDCounter = IDCounter + 1
ID = IDCounter
End Sub
Private Shared Sub JobTimerAction(t as timer)
Dim launch As Boolean = false
For Each j As job In jobs
If j.Started And Not j.Finished Then
If j.Data.UInt32Value(8) <> 0 then
j.ThreadID = j.data.UInt64Value(48)
j.Running = false
j.Finished = True
If j.FinishedHandler <> Nil Then
j.FinishedHandler.Invoke(j)
End If
launch = True
jobs.RemoveAt jobs.IndexOf(j)
exit // come back later to run more
End If
End If
Next
If launch Then
RunJobs
End If
End Sub
Sub Run()
StartTimer
data = New MemoryBlock(100)
data.UInt64Value(0) = ID
data.UInt32Value(8) = 0 // done flag
if Input <> nil then
data.Ptr(16) = Input
data.UInt64Value(24) = Input.size
End If
If Output <> Nil Then
data.Ptr(32) = Output
data.UInt64Value(40) = output.size
End If
If DebugBuild Then
Started = True
func.Invoke(data)
Return
End If
If StartedHandler <> Nil Then
StartedHandler.Invoke(Self)
End If
If CallDelegateOnPreemptiveThreadMBS(func, data) Then
Running = true
Started = True
Else
Break
End If
End Sub
Shared Sub RunJobs()
// start all jobs in queue
StartTimer
Dim RunningCounter As Integer
For Each j As job In jobs
If j.Running then
RunningCounter = RunningCounter + 1
Continue
End If
If j.CanRun Then
j.run
RunningCounter = RunningCounter + 1
End If
If RunningCounter >= 4 Then
// 4 in paralell is enough for us
Exit
end if
Next
End Sub
Private Shared Sub StartTimer()
If JobTimer = Nil Then
JobTimer = New timer
AddHandler JobTimer.Action, AddressOf JobTimerAction
JobTimer.Period = 50
JobTimer.RunMode = timer.RunModes.Multiple
End If
End Sub
Property AfterJob As Job
Property Private Data As MemoryBlock
Property Finished As Boolean
Property FinishedHandler As JobFInished
Property Func As _delegatePtrMBS
Property ID As Integer
Property Shared IDCounter As Integer
Property Input As MemoryBlock
Property Private Shared JobTimer As Timer
Property Shared Jobs() As job
Property Label As string
Property Output As MemoryBlock
Property Running As Boolean
Property Started As Boolean
Property StartedHandler As JobFInished
Property ThreadID As Integer
End Class
Module JobModule
Sub CopyJob(data as Ptr)
#Pragma BackgroundTasks False
#Pragma BreakOnExceptions False
#Pragma StackOverflowChecking False
#Pragma NilObjectChecking False
// get input parameters from job data
Dim ID As UInt64 = data.UInt64(0)
Dim InputData As Ptr = data.Ptr(16)
Dim InputSize As UInt64 = data.UInt64(24)
Dim OutputData As Ptr = data.Ptr(32)
Dim OutputSize As UInt64 = data.UInt64(40)
// do work
Dim u As Integer = InputSize-7
For i As Integer = 0 To u Step 8
OutputData.UInt64(i) = InputData.UInt64(i)
Next
// we like to know which thread got the job
#if TargetWindows
Declare Function GetCurrentThreadId Lib "kernel32" () As UInt32
data.UInt64(48) = GetCurrentThreadId
#Else
Declare Function pthread_self Lib "/usr/lib/libpthread.dylib" () As UInt64
data.UInt64(48) = pthread_self
#EndIf
// mark job done
data.UInt32(8) = 1 // done flag
End Sub
Sub FillJob(data as ptr)
#Pragma BackgroundTasks False
#Pragma BreakOnExceptions False
#Pragma StackOverflowChecking False
#Pragma NilObjectChecking False
// get input parameters from job data
Dim ID As UInt64 = data.UInt64(0)
Dim InputData As Ptr = data.Ptr(16)
Dim InputSize As UInt64 = data.UInt64(24)
Dim OutputData As Ptr = data.Ptr(32)
Dim OutputSize As UInt64 = data.UInt64(40)
// do work
Dim u As Integer = OutputSize-7
For i As Integer = 0 To u Step 8
OutputData.UInt64(i) = i
Next
// we like to know which thread got the job
#If TargetWindows
Declare Function GetCurrentThreadId Lib "kernel32" () As UInt32
data.UInt64(48) = GetCurrentThreadId
#Else
Declare Function pthread_self Lib "/usr/lib/libpthread.dylib" () As UInt64
data.UInt64(48) = pthread_self
#EndIf
// mark job done
data.UInt32(8) = 1 // done flag
End Sub
Sub SumJob(data as Ptr)
#Pragma BackgroundTasks False
#Pragma BreakOnExceptions False
#Pragma StackOverflowChecking False
#Pragma NilObjectChecking False
// get input parameters from job data
Dim ID As UInt64 = data.UInt64(0)
Dim InputData As Ptr = data.Ptr(16)
Dim InputSize As UInt64 = data.UInt64(24)
Dim OutputData As Ptr = data.Ptr(32)
Dim OutputSize As UInt64 = data.UInt64(40)
// do work
Dim Sum As UInt64
Dim u As Integer = InputSize-7
For i As Integer = 0 To u Step 8
Sum = Sum + InputData.UInt64(i)
Next
// store result
OutputData.UInt64(0) = sum
// we like to know which thread got the job
#If TargetWindows
Declare Function GetCurrentThreadId Lib "kernel32" () As UInt32
data.UInt64(48) = GetCurrentThreadId
#Else
Declare Function pthread_self Lib "/usr/lib/libpthread.dylib" () As UInt64
data.UInt64(48) = pthread_self
#EndIf
// mark job done
data.UInt32(8) = 1 // done flag
End Sub
Note "Warning"
Experimental function to play with preemptive-threads in Xojo apps.
Some rules:
* No objects, no strings, no arrays
* Use Ptr, not Memoryblocks
* Crashes in debugger, so only use in built app
* Use #Pragma BackgroundTasks False
* Use #Pragma BreakOnExceptions False
* Use #Pragma StackOverflowChecking False
* Use #Pragma NilObjectChecking False
* No exceptions
* Delegate must be stored in global variable to avoid it getting freed early.
* You can pass up to one ptr as data parameter.
uses thread pool on iOS, macOS and Windows. Otherwise regular threads.
End Module
Module MBSPluginRegistration
Sub RegisterChartDirector()
// License code registration could be done here
End Sub
Sub RegisterDynaPDF()
// License code registration could be done here
End Sub
Sub RegisterPluginMakeDoku()
// License code registration could be done here
End Sub
Sub RegisterPlugins()
// License code registration could be done here
End Sub
Sub RegisterSQL()
// License code registration could be done here
End Sub
End Module
End Project
See also:
The items on this page are in the following plugins: MBS Util Plugin.
