Module Simple ThreadControl without API (All OS)

Share your advanced PureBasic knowledge/code with the community.
User avatar
mk-soft
Always Here
Always Here
Posts: 5339
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Module Simple ThreadControl without API (All OS)

Post by mk-soft »

Here now a simple way to control threads

Update v1.05

Code: Select all

;-TOP

; Comment : Module Threadcontrol
; Author  : mk-soft
; Version : v1.05
; Create  : 22.05.2016
; Update  : 27.07.2017
; OS      : All

; ***************************************************************************************

; Thread Callback Results
;
;   Procedure cbRunning(*data)
;    - Result 0 : Running
;    - Result 1 : Stopped
;    - Result 2 : Exiting
;
;   Procedure cbStart(*data)
;    - Result 0 : Stopped
;    - Result 1 : Running
;
;   Procedure cbStop(*data)
;    - Result 0 : Running
;    - Result 1 : Stopped
;
;   Procedure cbContinue(*data)
;    - Result 0 : Stopped
;    - Result 1 : Running
;
;   Procedure cbExit(*data)
;    - Result 0 : Old State
;    - Result 1 : Exiting

; ***************************************************************************************

DeclareModule ThreadControl
  
  Enumeration
    #thInit
    #thStartup
    #thRunning
    #thStopping
    #thStopped
    #thContinuing
    #thShutdown
    #thFinished
    #thWait
  EndEnumeration
  
  Declare thCreate(*data, *cbRunning, *cbStart = 0, *cbStop = 0, *cbContinue = 0, *cbExit = 0)
  Declare thStart(*thread)
  Declare thStop(*thread)
  Declare thContinue(*thread)
  Declare thExit(*thread)
  Declare thKill(*thread)
  Declare thRelease(*thread)
  Declare thState(*thread)
  
EndDeclareModule

