avoid a crash: don't return unless the run queue has some threads in it
[ghc-hetmet.git] / rts / win32 / AwaitEvent.c
1 #if !defined(THREADED_RTS) /* to the end */
2 /*
3  * Wait/check for external events. Periodically, the
4  * Scheduler checks for the completion of external operations,
5  * like the expiration of timers, completion of I/O requests
6  * issued by Haskell threads.
7  *
8  * If the Scheduler is otherwise out of work, it'll block
9  * herein waiting for external events to occur.
10  *
11  * This file mirrors the select()-based functionality 
12  * for POSIX / Unix platforms in rts/Select.c, but for
13  * Win32.
14  *
15  */
16 #include "Rts.h"
17 #include "Schedule.h"
18 #include "AwaitEvent.h"
19 #include <windows.h>
20 #include "win32/AsyncIO.h"
21 #include "win32/ConsoleHandler.h"
22
23 // Used to avoid calling abandonRequestWait() if we don't need to.
24 // Protected by sched_mutex.
25 static nat workerWaitingForRequests = 0;
26
27 void
28 awaitEvent(rtsBool wait)
29 {
30   int ret;
31
32   do {
33     /* Try to de-queue completed IO requests
34      */
35     workerWaitingForRequests = 1;
36     ret = awaitRequests(wait);
37     workerWaitingForRequests = 0;
38
39     // If a signal was raised, we need to service it
40     // XXX the scheduler loop really should be calling
41     // startSignalHandlers(), but this is the way that posix/Select.c
42     // does it and I'm feeling too paranoid to refactor it today --SDM
43     if (stg_pending_events != 0) {
44         startSignalHandlers(&MainCapability);
45         return;
46     }
47
48     // The return value from awaitRequests() is a red herring: ignore
49     // it.  Return to the scheduler if !wait, or
50     //
51     //  - we were interrupted
52     //  - the run-queue is now non- empty
53
54   } while (wait
55            && sched_state == SCHED_RUNNING
56            && emptyRunQueue(&MainCapability)
57       );
58 }
59 #endif