X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Frts%2FSelect.c;h=3cec3a9afc9b36e48d7fccb4b6208d40bbcf949e;hb=b024717f2be4326cb11ced4e2d703ebcced05f96;hp=922b15157f71a69d17a75e7556bf1cc6d5adcb99;hpb=d4fc96655eba2dd67726f8043d073ec41ea03662;p=ghc-hetmet.git diff --git a/ghc/rts/Select.c b/ghc/rts/Select.c index 922b151..3cec3a9 100644 --- a/ghc/rts/Select.c +++ b/ghc/rts/Select.c @@ -1,7 +1,6 @@ /* ----------------------------------------------------------------------------- - * $Id: Select.c,v 1.20 2002/07/09 20:44:24 sof Exp $ * - * (c) The GHC Team 1995-1999 + * (c) The GHC Team 1995-2002 * * Support for concurrent non-blocking I/O and thread waiting. * @@ -14,8 +13,10 @@ #include "Schedule.h" #include "RtsUtils.h" #include "RtsFlags.h" +#include "Timer.h" #include "Itimer.h" #include "Signals.h" +#include "Capability.h" # ifdef HAVE_SYS_TYPES_H # include @@ -25,12 +26,20 @@ # include # endif -# ifdef mingw32_TARGET_OS -# include -# endif +#include +#include + +#ifdef HAVE_UNISTD_H +#include +#endif /* last timestamp */ -nat timestamp = 0; +lnat timestamp = 0; + +#if !defined(RTS_SUPPORTS_THREADS) +/* + * The threaded RTS uses an IO-manager thread in Haskell instead (see GHC.Conc) + */ /* There's a clever trick here to avoid problems when the time wraps * around. Since our maximum delay is smaller than 31 bits of ticks @@ -44,7 +53,7 @@ nat timestamp = 0; * (idea due to Andy Gill). */ rtsBool -wakeUpSleepingThreads(nat ticks) +wakeUpSleepingThreads(lnat ticks) { StgTSO *tso; rtsBool flag = rtsFalse; @@ -55,7 +64,7 @@ wakeUpSleepingThreads(nat ticks) sleeping_queue = tso->link; tso->why_blocked = NotBlocked; tso->link = END_TSO_QUEUE; - IF_DEBUG(scheduler,belch("Waking up sleeping thread %d\n", tso->id)); + IF_DEBUG(scheduler,debugBelch("Waking up sleeping thread %d\n", tso->id)); PUSH_ON_RUN_QUEUE(tso); flag = rtsTrue; } @@ -81,13 +90,10 @@ awaitEvent(rtsBool wait) StgTSO *tso, *prev, *next; rtsBool ready; fd_set rfd,wfd; -#ifndef mingw32_TARGET_OS int numFound; int maxfd = -1; -#endif rtsBool select_succeeded = rtsTrue; rtsBool unblock_all = rtsFalse; - static rtsBool prev_unblocked_all = rtsFalse; struct timeval tv; lnat min, ticks; @@ -95,11 +101,11 @@ awaitEvent(rtsBool wait) tv.tv_usec = 0; IF_DEBUG(scheduler, - belch("scheduler: checking for threads blocked on I/O"); + debugBelch("scheduler: checking for threads blocked on I/O"); if (wait) { - belch(" (waiting)"); + debugBelch(" (waiting)"); } - belch("\n"); + debugBelch("\n"); ); /* loop until we've woken up some threads. This loop is needed @@ -123,7 +129,6 @@ awaitEvent(rtsBool wait) min = 0x7ffffff; } -#ifndef mingw32_TARGET_OS /* * Collect all of the fd's that we're interested in */ @@ -155,20 +160,6 @@ awaitEvent(rtsBool wait) } } - /* Release the scheduler lock while we do the poll. - * this means that someone might muck with the blocked_queue - * while we do this, but it shouldn't matter: - * - * - another task might poll for I/O and remove one - * or more threads from the blocked_queue. - * - more I/O threads may be added to blocked_queue. - * - more delayed threads may be added to blocked_queue. We'll - * just subtract delta from their delays after the poll. - * - * I believe none of these cases lead to trouble --SDM. - */ - RELEASE_LOCK(&sched_mutex); - /* Check for any interesting events */ tv.tv_sec = min / 1000000; @@ -185,38 +176,31 @@ awaitEvent(rtsBool wait) should we see a bad file descriptor & give the threads a chance to clean up their act. - To avoid getting stuck in a loop, repeated EBADF failures - are 'handled' through barfing. + Note: assume here that threads becoming unblocked + will try to read/write the file descriptor before trying + to issue a threadWaitRead/threadWaitWrite again (==> an + IOError will result for the thread that's got the bad + file descriptor.) Hence, there's no danger of a bad + file descriptor being repeatedly select()'ed on, so + the RTS won't loop. */ - if ( errno == EBADF && !prev_unblocked_all) { + if ( errno == EBADF ) { unblock_all = rtsTrue; - prev_unblocked_all = rtsTrue; break; } else { - fprintf(stderr,"%d\n", errno); - fflush(stderr); perror("select"); barf("select failed"); } } -#else /* on mingwin */ - while (1) { - Sleep(0); /* don't busy wait */ -#endif /* mingw32_TARGET_OS */ - ACQUIRE_LOCK(&sched_mutex); - - prev_unblocked_all = rtsFalse; -#ifndef mingw32_TARGET_OS /* We got a signal; could be one of ours. If so, we need * to start up the signal handler straight away, otherwise * we could block for a long time before the signal is * serviced. */ +#if defined(RTS_USER_SIGNALS) if (signals_pending()) { - RELEASE_LOCK(&sched_mutex); /* ToDo: kill */ startSignalHandlers(); - ACQUIRE_LOCK(&sched_mutex); return; /* still hold the lock */ } #endif @@ -237,12 +221,8 @@ awaitEvent(rtsBool wait) if (run_queue_hd != END_TSO_QUEUE) { return; /* still hold the lock */ } - - RELEASE_LOCK(&sched_mutex); } - ACQUIRE_LOCK(&sched_mutex); - /* Step through the waiting queue, unblocking every thread that now has * a file descriptor in a ready state. */ @@ -263,7 +243,7 @@ awaitEvent(rtsBool wait) } if (ready) { - IF_DEBUG(scheduler,belch("Waking up blocked thread %d\n", tso->id)); + IF_DEBUG(scheduler,debugBelch("Waking up blocked thread %d\n", tso->id)); tso->why_blocked = NotBlocked; tso->link = END_TSO_QUEUE; PUSH_ON_RUN_QUEUE(tso); @@ -283,6 +263,8 @@ awaitEvent(rtsBool wait) blocked_queue_tl = prev; } } - + } while (wait && !interrupted && run_queue_hd == END_TSO_QUEUE); } + +#endif /* RTS_SUPPORTS_THREADS */