Does anybody have any experience using the windows thread pool api's?
1. CreateThreadpool
2. SetThreadpoolThreadMaximum
3. SetThreadpoolThreadMinimum
4. CreateThreadpoolWork
5. SubmitThreadpoolWork
6. CloseThreadpoolWork
7. CloseThreadPool
Nope. Sorry. Wish I could help you on this one but threading is not my specialty. :)
Thank you, I'm not sure here, and, the only thing to do is to test, test, test. And, then test some more. For this to work as I'm thinking, I'll also have to have a stack object to push TCP sockets into and have the thread pop 'em off. As long as I'm spending a big chunk of time to get the SQLite client/server stuff going, I might as well as investigate all the stuff MS offers and build a race car version.
Rick
What exactly is the purpose of a thread pool? To avoid the overhead of creating and terminating thread functions by having a pool of threads 'standing by' waiting for you to give them something to do? Something like that?
Quote from: Eddy Van Esch on May 24, 2017, 05:56:17 PM
What exactly is the purpose of a thread pool? To avoid the overhead of creating and terminating thread functions by having a pool of threads 'standing by' waiting for you to give them something to do? Something like that?
Yes
MSDN: Thread pool architecture (https://msdn.microsoft.com/en-us/library/windows/desktop/ms686760(v=vs.85).aspx) :-)
Quote from: Pierre Bellisle on May 24, 2017, 10:35:36 PM
MSDN: Thread pool architecture (https://msdn.microsoft.com/en-us/library/windows/desktop/ms686760(v=vs.85).aspx) :-)
Thank you, that link is helpful.
Hey Richard,
Also, the link point to a code demo: Using the Thread Pool Functions (https://msdn.microsoft.com/en-us/library/windows/desktop/ms686980(v=vs.85).aspx)
Looks pretty interesting...
Pierre
Quote from: Pierre Bellisle on May 25, 2017, 12:57:02 PM
Hey Richard,
Also, the link point to a code demo: Using the Thread Pool Functions (https://msdn.microsoft.com/en-us/library/windows/desktop/ms686980(v=vs.85).aspx)
Looks pretty interesting...
Pierre
I'll use that as a guide.
What got me thinking about a thread pool is trying to decide the ideal number of threads taking into consideration different computers with varying number of cores to exploit maximum system performance. I also know that creating and destroying threads is a relatively expensive process. From my reading on thread pools, the concept is I shouldn't really care how many threads it has. Just submit work to the pool and let Windows determine how to optimally execute each work request. I plan on using this in a multithreading TCP/UDP environment. To be safe, I think I'll "shadow" the TCP socket value using FB Allocate as my pAny as Any Ptr and have the thread get a local copy and then Deallocate. Since I think during program shutdown, it is best to let all outstanding threads complete, I'll also have to come up with a way to determine if there are any outstanding threads still running.
Rick
....don't make it too complicated, simple people like myself need to be able to follow and understand the code. :)
Quote from: TechSupport on May 25, 2017, 04:02:01 PM
....don't make it too complicated, simple people like myself need to be able to follow and understand the code. :)
Believe me Paul, if I can understand it, you will breeze right through it. In this case, I have to let go of "knowing" everything under the hood and just accept that when I press the gas pedal, the darn car moves. I'm in new territory here....
Rick
How about creating your own thread pool system?
You launch a number of threads, as many as you like, and you have them waiting for something to do.
Then you feed them work ..
Doesn't seem impossible to do .. The heart of this is a good system to communicate with the threads. Also to have the threads use no system resources (CPU capacity) when they are waiting .. (WaitForSingleObject ..?) ...
Quote from: Eddy Van Esch on May 25, 2017, 05:44:30 PM
How about creating your own thread pool system?
You launch a number of threads, as many as you like, and you have them waiting for something to do.
Then you feed them work ..
Doesn't seem impossible to do .. The heart of this is a good system to communicate with the threads. Also to have the threads use no system resources (CPU capacity) when they are waiting .. (WaitForSingleObject ..?) ...
Well....this is exactly what the windows thread pool api's do.....
Well Paul, this chunk of code seems to work. I created a private thread pool, submitted three work/thread requests and they ran.
const _WIN32_WINNT = &h0602
#INCLUDE ONCE "windows.bi"
declare sub myThread (byval Instance as PTP_CALLBACK_INSTANCE, byval Context as PVOID, byval Work as PTP_WORK)
dim shared lpCriticalSection as CRITICAL_SECTION
dim iError as long
dim ptpp as PTP_POOL
dim reserved as PVOID
dim ucbe as TP_CALLBACK_ENVIRON
dim cbe as PTP_CALLBACK_ENVIRON
dim Work as PTP_WORK
dim iIndex as integer
cbe = cast(PTP_CALLBACK_ENVIRON,varptr(ucbe))
InitializeCriticalSection(ByVal VarPtr(lpCriticalSection))
ptpp = CreateThreadpool(reserved)
iError = GetLastError()
if ptpp = 0 THEN
print "CreateThreadPool failed,error=" + str(iError)
Print "press q to quit"
Do
Sleep 1, 1
Loop Until Inkey = "q"
END
END IF
print "CreateThreadPool successful..."
TpInitializeCallbackEnviron(cbe)
TpSetCallbackLongFunction(cbe)
for iIndex = 1 to 3
Work = CreateThreadpoolWork(cast(PTP_WORK_CALLBACK,@myThread),cast(PVOID,iIndex),cbe)
SubmitThreadpoolWork(Work)
CloseThreadpoolWork(Work)
NEXT
sleep 1000,1
TpDestroyCallbackEnviron(cbe)
CloseThreadpool(ptpp)
DeleteCriticalSection(ByVal VarPtr(lpCriticalSection))
Print "press q to quit"
Do
Sleep 1, 1
Loop Until Inkey = "q"
end
sub myThread (byval Instance as PTP_CALLBACK_INSTANCE, byval Context as PVOID, byval Work as PTP_WORK)
EnterCriticalSection(ByVal VarPtr(lpCriticalSection))
print "Thread started,Instance=" + str(Instance) + ",Context=" + str(Context)
LeaveCriticalSection(ByVal VarPtr(lpCriticalSection))
end sub
See if it works for you (an anybody else that wants to give it a shot). I ran with both 32 and 64 bit compiles.
Rick
Jose, I did not find CloseThreadpoolCleanupGroupMembers() in your includes?
-
Here is a litteral Console-PowerBASIC translation of the MSDN example, using Josee's include.
Code need to be tested... ;-)
Pierre
'https://msdn.microsoft.com/en-us/library/windows/desktop/ms686980(v=vs.85).aspx
'Thread Pools
'A thread pool is a collection of worker threads that efficiently execute asynchronous
'callbacks on behalf of the application. The thread pool is primarily used to reduce
'the number of application threads and provide management of the worker threads.
'Applications can queue work items, associate work with waitable handles,
'automatically queue based on a timer, and bind with I/O.
'The thread pool architecture consists of the following:
'Worker threads that execute the callback functions
'Waiter threads that wait on multiple wait handles
'A work queue
'A default thread pool for each process
'A worker factory that manages the worker threads
'Using Jose Roca include files
'Windows API Headers III v. 1.07 PBWIN 10 or PBCC 6 http://www.jose.it-berater.org/smfforum/index.php?topic=5061.0
'Windows API Headers v. 1.19 PBWIN 9 or PBCC 5 http://www.jose.it-berater.org/smfforum/index.php?topic=4136.0
#COMPILE EXE '#CC 5.07(D:\Basic\Bas\Jose Roca\Forum\Jose\Windows API Headers\1.19 (PB9.x)\uz)#
#REGISTER NONE
#DIM ALL
#INCLUDE "Win32Api.inc"
#INCLUDE "WinBase.inc"
MACRO TP_POOL = DWORD 'PTP_POOL is an opaque pointer.
MACRO PTP_WAIT = DWORD
MACRO TP_WAIT_RESULT = DWORD
MACRO PTP_WORK = DWORD
MACRO PTP_TIMER = DWORD
MACRO PTP_POOL = DWORD
MACRO PTP_WORK_CALLBACK = DWORD
MACRO PTP_CALLBACK_INSTANCE = DWORD
MACRO PTP_TIMER_CALLBACK = DWORD
MACRO PTP_CLEANUP_GROUP = DWORD
DECLARE FUNCTION CreateThreadpool LIB "Kernel32.dll" ALIAS "CreateThreadpool" _
(BYVAL Reserved AS DWORD) AS DWORD
DECLARE FUNCTION CloseThreadpoolCleanupGroupMembers LIB "Kernel32.dll" ALIAS "CloseThreadpoolCleanupGroupMembers" _
(ptpcg AS PTP_CLEANUP_GROUP, BYVAL fCancelPendingCallbacks AS LONG, pvCleanupContext AS LONG) AS DWORD
'_____________________________________________________________________________
'
FUNCTION MyWaitCallback(Instance_ AS PTP_CALLBACK_INSTANCE, Parameter AS LONG, Wait AS PTP_WAIT, WaitResult AS TP_WAIT_RESULT) AS DWORD
'Do something when the wait is over.
PRINT "MyWaitCallback: wait is over."
END FUNCTION
'_____________________________________________________________________________
FUNCTION MyTimerCallback(Instance_ AS PTP_CALLBACK_INSTANCE, Parameter AS LONG, Timer_ AS PTP_TIMER) AS LONG
'Do something when the timer fires.
PRINT "MyTimerCallback: timer has fired."
END FUNCTION
'_____________________________________________________________________________
FUNCTION MyWorkCallback(Instance_ AS PTP_CALLBACK_INSTANCE, Parameter AS LONG, Work AS PTP_WORK) AS LONG
'Do something when the work callback is invoked.
PRINT "MyWorkCallback: Task performed."
END FUNCTION
'_____________________________________________________________________________
SUB DemoCleanupPersistentWorkTimer()
LOCAL CallBackEnviron AS TP_CALLBACK_ENVIRON 'MACRO TP_CALLBACK_ENVIRON = TP_CALLBACK_ENVIRON_V3
LOCAL WorkCallback AS PTP_WORK_CALLBACK
LOCAL TimerCallback AS PTP_TIMER_CALLBACK
LOCAL CleanupGroup AS PTP_CLEANUP_GROUP
LOCAL Work AS PTP_WORK
LOCAL timer_ AS PTP_TIMER
LOCAL pool AS PTP_POOL
LOCAL FileDueTime AS FILETIME
LOCAL ulDueTime AS QUAD
LOCAL rollback AS DWORD
LOCAL bRet AS LONG
WorkCallback = CODEPTR(MyWorkCallback)
TimerCallback = CODEPTR(MyTimerCallback)
InitializeThreadpoolEnvironment(CallBackEnviron)
'Create a custom, dedicated thread pool.
pool = CreateThreadpool(%NULL)
IF pool = 0 THEN
PRINT "CreateThreadpool failed. LastError:" & STR$(GetLastError())
GOTO main_cleanup
END IF
rollback = 1 'pool creation succeeded
'The thread pool is made persistent simply by setting
'both the minimum and maximum threads to 1.
SetThreadpoolThreadMaximum(BYVAL pool, 1)
bRet = SetThreadpoolThreadMinimum(BYVAL pool, 1)
IF bRet = 0 THEN
PRINT "SetThreadpoolThreadMinimum failed. LastError:" & STR$(GetLastError())
GOTO main_cleanup
END IF
'Create a cleanup group for this thread pool.
CleanupGroup = CreateThreadpoolCleanupGroup()
IF CleanupGroup = 0 THEN
PRINT "CreateThreadpoolCleanupGroup failed. LastError:" & STR$(GetLastError())
GOTO main_cleanup
END IF
rollback = 2 'Cleanup group creation succeeded
'Associate the callback environment with our thread pool.
CallbackEnviron.Pool = Pool
'Associate the cleanup group with our thread pool.
'Objects created with the same callback environment
'as the cleanup group become members of the cleanup group.
CallbackEnviron.CleanupGroup = CleanupGroup
'Create work with the callback environment.
Work = CreateThreadpoolWork(WorkCallback, BYVAL %NULL, CallBackEnviron)
IF Work = 0 THEN
PRINT "CreateThreadpoolWork failed. LastError:" & STR$(GetLastError())
GOTO main_cleanup
END IF
rollback = 3 'Creation of work succeeded
'Submit the work to the pool. Because this was a pre-allocated
'work item (using CreateThreadpoolWork), it is guaranteed to execute.
SubmitThreadpoolWork(BYVAL Work)
'Create a timer with the same callback environment.
timer_ = CreateThreadpoolTimer(TimerCallback, BYVAL %NULL, CallBackEnviron)
IF timer_ = 0 THEN
PRINT "CreateThreadpoolTimer failed. LastError:" & STR$(GetLastError())
GOTO main_cleanup
END IF
rollback = 4 'Timer creation succeeded
'Set the timer to fire in one second.
ulDueTime = -(1 * 10 * 1000 * 1000)
FileDueTime.dwHighDateTime = HI(DWORD, ulDueTime)
FileDueTime.dwLowDateTime = LO(DWORD, ulDueTime)
SetThreadpoolTimer(BYVAL timer_, FileDueTime, 0, 0)
'Delay for the timer to be fired
Sleep(1500)
'Wait for all callbacks to finish.
'CloseThreadpoolCleanupGroupMembers also releases objects
'that are members of the cleanup group, so it is not necessary
'to call close functions on individual objects
'after calling CloseThreadpoolCleanupGroupMembers.
CloseThreadpoolCleanupGroupMembers(BYVAL CleanupGroup, %FALSE, %NULL)
'Already cleaned up the work item with the
'CloseThreadpoolCleanupGroupMembers, so set rollback to 2.
rollback = 2
GOTO main_cleanup
main_cleanup:
'Clean up any individual pieces manually
'Notice the fall-through structure of the switch.
'Clean up in reverse order.
SELECT CASE rollback
CASE 4:
CASE 3: 'Clean up the cleanup group members.
CloseThreadpoolCleanupGroupMembers(BYVAL CleanupGroup, %FALSE, %NULL)
CASE 2: 'Clean up the cleanup group.
CloseThreadpoolCleanupGroup(BYVAL CleanupGroup)
CASE 1: 'Clean up the pool.
CloseThreadpool(BYVAL pool)
CASE ELSE
END SELECT
END SUB
'_____________________________________________________________________________
SUB DemoNewRegisterWait()
LOCAL Wait AS PTP_WAIT
LOCAL waitcallback AS DWORD
LOCAL PTP_WAIT_CALLBACK AS DWORD
LOCAL hEvent AS DWORD
LOCAL rollback AS WORD
LOCAL i AS WORD
waitcallback = CODEPTR(MyWaitCallback)
'Create an auto-reset event.
hEvent = CreateEvent("", %FALSE, %FALSE, "")
IF hEvent = 0 THEN
PRINT "Error Handling"
EXIT SUB
END IF
rollback = 1 'CreateEvent succeeded
Wait = CreateThreadpoolWait(waitcallback, BYVAL %NULL, "")
IF Wait = 0 THEN
PRINT "CreateThreadpoolWait failed. LastError:" & STR$(GetLastError())
GOTO new_wait_cleanup
END IF
rollback = 2 'CreateThreadpoolWait succeeded
'Need to re-register the event with the wait object
'each time before signaling the event to trigger the wait callback.
FOR i = 0 TO 4
SetThreadpoolWait(BYVAL Wait, BYVAL hEvent, BYVAL %NULL)
SetEvent(hEvent)
'Delay for the waiter thread to act if necessary.
SLEEP(500)
'Block here until the callback function is done executing.
WaitForThreadpoolWaitCallbacks(BYVAL Wait, %FALSE)
NEXT
new_wait_cleanup:
SELECT CASE rollback
CASE 2 'Unregister the wait by setting the event to NULL.
SetThreadpoolWait(BYVAL Wait, %NULL, "")
'Close the wait.
CloseThreadpoolWait(BYVAL Wait)
CASE 1
'Close the event.
CloseHandle(hEvent)
CASE ELSE
END SELECT
END SUB
'_____________________________________________________________________________
FUNCTION PBMAIN() AS LONG
DemoNewRegisterWait()
DemoCleanupPersistentWorkTimer()
PRINT : PRINT "Type or click..." : MOUSE ON : MOUSE 3, UP : WAITKEY$
END FUNCTION
'______________________________________________________________________________
'
Your code works fine for me too Richard, both 32 and 64...
Pierre
> Jose, I did not find CloseThreadpoolCleanupGroupMembers() in your includes?
Must have skipped it accidentally.
DECLARE SUB CloseThreadpoolCleanupGroupMembers IMPORT "KERNEL32.DLL" ALIAS "CloseThreadpoolCleanupGroupMembers" ( _
BYVAL ptpp AS DWORD _ ' __in PTP_CLEANUP_GROUP ptpcg
, BYVAL fCancelPendingCallbacks AS LONG _ ' __BOOL fCancelPendingCallbacks
, BYVAL pvCleanupContext AS DWORD _ ' __PVOID pvCleanupContext
) ' void
Thank you Jose. :-)
Pierre
Quote from: Richard Kelly on May 25, 2017, 01:23:34 PM
Since I think during program shutdown, it is best to let all outstanding threads complete, I'll also have to come up with a way to determine if there are any outstanding threads still running.
I'm beginning to like these threadpool api's. Adding the following will allow all outstanding callbacks/threads to complete which is what I want to do.
CreateThreadpoolCleanupGroup
SetThreadpoolCallbackCleanupGroup
CloseThreadpoolCleanupGroupMembers
This api will wait for all callbacks to finish. It also releases objects so it is not necessary to call any close functions.
CloseThreadpoolCleanupGroup
Maybe this is best encapsulated into it's own object class.
Rick
For the fun of it, same MSDN thread pool example, this time ported to FreeBASIC.
Pierre
#Define JumpCompiler "<D:\Free\64\fbc.exe>"
#Define JumpCompilerCmd "<-s console>"
#Lang "fb"
#Define Unicode
Const _WIN32_WINNT = &h0602
#Include Once "Windows.bi"
#Include Once "Win\WinNT.bi"
#Include Once "Win\WinBase.bi"
#Macro InitializeThreadpoolEnvironment(pcbe)
TpInitializeCallbackEnviron(pcbe)
#EndMacro
#Macro SetThreadpoolCallbackPool(pcbe, ptpp)
TpSetCallbackThreadpool(pcbe, ptpp)
#EndMacro
#Macro SetThreadpoolCallbackCleanupGroup(pcbe, ptpcg, pfng)
TpSetCallbackCleanupGroup(pcbe, ptpcg, pfng)
#EndMacro
'_____________________________________________________________________________
'
Function MyWaitCallback(Instance_ As PTP_CALLBACK_INSTANCE, Parameter As Long, Wait_ As PTP_WAIT, WaitResult As TP_WAIT_RESULT) As Long
Print "MyWaitCallback: Wait is over."
Function = 1
End Function
'_____________________________________________________________________________
Function MyTimerCallback(Instance_ As PTP_CALLBACK_INSTANCE, Parameter As Long, Timer_ As PTP_TIMER) As Long
'Do something when the timer fires.
Print "MyTimerCallback: Timer has fired."
Function = 1
End Function
'_____________________________________________________________________________
Function MyWorkCallback(Instance_ As PTP_CALLBACK_INSTANCE, Parameter As Long, Work As PTP_WORK) As Long
Print "MyWorkCallback: Task performed."
Function = 1
End Function
'_____________________________________________________________________________
Sub DemoCleanupPersistentWorkTimer()
Dim bRet As Long
Dim work As PTP_WORK
Dim timer_ As PTP_TIMER
Dim pool As PTP_POOL
Dim CallBackEnviron As TP_CALLBACK_ENVIRON
Dim cleanupgroup As PTP_CLEANUP_GROUP
Dim FileDueTime As FILETIME
Dim ulDueTime As ULongInt
Dim rollback As DWORD
InitializeThreadpoolEnvironment(@CallBackEnviron)
'Create a custom, dedicated thread pool.
pool = CreateThreadpool(ByVal NULL)
If pool = 0 Then
Print "CreateThreadpool failed. LastError:" & Str$(GetLastError())
GoTo main_cleanup
End If
rollback = 1 'Pool creation succeeded
'The thread pool is made persistent simply by setting
'both the minimum and maximum threads to 1.
SetThreadpoolThreadMaximum(ByVal pool, 1)
bRet = SetThreadpoolThreadMinimum(ByVal pool, 1)
If bRet = 0 Then
Print "SetThreadpoolThreadMinimum failed. LastError:" & Str$(GetLastError())
GoTo main_cleanup
End If
'Create a cleanup group for this thread pool.
cleanupgroup = CreateThreadpoolCleanupGroup()
If cleanupgroup = 0 Then
Print "CreateThreadpoolCleanupGroup failed. LastError:" & Str$(GetLastError())
GoTo main_cleanup
End If
rollback = 2 'Cleanup group creation succeeded
'Associate the callback environment with our thread pool.
SetThreadpoolCallbackPool(@CallBackEnviron, pool)
'Associate the cleanup group with our thread pool.
'Objects created with the same callback environment
'as the cleanup group become members of the cleanup group.
SetThreadpoolCallbackCleanupGroup(@CallBackEnviron, cleanupgroup, NULL)
'Create work with the callback environment.
work = CreateThreadpoolWork(Cast(Any Pointer, @MyWorkCallback), ByVal NULL, @CallBackEnviron)
If work = 0 Then
Print "CreateThreadpoolWork failed. LastError:" & Str$(GetLastError())
GoTo main_cleanup
End If
rollback = 3 'Creation of work succeeded
'Submit the work to the pool. Because this was a pre-allocated
'work item (using CreateThreadpoolWork), it is guaranteed to execute.
SubmitThreadpoolWork(ByVal work)
'Create a timer with the same callback environment.
timer_ = CreateThreadpoolTimer(Cast(Any Pointer, @MyTimerCallback), ByVal NULL, @CallBackEnviron)
If timer_ = 0 Then
Print "CreateThreadpoolTimer failed. LastError:" & Str$(GetLastError())
GoTo main_cleanup
End If
rollback = 4 'Timer creation succeeded
'Set the timer to fire in one second.
ulDueTime = -(1 * 10 * 1000 * 1000)
FileDueTime.dwHighDateTime = ((Cast(ULong, ulDueTime) And &hFFFFFFFF00000000) Shr 32)
FileDueTime.dwLowDateTime = ((Cast(ULong, ulDueTime) And &hFFFFFFFF))
SetThreadpoolTimer(ByVal timer_, @FileDueTime, 0, 0)
'Delay for the timer to be fired
Sleep(1500)
'Wait for all callbacks to finish.
'CloseThreadpoolCleanupGroupMembers also releases objects
'that are members of the cleanup group, so it is not necessary
'to call close functions on individual objects
'after calling CloseThreadpoolCleanupGroupMembers.
CloseThreadpoolCleanupGroupMembers(ByVal cleanupgroup, FALSE, NULL)
'Already cleaned up the work item with the
'CloseThreadpoolCleanupGroupMembers, so set rollback to 2.
rollback = 2
GoTo main_cleanup
main_cleanup:
'Clean up any individual pieces manually
'Notice the fall-through structure of the switch.
'Clean up in reverse order.
Select Case rollback
Case 3: 'Clean up the cleanup group members.
CloseThreadpoolCleanupGroupMembers(ByVal cleanupgroup, FALSE, NULL)
Case 2: 'Clean up the cleanup group.
CloseThreadpoolCleanupGroup(ByVal cleanupgroup)
Case 1: 'Clean up the pool.
CloseThreadpool(ByVal pool)
End Select
End Sub
'_____________________________________________________________________________
Sub DemoNewRegisterWait()
Dim Wait_ As PTP_WAIT
Dim hEvent As HANDLE
Dim i As Long
Dim rollback As Long
'Create an auto-reset event.
hEvent = CreateEvent(NULL, FALSE, FALSE, "")
If hEvent = 0 Then
Print "Error Handling"
Exit Sub
End If
rollback = 1 'CreateEvent succeeded
Wait_ = CreateThreadpoolWait(Cast(Any Pointer, @MyWaitCallback), ByVal NULL, NULL)
If Wait_ = 0 Then
Print "CreateThreadpoolWait failed. LastError:" & Str$(GetLastError())
GoTo new_wait_cleanup
End If
rollback = 2 'CreateThreadpoolWait succeeded
'Need to re-register the event with the wait object
'each time before signaling the event to trigger the wait callback.
For i = 0 To 4
SetThreadpoolWait(ByVal Wait_, ByVal hEvent, ByVal NULL)
SetEvent(hEvent)
'Delay for the waiter thread to act if necessary.
Sleep(500)
'Block here until the callback function is done executing.
WaitForThreadpoolWaitCallbacks(ByVal Wait_, FALSE)
Next
new_wait_cleanup:
Select Case rollback
Case 2 'Unregister the wait by setting the event to NULL.
SetThreadpoolWait(ByVal Wait_, NULL, NULL)
'Close the wait.
CloseThreadpoolWait(ByVal Wait_)
Case 1
'Close the event.
CloseHandle(hEvent)
End Select
End Sub
'_____________________________________________________________________________
DemoNewRegisterWait()
DemoCleanupPersistentWorkTimer()
Print "Press a key or click to end"
Dim MB As Long : Do : GetMouse(0, 0, 0, MB) : If MB Or Len(InKey) Then Exit Do : End If : Sleep 10 : Loop
'______________________________________________________________________________
'
Well, I haven't tried to compile this yet, but everything I wanted went into a rather small class attached.
*** Update ***
I got home and fixed up all my finger coding checks. Attachment now updated.
Save the attachment in inc/cCTSQL and now the test script looks like:
#INCLUDE ONCE "cCTSQL/cCTServerThreadPool.bi"
declare sub myThread (byval Instance as PTP_CALLBACK_INSTANCE, byval Context as PVOID, byval Work as PTP_WORK)
dim shared lpCriticalSection as CRITICAL_SECTION
dim oThreadPool as cCTServerThreadPool
dim iError as long
dim iIndex as integer
if oThreadPool.StartupStatus(iError) = False THEN
print "CreateThreadPool failed,error=" + str(iError)
Print "press q to quit"
Do
Sleep 1, 1
Loop Until Inkey = "q"
END
END IF
InitializeCriticalSection(ByVal VarPtr(lpCriticalSection))
for iIndex = 1 to 10
oThreadPool.CreateThreadWork(cast(PTP_WORK_CALLBACK,@myThread),cast(PVOID,iIndex))
NEXT
oThreadPool.ShutdownThreadPool()
Print "press q to quit"
Do
Sleep 1, 1
Loop Until Inkey = "q"
end
DeleteCriticalSection(ByVal VarPtr(lpCriticalSection))
sub myThread (byval Instance as PTP_CALLBACK_INSTANCE, byval Context as PVOID, byval Work as PTP_WORK)
EnterCriticalSection(ByVal VarPtr(lpCriticalSection))
print "Thread started,Instance=" + str(Instance) + ",Context=" + str(Context)
LeaveCriticalSection(ByVal VarPtr(lpCriticalSection))
end sub
The ShutdownThreadPool does seem to wait for all callbacks/threads to finish (it does it asynchronously).
You can follow Dave Roberts from the PB forums on his thread pool journey in the FB forums at:
http://www.freebasic.net/forum/viewtopic.php?f=6&t=25697 (http://www.freebasic.net/forum/viewtopic.php?f=6&t=25697)