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
Leave a comment: