It is currently Sat Feb 22, 2020 7:28 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 6 posts ] 
Author Message
 Post subject: Module Simple ThreadControl without API (All OS)
PostPosted: Sun May 22, 2016 2:52 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2226
Location: Germany
Here now a simple way to control threads

Update v1.05
Code:
;-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:

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Last edited by mk-soft on Thu Jul 27, 2017 8:57 am, edited 6 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Module Simple ThreadControl without API (All OS)
PostPosted: Wed Jul 26, 2017 4:21 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Dec 23, 2009 10:14 pm
Posts: 3203
Location: Boston, MA
Very helpful code. Why extra CreateSemaphore()?
Code:
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Module Simple ThreadControl without API (All OS)
PostPosted: Wed Jul 26, 2017 6:46 pm 
Offline
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1732
Location: Uttoxeter, UK
@mk-soft,

Thank you for the update. :D

_________________
DE AA EB


Top
 Profile  
Reply with quote  
 Post subject: Re: Module Simple ThreadControl without API (All OS)
PostPosted: Wed Jul 26, 2017 7:28 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2226
Location: Germany
To fast :wink:

Small bug in thKill(...)

Update v1.03
Code:
  Procedure thKill(*thread.udtThread)
   
    With *thread
      \state = #thShutdown
      KillThread(\handle)
      \handle = 0
      \state = #thFinished
    EndWith
   
  EndProcedure

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Module Simple ThreadControl without API (All OS)
PostPosted: Wed Jul 26, 2017 9:04 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Dec 23, 2009 10:14 pm
Posts: 3203
Location: Boston, MA
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:
  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:
; 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


Top
 Profile  
Reply with quote  
 Post subject: Re: Module Simple ThreadControl without API (All OS)
PostPosted: Wed Jul 26, 2017 11:00 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2226
Location: Germany
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:
;-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 / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 6 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 5 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye