Announcement

**Thomas Tierney** · 11 Nov 2005, 11:50 AM

Excellent piece of work Michael

**Michael Mattias** · 23 Dec 2005, 04:18 PM

12.23.05 Updated again to show use of Thread Local Storage (TLS)

Code:

' edipal_Event_test_2.bas
' COMPILER: PB/CC 3.03
' AUTHOR:   Michael Mattias Racine WI
' COPYRIGHT: Placed in public domain by author
' DATE:     11.10.05
' USE:      Instead of trying to use GLOBAL variables to force a premature exit to one or
'           more thread functions, Windows user-defined events may be used.
'           At end of a program or any other time when desired, you may quickly terminate
'           the operation of any active worker threads.
' UPDATES
'   11.11.05  Added SLEEP 500 In function SignalAllWaiting Threads. This cuts the
'             number of 'useless' OpenEvent/SetEvent/CloseHandle cycles and makes the
'             'nthreadReleased' variable more reasonable, albeit not a count of number
'             if threads
'             Corrected typo in comment "WaitForSingleObjectT" should be "WaitForSingleObject"

'   12.23.05  As Programname_2, add demo of TLS in working threads.
'             Uses three separate TLS indices to retain what one might consider
'             ' THREAD STATIC' variables.
'             To keep the screen a little cleaner, I commented out most of the
'             STDOUT displays.
'             I used BYVAL for parameter two for the TLsSetValue calls because my
'             Win32API.INC DECLAREs that function with parameter two "AS ANY".


'
' TO RUN DEMO:
' 1. Compile and execute
' 2. Press 's' any number of times to start that many worker threads.
' 3. At desired point, press "f" to force all threads to exit their loops
 'NOTE :
'             The best way to see the difference between forced exit and 'normal' exit
'             is to pause for two or three seconds between pressing "S" to start a thread,
'             and not pressing 'F' until the first thread started has terminated normally.
'             That also gives enough time range that you can see each thread is maintaining
'             its own separate data.

' 4. Repeat as necessary
' 5. press 'x' to end the demo. An additional keystroke will be required to end the program
' ------------------------------------------------------------------------------------------
#COMPILE EXE
#INCLUDE "WIN32API.INC"
#IF NOT %DEF(%INVALID_HANDLE_VALUE_LONG)
  %INVALID_HANDLE_VALUE_LONG  = -1&
#ENDIF
' ---------------------------------
'     Shared/Common Event Name
' ---------------------------------
$EVENT_NAME_DEALLOCATE_EXIT       =   "EDIPAL25_DEALLOCATE_EXIT"


' -----------------------------------------------------------
'     GLOBAL variables added For Thread Local Storage Demo
' The value for each thread's First TLS will be a long integer representing
' how many 'working' loops that thread ompleted before being terminated
' The second and third TLS indexes will hold the times (hhmmss as a long integer)
' of the first and most recend executions of the actual "working" code.
' ---------------------------------------------------------------------

 GLOBAL  g_tlsiCount        AS LONG
 GLOBAL  g_tlsiTimeFirst    AS LONG
 GLOBAL  g_tlsiTimeLast     AS LONG

FUNCTION PBMAIN() AS LONG
    
    '  Get  a TLS index to use for our one long integer
    g_tlsiCount       = TLsAlloc()
    ' get a second index to use for our thread's start time
    g_tlsiTimeFirst   =  TlsAlloc()
    ' get a third index to use for our last run time
    g_tlsiTimeLast    =  TlsAlloc()
    

    CALL UserInputFunction
    
    ' free the TLS allocations we took:
    TlsFree g_tlsiCount
    TlsFree g_tlsiTimeFirst
    TlsFree g_tlsiTimeLast

    STDOUT "WinMain End of Job, any key"
    WAITKEY$

END FUNCTION

' ---------------------------------------------------------
' SIGNAL ANY WORKER THREADS CURRENTLY EXECUTING TO EXIT NOW
' ---------------------------------------------------------

FUNCTION SignalAllWaitingThreads () AS LONG
'
 LOCAL hEvent AS LONG, dwAccess AS DWORD, bInheritHandle AS LONG, szName AS ASCIIZ * 64
 LOCAL nThreadReleased AS LONG

  dwAccess        = %EVENT_ALL_ACCESS
  bInheritHandle  = %FALSE
  szName          = $EVENT_NAME_DEALLOCATE_EXIT

    DO
       hEvent       = OpenEvent (dwAccess, bInheritHandle, szName)
       IF ISTRUE  hEvent   THEN ' we were able to get a handle, meaning event is in progress 'somewhere'

           SetEvent  hEvent     ' which was created as auto-reset, so it will unsignal itself
                                ' after releasing one thread
           CloseHandle  hEvent
           SLEEP        500     ' allow windows to switch to another thread and release it
           INCR         nThreadReleased
       ELSE                     ' could not open the event, therefore no thread is using it anymore
           EXIT DO
       END IF

    LOOP

    STDOUT ""
    STDOUT USING$ ("Attempted Signalling # times before exiting", nThreadReleased)
    STDOUT ""
    ' ******************************************************************************
    ' NOTE:
    ' The 'nThreadReleased' number is always displayed incorrectly except when zero.
    ' I have no idea why that is.
    ' But since I don't need that number, I don't care. We'll see what we get with the
    ' other (PB/Win 7.02)compiler.
    ' 11.11.05 found problem. OpenEvent/Setevent/CloseHandle does not force a thread
    ' switch, so waiting threads are not released; Net effect is that OpenEvent/SetEvent/
    ' Closehandle does exactly nothing. Added SLEEP to 'encourage' Windows to switch to
    ' another thread and release it from wait state.
    ' ******************************************************************************