Module ThreadControl
  
  EnableExplicit
  
  ; -----------------------------------------------------------------------------------
  
  Enumeration
    #thCmdNothing
    #thCmdStart
    #thCmdStop
    #thCmdContinue
    #thCmdExit
  EndEnumeration
  
  ; -----------------------------------------------------------------------------------
  
  Prototype Invoke(*data)
  
  Structure udtThread
    ; Header
    handle.i
    signal.i
    cmd.i
    state.i
    ; Userdata
    *data
    ; Callback
    cbRunning.Invoke
    cbStart.Invoke
    cbStop.Invoke
    cbContinue.Invoke
    cbExit.Invoke
  EndStructure 
  
  ; -----------------------------------------------------------------------------------
  
  Declare thWork(*thread.udtThread)
  
  ; -----------------------------------------------------------------------------------
  
  Procedure thCreate(*data, *cbRunning, *cbStart = 0, *cbStop = 0, *cbContinue = 0, *cbExit = 0)
    
    Protected *thread.udtThread
    
    *thread = AllocateStructure(udtThread)
    If Not *thread
      ProcedureReturn 0
    EndIf
    With *thread
      ; Init Header
      \handle = 0
      \signal = CreateSemaphore()
      \cmd = #thCmdNothing
      \state = #thWait
      ; Init Data
      \data = *data
      ; Init Callback
      \cbRunning = *cbRunning
      \cbStart = *cbStart
      \cbStop = *cbStop
      \cbContinue = *cbContinue
      \cbExit = *cbExit
    EndWith
    
    ProcedureReturn *thread
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure thStart(*thread.udtThread)
    
    If Not *thread : ProcedureReturn 0 : EndIf
    With *thread
      If \state => #thFinished
        \state = #thInit
        \handle = CreateThread(@thWork(), *thread)
        If \handle
          \cmd = #thCmdStart
        Else
          \state = #thWait
        EndIf
      EndIf
    EndWith
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure thStop(*thread.udtThread)
    
    If Not *thread : ProcedureReturn 0 : EndIf
    With *thread
      If \state = #thRunning
        \cmd = #thCmdStop
      EndIf
    EndWith
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure thContinue(*thread.udtThread)
    
    If Not *thread : ProcedureReturn 0 : EndIf
    With *thread
      If \state = #thStopped
        \cmd = #thCmdContinue
        SignalSemaphore(\signal)
      EndIf
    EndWith
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure thExit(*thread.udtThread)
    
    If Not *thread : ProcedureReturn 0 : EndIf
    With *thread
      If \state < #thShutdown
        \cmd = #thCmdExit
        If \state = #thStopped
          SignalSemaphore(\signal)
        EndIf
      EndIf
    EndWith
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure thKill(*thread.udtThread)
    
    If Not *thread : ProcedureReturn 0 : EndIf
    With *thread
      \state = #thShutdown
      If IsThread(\handle)
        KillThread(\handle)
      EndIf
      \handle = 0
      \state = #thFinished
    EndWith
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure thRelease(*thread.udtThread)
    
    If Not *thread : ProcedureReturn 0 : EndIf
    With *thread
      If \state => #thFinished
        FreeSemaphore(\signal)
        FreeStructure(*thread)
        ProcedureReturn 0
      Else
        ProcedureReturn *thread
      EndIf
    EndWith
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure thState(*thread.udtThread)
    If *thread
      ProcedureReturn *thread\state
    Else
      ProcedureReturn 0
    EndIf
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure thWork(*thread.udtThread)
    
    Protected old_state
    
    With *thread
      Repeat
        ; Go Sleeping
        If \state = #thStopped
          WaitSemaphore(\signal)
        EndIf
        ; Check Command
        Select \cmd
          Case #thCmdStart
            \cmd = #thCmdNothing
            If \state = #thInit
              \state = #thStartup
              ; Code Startup
              If \cbStart
                If \cbStart(\data)
                  \state = #thRunning
                Else
                  \state = #thStopped
                EndIf
              Else
                \state = #thRunning
              EndIf
              ; ...
            EndIf
            
          Case #thCmdStop
            \cmd = #thCmdNothing
            If \state = #thRunning
              \state = #thStopping
              ; Code Stopping
              If \cbStop
                If \cbStop(\data)
                  \state = #thStopped
                Else
                  \state = #thRunning
                EndIf
              Else
                \state = #thStopped
              EndIf
              ; ...
            EndIf
            
          Case #thCmdContinue
            \cmd = #thCmdNothing
            If \state = #thStopped
              \state = #thContinuing
              ; Code Continue
              If \cbContinue
                If \cbContinue(\data)
                  \state = #thRunning
                Else
                  \state = #thStopped
                EndIf
              Else
                \state = #thRunning
              EndIf
              ; ...
            EndIf
            
          Case #thCmdExit
            \cmd = #thCmdNothing
            If \state < #thShutdown
              old_state = \state
              \state = #thShutdown
              ; Code Exit
              If \cbExit
                If \cbExit(\data)
                  Break
                Else
                  \state = old_state
                EndIf
              Else
                Break
              EndIf
              ; ...
            EndIf
            
        EndSelect
        
        ; Cycle Code
        If \state = #thRunning
          If \cbRunning
            Select \cbRunning(\data)
              Case 1
                \state = #thStopped
              Case 2
                Break
            EndSelect
          Else
            Delay(100)
          EndIf
        EndIf
        
      ForEver
      
      ; Exit
      \handle = 0
      \state = #thFinished
      
    EndWith
    
  EndProcedure
  
EndModule

; ***************************************************************************************