END FUNCTION


FUNCTION UserInputFunction () AS LONG

    LOCAL   action AS STRING
    LOCAL   nLoop AS LONG, hThread AS LONG, iresult AS LONG


    nLoop   =  10    ' number of iterations each thread function should perform if not
                     ' prematurely terminated

    DO
        STDOUT "(S)tart thread, (F)orce Exit All, E(x)it test loop"
        action     = LCASE$(WAITKEY$)
        STDOUT      "Action===>" & UCASE$(action)
        SELECT CASE action
            CASE "s"      ' start a new thread
                 THREAD CREATE ThreadFunction (nLoop) SUSPEND TO hThread
                 SetThreadPriority   hThread, %THREAD_PRIORITY_LOWEST
                 THREAD RESUME       hThread TO iResult    ' can't step on hThread here
                 ' ---------------------------------------------------------------------
                 ' IN REAL LIFE, ONE SHOULD 'WaitforSingleObject' on a readyEvent here
                 ' SLEEP is *NOT* an acceptable substitution.
                 ' --------------------------------------------------------------------
                 SLEEP   500
                 THREAD  CLOSE hThread TO hThread   ' we do not need the thread handle
            CASE "f"      ' force all threads to exit now
                  CALL SignalAllWaitingThreads
            CASE "x"      ' Just exit this test procedure. We really should signal all
                          ' waiting threads here but this was an escape whilst developing.
                EXIT DO
            CASE ELSE
                STDOUT Action & " is not a valid keystroke here"
          END SELECT
          

     LOOP

END FUNCTION