CompilerIf #PB_Compiler_IsMainFile
  
  Structure udtData
    counter.i
  EndStructure
  
  Global MyData.udtData
  
  UseModule ThreadControl
  
  ; -----------------------------------------------------------------------------------
  
  Procedure doMain(*data.udtData)
    
    With *data
      \counter + 1
      Debug \counter
      Delay(1000)
      If \counter % 10 = 0
        ProcedureReturn 1
      ElseIf \counter % 25 = 0
        ProcedureReturn 2
      Else
        ProcedureReturn 0
      EndIf
    EndWith
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure doStart(*data.udtData)
    
    Debug "Thread Start..."
    
    With *data
      \counter = 0
      Delay(1000)
    EndWith
    
    ProcedureReturn 1
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure doStop(*data.udtData)
    
    Debug "Thread Stopping..."
    
    With *data
      Delay(1000)
    EndWith
    
    ProcedureReturn 1
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure doContinue(*data.udtData)
    
    Debug "Thread Continue..."
    
    With *data
      Delay(1000)
    EndWith
    
    ProcedureReturn 1
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure doExit(*data.udtData)
    
    Debug "Thread Shutdown..."
    
    With *data
      Delay(1000)
    EndWith
    
    ProcedureReturn 1
    
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure.s GetStateStr(state)
    Protected result.s
    
    Select state
      Case #thInit        : Result = "Thread Init"
      Case #thStartup     : Result = "Thread Starting"
      Case #thRunning     : Result = "Thread Running"
      Case #thStopping    : Result = "Thread Stopping"
      Case #thStopped     : Result = "Thread Stopped"
      Case #thContinuing  : Result = "Thread Resume"
      Case #thShutdown    : Result = "Thread Shutdown"
      Case #thFinished    : Result = "Thread Finished"
      Case #thWait        : Result = "Thread Wait for first start"
      Default
    EndSelect
    
    ProcedureReturn result
  EndProcedure
  
  ; -----------------------------------------------------------------------------------
  
  Procedure Main()
    
    Protected *thread1
    Protected start, ende, cont, timer
    
    *thread1 = thCreate(@MyData, @doMain(), @doStart(), @doStop(), @doContinue(), @doExit())
    ;*thread1 = thCreate(@MyData, @doMain())
    
    If OpenWindow(0, #PB_Any, #PB_Any, 400, 150, "Thread-Test", #PB_Window_SystemMenu)
      CreateStatusBar(0, WindowID(0))
      AddStatusBarField(#PB_Ignore)
      ButtonGadget(0, 10, 10, 80, 25, "Start")
      ButtonGadget(1, 100, 10, 80, 25, "Stop")
      ButtonGadget(2, 190, 10, 80, 25, "Cont")
      ButtonGadget(3, 280, 10, 80, 25, "Exit")
      
      AddWindowTimer(0, 1, 100)
      
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
            
          Case #PB_Event_Gadget
            Select EventGadget()
              Case 0
                thStart(*thread1)
                
              Case 1
                thStop(*thread1)
                
              Case 2
                thContinue(*thread1)
                
              Case 3
                thExit(*thread1)
                
            EndSelect
            
          Case #PB_Event_Timer
            StatusBarText(0, 0, GetStateStr(thState(*thread1)))
            
        EndSelect
      ForEver
    EndIf
    
  EndProcedure : Main()
  
CompilerEndIf
:wink:
Last edited by mk-soft on Thu Jul 27, 2017 8:57 am, edited 6 times in total.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
skywalk
Addict
Addict
Posts: 3975
Joined: Wed Dec 23, 2009 10:14 pm
Location: Boston, MA

Re: Module Simple ThreadControl without API (All OS)

Post by skywalk »

Very helpful code. Why extra CreateSemaphore()?

Code: Select all

Procedure thKill(*thread.udtThread)    
  With *thread
    \state = #thInit
    KillThread(\handle)
    \handle = 0
    FreeSemaphore(\signal)
    CreateSemaphore(\signal) ;<-- WHY?
    \state = #thFinished
  EndWith    
EndProcedure
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Module Simple ThreadControl without API (All OS)

Post by davido »

@mk-soft,

Thank you for the update. :D
DE AA EB
User avatar
mk-soft
Always Here
Always Here
Posts: 5339
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module Simple ThreadControl without API (All OS)

Post by mk-soft »

To fast :wink:

Small bug in thKill(...)

Update v1.03

Code: Select all

  Procedure thKill(*thread.udtThread)
    
    With *thread
      \state = #thShutdown
      KillThread(\handle)
      \handle = 0
      \state = #thFinished
    EndWith
    
  EndProcedure
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
User avatar
skywalk
Addict
Addict
Posts: 3975
Joined: Wed Dec 23, 2009 10:14 pm
Location: Boston, MA

Re: Module Simple ThreadControl without API (All OS)

Post by skywalk »

Some followup questions:
I know the code works, but I'm confused by thCreate() and the return of protected variables. When *thread is destroyed after ProcedureReturn, the structured memory it pointed to is still preserved?
If you move Structure udtThread to Declare of the module, you can define *thread1.udtThread in the Main scope.

Code: Select all

  Procedure thCreate(*data, *cbRunning, *cbStart = 0, *cbStop = 0, *cbContinue = 0, *cbExit = 0)
    Protected *thread.udtThread
    *thread = AllocateStructure(udtThread)
    If Not *thread
      ProcedureReturn 0
    EndIf
    ; Init Header
    *thread\handle = 0
    *thread\signal = CreateSemaphore()
    *thread\cmd = #thCmdNothing
    *thread\state = #thFinished
    ; Init Data
    *thread\data = *data
    ; Init Callback
    *thread\cbRunning = *cbRunning
    *thread\cbStart = *cbStart
    *thread\cbStop = *cbStop
    *thread\cbContinue = *cbContinue
    *thread\cbExit = *cbExit
    ProcedureReturn *thread
  EndProcedure

    Protected *thread1  ;<-- untyped pointer? Why not *thread1.udtThread?
    Protected start, ende, cont, timer
    *thread1 = thCreate(@MyData, @doMain(), @doStart(), @doStop(), @doContinue(), @doExit())
When/how is thKill() called?
How to clean/release the *thread1.udtThread memory?

Code: Select all

; Exit
;;*thread\handle = 0  ;<-- Don't apply here if calling thKill() later, else Null pointer error.
And, then I still get random, "Thread does not exist", because thRelease() has a FreeStructure(*thread)?
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum
User avatar
mk-soft
Always Here
Always Here
Posts: 5339
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Module Simple ThreadControl without API (All OS)

Post by mk-soft »

Edit
The internal structure is only required within the module.
The result of thCreate don´t delete´, before free memory with thRelease (...).

With thKill(...) is not freed the memory! Is kill the thread.

Small example

Code: Select all

;-Top

IncludeFile "ThreadControl.pb"

UseModule ThreadControl

Structure udtData
  cnt.i
EndStructure

Procedure doAny(*data.udtData)
  With *data
    Debug "Running..."
    \cnt + 1
    Delay(500)
    If \cnt >= 5
      Debug "Ready."
      \cnt = 0
      ProcedureReturn 2
    EndIf
  EndWith
EndProcedure

Procedure.s GetStateStr(state)
  Protected result.s
 
  Select state
    Case #thInit        : Result = "Thread Init"
    Case #thStartup     : Result = "Thread Startingup"
    Case #thRunning     : Result = "Thread Running"
    Case #thStopping    : Result = "Thread Stopping"
    Case #thStopped     : Result = "Thread Stopped"
    Case #thContinuing  : Result = "Thread Resume"
    Case #thShutdown    : Result = "Thread Shutdown"
    Case #thFinished    : Result = "Thread Finished"
    Default
  EndSelect
 
  ProcedureReturn result
EndProcedure

Define MyData.udtData
*Thread = thCreate(MyData, @doAny())
thStart(*Thread)
Debug GetStateStr(thState(*Thread))
Delay(1000)
thKill(*Thread) ; Not good, we can´t restart allway the thread
Delay(100)
Debug GetStateStr(thState(*Thread))
thStart(*Thread)
Repeat
  Delay(100)
Until thState(*Thread) = #thFinished

If thRelease(*Thread) = 0
  Debug "Is all free!"
EndIf


But I'm working on the code to control the parameters

Update v1.05
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Post Reply