FUNCTION ThreadFunction (BYVAL iMax AS LONG) AS LONG
  LOCAL iWait  AS LONG, bWaitAll AS LONG, nLoop AS LONG, MaxLoop AS LONG
  LOCAL hEVent() AS LONG
  LOCAL lpAttributes AS DWORD, bManualReset AS LONG, bInitialState AS LONG, pszName AS ASCIIZ PTR
  LOCAL szName   AS ASCIIZ * 64
  LOCAL dwAccess AS DWORD, bInheritHandle AS LONG
  LOCAL tid  AS DWORD
  LOCAL bForcedExit AS LONG, iCount AS LONG
  
  LOCAL szTF AS ASCIIZ * 8, szTime AS ASCIIZ * 8,  st AS SystemTime, lTime AS LONG
  LOCAL sMask AS STRING, w AS STRING
  LOCAL lTimeFirst AS LONG, lTimeLast AS LONG
  LOCAL sTimeFirst AS STRING, sTimeLast AS STRING
  LOCAL sHowExit   AS STRING
  

  

  tid    = THREADID
  ' -------------------------------------------------------------
  ' store the start time of this thread in the assigned TLS slot
  ' -------------------------------------------------------------
  GetSystemTime   st
  szTF           = "HHmmss"   ' 24 hour HHMMSS with leading zeroes for HH, mm and ss
  GetTimeFormat    BYVAL %NULL, BYVAL %NULL, st, szTF, szTime, SIZEOF(szTime)  'returns HHmmss
   ' convert the formatted string time to an integer
  lTime = VAL (szTime)
  ' store it in assigned index
  TlsSetValue g_tlsiTimeFirst, BYVAL lTime


  
  REDIM    hEvent(1)
  ' ************************************************************************************
  ' WFMO NOTE:  When more than one object is signalled and bWaitAll is FALSE, WFMO returns
  ' the smallest index which was signalled.
  ' Since our function _always_ has the unnamed continue event signalled, our EXIT event
  ' should be at index 0.
  ' ********************************************************************************************
  ' --------------------------------------------------------------------------------------------
  ' Get a Handle to the Exit Event as index zero. If the event does not already exist, create it
  ' --------------------------------------------------------------------------------------------

  dwAccess        = %EVENT_ALL_ACCESS
  bInheritHandle  = %FALSE
  szName          = $EVENT_NAME_DEALLOCATE_EXIT
  hEvent(0)       = OpenEvent (dwAccess, bInheritHandle, szName)
  IF ISFALSE hEvent(0) THEN  ' the open failed, meaning no other dealloc thread is running
       'STDOUT USING$("tid # could not open exit event, creating new", tid)
       lpAttributes     = %NULL     ' default security
       bManualReset     = %FALSE    ' If false, system will set to unsignalled on each statisfied wait
       bInitialState    = %FALSE    ' I want it to detect signalled state
       hEvent(0)        =  CreateEvent (BYVAL lpAttributes, bManualReset, bInitialState, szName)
  ELSE
       'STDOUT USING$("tid # opened existing exit event", tid)
  END IF


  ' *******************************************************************
  '  Create an unnamed event which initially is signalled as index 1
  '  Because this event is signalled, it lets the loop continue when
  '  nothing else' has occured... which is what we want.
  ' *******************************************************************

  lpAttributes     = %NULL     ' default security
  bManualReset     = %TRUE     ' If false, system will set to unsignalled on each statisfied wait
                               ' we do not want this
  bInitialState    = %TRUE     ' I want it to be signalled
  pszName          = %NULL     ' unnamed event (don't need a name here)
  hEvent(1)        = CreateEvent (BYVAL lpAttributes, bManualReset, bInitialState, BYVAL pszName)

  ' loop driver and WFMO params:
  bWaitAll = %FALSE
  nLoop    = 0
  maxLoop  = iMax

  ' -------------------------------------------------------------------
  ' THIS IS THE POINT WHERE A 'READY EVENT' SHOULD BE SIGNALLED TO
  ' RELEASE THE CALLING THREAD .. *AFTER* THE THREAD HAS OBTAINED ITS
  ' HANDLE TO THE SHARED 'EXIT' EVENT
  ' FOR THIS DEMO, WE JUST 'SLEEP' IN THE CALLING THREAD.
  ' THIS IS *NOT* A RECOMMENDED SUBSTITUTE FOR A 'READY EVENT.'
  ' -------------------------------------------------------------------

   DO WHILE nLoop <= MaxLoop   ' do a maxumim number of times. FOR/NEXT would work here, too.

      iWait  = WaitForMultipleObjects (BYVAL 2&, BYVAL VARPTR(hEvent(0)), bWaitAll, %INFINITE)

      SELECT  CASE AS LONG  iWait
          CASE %WAIT_OBJECT_0     ' first event (the forced exit) satisfied wait.
              bForcedExit       = %TRUE
              'STDOUT USING$( "TID # FORCED EXIT Signalled with nLoop #", tid, nLoop)
              EXIT DO

          CASE %WAIT_OBJECT_0 + 1  ' second event (continue) satisfied wait
              INCR  nLoop
              'STDOUT  USING$("TID # Executing loop # code" , tid, nLoop)
              '
              SLEEP   2000   ' <<< THE REAL WORK GETS DONE HERE
              ' increment the count of times we have actually been here
              ' and store the result in assigned index
              iCount    =  TlsGetValue (g_tlsiCount)  ' get current value
              INCR         icount
              TlsSetValue  g_tlsiCount, BYVAL iCount
              ' update the last time the 'real work' loop executed
              GetSystemTime   st
              szTF           = "HHmmss"   ' 24 hour HHMMSS with leading zeroes for HH, mm and ss
              GetTimeFormat   BYVAL %NULL, BYVAL %NULL, st, szTF, szTime, SIZEOF(szTime)  'returns HHmmss
              ' convert the formatted string time to an integer
               lTime         = VAL (szTime)
              ' store it in assigned index
               TlsSetValue     g_tlsiTimeLast, BYVAL lTime
              

      END SELECT

   LOOP
   ' On exit, show a display of thread id, time start, how exited, number of loops executed
   ' and how many loops it completed before exiting.
   

   sMask   =  " Thread ID _0x& started at & executed # work loops_, last at & before & exit"
   ' get the count and the two times for this particular thread
   iCount     = TlsGetValue (g_tlsiCount)
   lTimeFirst = TlsGetvalue (g_tlsiTimeFirst)
   lTimeLast  = TlsGetValue (G_tlsiTimeLast)
   
   w          = FORMAT$(lTimeFirst)
   sTimeFirst = LEFT$(w,2) & ":" & MID$(W, 3,2) & ":" & RIGHT$(W,2)
   
   W          = FORMAT$(lTimeLast)
   sTimeLast  = LEFT$(w,2) & ":" & MID$(W, 3,2) & ":" & RIGHT$(W,2)
   
   sHowExit   = IIF$(bForcedExit, "Forced", "Normal")
   
   STDOUT USING$ (sMask, HEX$(Tid,4), sTimeFirst, iCount, sTimeLast, sHowExit)
   
   'STDOUT "Exited loop: Closing handles and exiting thread function"
   
   ' clean up our handles:
   
   CloseHandle hEvent(0)
   CloseHandle hEvent(1)

END FUNCTION

' *** END OF FILE ***

------------------
Michael Mattias
Tal Systems Inc.
Racine WI USA
mailto:[email protected][email protected]</A>
www.talsystems.com

Announcement

Forum Guidelines

Terminate Worker Threads using Windows Events

Terminate Worker Threads using Windows Events

Comment

Comment