From 557947d3f93e11285e36423ddb08d859af60ab47 Mon Sep 17 00:00:00 2001 From: sof Date: Sat, 22 Feb 2003 04:51:58 +0000 Subject: [PATCH] [project @ 2003-02-22 04:51:50 by sof] Clean up code&interfaces that deals with timers and asynchrony: - Timer.{c,h} now defines the platform-independent interface to the timing services needed by the RTS. Itimer.{c,h} + win32/Ticker.{c,h} defines the OS-specific services that creates/destroys a timer. - For win32 plats, drop the long-standing use of the 'multimedia' API timers and implement the ticking service ourselves. Simpler and more flexible. - Select.c is now solely for platforms that use select() to handle non-blocking I/O & thread delays. win32/AwaitEvent.c provides the same API on the Win32 side. - support threadDelay on win32 platforms via worker threads. Not yet compiled up on non-win32 platforms; will do once checked in. --- ghc/rts/Itimer.c | 156 +++---------------------------------- ghc/rts/Itimer.h | 22 +++--- ghc/rts/LdvProfile.c | 4 +- ghc/rts/PrimOps.hc | 25 +++++- ghc/rts/Profiling.c | 4 +- ghc/rts/Proftimer.c | 4 +- ghc/rts/RetainerProfile.c | 4 +- ghc/rts/RtsFlags.c | 8 +- ghc/rts/RtsStartup.c | 8 +- ghc/rts/Schedule.c | 4 +- ghc/rts/Select.c | 41 +++------- ghc/rts/Timer.c | 67 ++++++++++++++++ ghc/rts/Timer.h | 22 ++++++ ghc/rts/rts.conf.in | 1 - ghc/rts/win32/AsyncIO.c | 58 ++++++++++++-- ghc/rts/win32/AsyncIO.h | 4 +- ghc/rts/win32/AwaitEvent.c | 62 +++++++++++++++ ghc/rts/win32/IOManager.c | 1 - ghc/rts/win32/Ticker.c | 95 ++++++++++++++++++++++ ghc/rts/win32/Ticker.h | 9 +++ 20 files changed, 373 insertions(+), 226 deletions(-) create mode 100644 ghc/rts/Timer.c create mode 100644 ghc/rts/Timer.h create mode 100644 ghc/rts/win32/AwaitEvent.c create mode 100644 ghc/rts/win32/Ticker.c create mode 100644 ghc/rts/win32/Ticker.h diff --git a/ghc/rts/Itimer.c b/ghc/rts/Itimer.c index bbc87384e0bd..f1dd8237117d 100644 --- a/ghc/rts/Itimer.c +++ b/ghc/rts/Itimer.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Itimer.c,v 1.31 2002/08/16 13:29:06 simonmar Exp $ + * $Id: Itimer.c,v 1.32 2003/02/22 04:51:50 sof Exp $ * * (c) The GHC Team, 1995-1999 * @@ -17,12 +17,10 @@ * Hence, we use the old-fashioned @setitimer@ that just about everyone seems * to support. So much for standards. */ - -/* This is not posix compliant. */ -/* #include "PosixSource.h" */ - #include "Rts.h" +#if !defined(mingw32_TARGET_OS) /* to the end */ #include "RtsFlags.h" +#include "Timer.h" #include "Itimer.h" #include "Proftimer.h" #include "Schedule.h" @@ -39,126 +37,10 @@ # endif # endif -#if HAVE_WINDOWS_H -# include -#endif - #ifdef HAVE_SIGNAL_H # include #endif -static lnat total_ticks = 0; - -/* ticks left before next pre-emptive context switch */ -static int ticks_to_ctxt_switch = 0; - -/* ----------------------------------------------------------------------------- - Tick handler - - We use the ticker for time profiling. - - SMP note: this signal could be delivered to *any* thread. We have - to ensure that it doesn't matter which thread actually runs the - signal handler. - -------------------------------------------------------------------------- */ - -static -void -#if defined(mingw32_TARGET_OS) || (defined(cygwin32_TARGET_OS) && !defined(HAVE_SETITIMER)) - -CALLBACK -handle_tick(UINT uID STG_UNUSED, UINT uMsg STG_UNUSED, DWORD dwUser STG_UNUSED, - DWORD dw1 STG_UNUSED, DWORD d STG_UNUSED) -#else -handle_tick(int unused STG_UNUSED) -#endif -{ - total_ticks++; - -#ifdef PROFILING - handleProfTick(); -#endif - - if (RtsFlags.ConcFlags.ctxtSwitchTicks > 0) { - ticks_to_ctxt_switch--; - if (ticks_to_ctxt_switch <= 0) { - ticks_to_ctxt_switch = RtsFlags.ConcFlags.ctxtSwitchTicks; - context_switch = 1; /* schedule a context switch */ - } - } -} - - -/* - * Handling timer events under cygwin32 is not done with signal/setitimer. - * Instead of the two steps of first registering a signal handler to handle - * \tr{SIGVTALRM} and then start generating them via @setitimer()@, we use - * the Multimedia API (MM) and its @timeSetEvent@. (Internally, the MM API - * creates a separate thread that will notify the main thread of timer - * expiry). -- SOF 7/96 - * - * 11/98: if the cygwin DLL supports setitimer(), then use it instead. - */ - -#if defined(mingw32_TARGET_OS) || (defined(cygwin32_TARGET_OS) && !defined(HAVE_SETITIMER)) - -static LPTIMECALLBACK vtalrm_cback; -static unsigned int vtalrm_id = 0; -static unsigned int period = -1; - -int -startVirtTimer(nat ms) -{ - /* On Win32 setups that don't have support for - setitimer(), we use the MultiMedia API's timer - support. - - The delivery of ticks isn't free; the performance hit should be checked. - */ - unsigned int delay; - TIMECAPS tc; - - vtalrm_cback = handle_tick; - - if ( timeGetDevCaps(&tc, sizeof(TIMECAPS)) == TIMERR_NOERROR) { - period = tc.wPeriodMin; - delay = timeBeginPeriod(period); - if (delay == TIMERR_NOCANDO) { /* error of some sort. */ - return -1; - } - } else { - return -1; - } - -#ifdef PROFILING - initProfTimer(); -#endif - - vtalrm_id = - timeSetEvent(ms, /* event every `delay' milliseconds. */ - 1, /* precision is within 1 ms */ - vtalrm_cback, - TIME_CALLBACK_FUNCTION, /* ordinary callback */ - TIME_PERIODIC); - - return 0; -} - -int -stopVirtTimer() -{ - /* Shutdown the MM timer */ - if ( vtalrm_id != 0 ) { - timeKillEvent(vtalrm_id); - } - if (period > 0) { - timeEndPeriod(period); - } - - return 0; -} - -#else static int install_vtalrm_handler(void) @@ -174,7 +56,7 @@ install_vtalrm_handler(void) } int -startVirtTimer(nat ms) +startTicker(nat ms) { # ifndef HAVE_SETITIMER /* fprintf(stderr, "No virtual timer on this system\n"); */ @@ -186,10 +68,6 @@ startVirtTimer(nat ms) timestamp = getourtimeofday(); -#ifdef PROFILING - initProfTimer(); -#endif - it.it_value.tv_sec = ms / 1000; it.it_value.tv_usec = 1000 * (ms - (1000 * it.it_value.tv_sec)); it.it_interval = it.it_value; @@ -198,7 +76,7 @@ startVirtTimer(nat ms) } int -stopVirtTimer() +stopTicker() { # ifndef HAVE_SETITIMER /* fprintf(stderr, "No virtual timer on this system\n"); */ @@ -213,12 +91,10 @@ stopVirtTimer() # endif } -#endif /* !{mingw,cygwin32}_TARGET_OS */ - # if 0 /* This is a potential POSIX version */ int -startVirtTimer(nat ms) +startTicker(nat ms) { struct sigevent se; struct itimerspec it; @@ -226,10 +102,6 @@ startVirtTimer(nat ms) timestamp = getourtimeofday(); -#ifdef PROFILING - initProfTimer(); -#endif - se.sigev_notify = SIGEV_SIGNAL; se.sigev_signo = SIGVTALRM; se.sigev_value.sival_int = SIGVTALRM; @@ -243,7 +115,7 @@ startVirtTimer(nat ms) } int -stopVirtTimer() +stopTicker() { struct sigevent se; struct itimerspec it; @@ -262,11 +134,8 @@ stopVirtTimer() it.it_interval = it.it_value; return timer_settime(tid, TIMER_RELTIME, &it, NULL); } - # endif -#if defined(mingw32_TARGET_OS) || (defined(cygwin32_TARGET_OS) && !defined(HAVE_SETITIMER)) -#else void block_vtalrm_signal(void) { @@ -288,12 +157,10 @@ unblock_vtalrm_signal(void) (void) sigprocmask(SIG_UNBLOCK, &signals, NULL); } -#endif /* gettimeofday() takes around 1us on our 500MHz PIII. Since we're * only calling it 50 times/s, it shouldn't have any great impact. */ -#if !defined(mingw32_TARGET_OS) unsigned int getourtimeofday(void) { @@ -302,10 +169,5 @@ getourtimeofday(void) return (tv.tv_sec * TICK_FREQUENCY + tv.tv_usec * TICK_FREQUENCY / 1000000); } -#else -unsigned int -getourtimeofday(void) -{ - return ((unsigned int)GetTickCount() * TICK_FREQUENCY) / 1000; -} -#endif + +#endif /* !mingw32_TARGET_OS */ diff --git a/ghc/rts/Itimer.h b/ghc/rts/Itimer.h index 3e41e49a7b95..03e47d841a2f 100644 --- a/ghc/rts/Itimer.h +++ b/ghc/rts/Itimer.h @@ -1,22 +1,18 @@ /* ----------------------------------------------------------------------------- - * $Id: Itimer.h,v 1.10 2001/11/27 01:51:23 sof Exp $ + * $Id: Itimer.h,v 1.11 2003/02/22 04:51:51 sof Exp $ * * (c) The GHC Team 1998-2001 * * Interval timer for profiling and pre-emptive scheduling. * * ---------------------------------------------------------------------------*/ +#ifndef __ITIMER_H__ +#define __ITIMER_H__ -# define TICK_FREQUENCY 50 /* ticks per second */ -# define TICK_MILLISECS (1000/TICK_FREQUENCY) /* ms per tick */ +extern int startTicker( nat ms ); +extern int stopTicker ( void ); -/* Context switch timing constants. Context switches happen after a - * whole number of ticks, the default being every tick. - */ -#define CS_MIN_MILLISECS TICK_MILLISECS /* milliseconds per slice */ - -int startVirtTimer( nat ms ); -int stopVirtTimer ( void ); -void block_vtalrm_signal ( void ); -void unblock_vtalrm_signal ( void ); -unsigned int getourtimeofday ( void ); +extern void block_vtalrm_signal ( void ); +extern void unblock_vtalrm_signal ( void ); +extern unsigned int getourtimeofday ( void ); +#endif /* __ITIMER_H__ */ diff --git a/ghc/rts/LdvProfile.c b/ghc/rts/LdvProfile.c index e325374d1740..31777e5557bd 100644 --- a/ghc/rts/LdvProfile.c +++ b/ghc/rts/LdvProfile.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: LdvProfile.c,v 1.4 2003/01/30 10:06:35 simonmar Exp $ + * $Id: LdvProfile.c,v 1.5 2003/02/22 04:51:51 sof Exp $ * * (c) The GHC Team, 2001 * Author: Sungwoo Park @@ -14,8 +14,6 @@ #include "Rts.h" #include "LdvProfile.h" #include "RtsFlags.h" -#include "Itimer.h" -#include "Proftimer.h" #include "Profiling.h" #include "Stats.h" #include "Storage.h" diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc index 00e35e2ecad3..e5d286d66e57 100644 --- a/ghc/rts/PrimOps.hc +++ b/ghc/rts/PrimOps.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.hc,v 1.104 2003/02/21 05:34:15 sof Exp $ + * $Id: PrimOps.hc,v 1.105 2003/02/22 04:51:51 sof Exp $ * * (c) The GHC Team, 1998-2002 * @@ -19,8 +19,11 @@ #include "BlockAlloc.h" /* tmp */ #include "StablePriv.h" #include "StgRun.h" -#include "Itimer.h" +#include "Timer.h" /* TICK_MILLISECS */ #include "Prelude.h" +#ifndef mingw32_TARGET_OS +#include "Itimer.h" /* getourtimeofday() */ +#endif #ifdef HAVE_SYS_TYPES_H # include @@ -1602,15 +1605,29 @@ FN_(waitWritezh_fast) FN_(delayzh_fast) { +#ifdef mingw32_TARGET_OS + StgAsyncIOResult* ares; + unsigned int reqID; +#else StgTSO *t, *prev; nat target; +#endif FB_ /* args: R1.i */ ASSERT(CurrentTSO->why_blocked == NotBlocked); CurrentTSO->why_blocked = BlockedOnDelay; ACQUIRE_LOCK(&sched_mutex); - +#ifdef mingw32_TARGET_OS + /* could probably allocate this on the heap instead */ + ares = (StgAsyncIOResult*)RET_STGCALL2(P_,stgMallocBytes,sizeof(StgAsyncIOResult), "asyncWritezh_fast"); + reqID = RET_STGCALL1(W_,addDelayRequest,R1.i); + ares->reqID = reqID; + ares->len = 0; + ares->errCode = 0; + CurrentTSO->block_info.async_result = ares; + APPEND_TO_BLOCKED_QUEUE(CurrentTSO); +#else target = (R1.i / (TICK_MILLISECS*1000)) + getourtimeofday(); CurrentTSO->block_info.target = target; @@ -1628,7 +1645,7 @@ FN_(delayzh_fast) } else { prev->link = CurrentTSO; } - +#endif RELEASE_LOCK(&sched_mutex); JMP_(stg_block_noregs); FE_ diff --git a/ghc/rts/Profiling.c b/ghc/rts/Profiling.c index b9136ee78bc6..c5baff0107d2 100644 --- a/ghc/rts/Profiling.c +++ b/ghc/rts/Profiling.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Profiling.c,v 1.35 2002/12/19 18:02:13 panne Exp $ + * $Id: Profiling.c,v 1.36 2003/02/22 04:51:52 sof Exp $ * * (c) The GHC Team, 1998-2000 * @@ -16,7 +16,7 @@ #include "Profiling.h" #include "Storage.h" #include "Proftimer.h" -#include "Itimer.h" +#include "Timer.h" #include "ProfHeap.h" #include "Arena.h" #include "RetainerProfile.h" diff --git a/ghc/rts/Proftimer.c b/ghc/rts/Proftimer.c index 41863c48d261..dc36df9d71cb 100644 --- a/ghc/rts/Proftimer.c +++ b/ghc/rts/Proftimer.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Proftimer.c,v 1.11 2002/12/11 15:36:47 simonmar Exp $ + * $Id: Proftimer.c,v 1.12 2003/02/22 04:51:52 sof Exp $ * * (c) The GHC Team, 1998-1999 * @@ -15,7 +15,7 @@ #include "Rts.h" #include "Profiling.h" -#include "Itimer.h" +#include "Timer.h" #include "Proftimer.h" #include "RtsFlags.h" diff --git a/ghc/rts/RetainerProfile.c b/ghc/rts/RetainerProfile.c index de3ae0938707..916ce9090db2 100644 --- a/ghc/rts/RetainerProfile.c +++ b/ghc/rts/RetainerProfile.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: RetainerProfile.c,v 1.6 2002/12/11 15:36:47 simonmar Exp $ + * $Id: RetainerProfile.c,v 1.7 2003/02/22 04:51:52 sof Exp $ * * (c) The GHC Team, 2001 * Author: Sungwoo Park @@ -27,8 +27,6 @@ #include "Profiling.h" #include "Stats.h" #include "BlockAlloc.h" -#include "Itimer.h" -#include "Proftimer.h" #include "ProfHeap.h" #include "Apply.h" diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c index 789d73de8c7e..ebd55b69d005 100644 --- a/ghc/rts/RtsFlags.c +++ b/ghc/rts/RtsFlags.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsFlags.c,v 1.65 2003/01/28 16:23:53 simonmar Exp $ + * $Id: RtsFlags.c,v 1.66 2003/02/22 04:51:53 sof Exp $ * * (c) The AQUA Project, Glasgow University, 1994-1997 * (c) The GHC Team, 1998-1999 @@ -26,13 +26,9 @@ #include "RtsFlags.h" #include "RtsUtils.h" #include "BlockAlloc.h" -#include "Itimer.h" /* CS_MIN_MILLISECS */ +#include "Timer.h" /* CS_MIN_MILLISECS */ #include "Profiling.h" -#if defined(PROFILING) -#include "Itimer.h" -#endif - #ifdef HAVE_CTYPE_H #include #endif diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c index 418ed6eda97c..4971bedbac82 100644 --- a/ghc/rts/RtsStartup.c +++ b/ghc/rts/RtsStartup.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsStartup.c,v 1.71 2003/02/21 05:34:15 sof Exp $ + * $Id: RtsStartup.c,v 1.72 2003/02/22 04:51:53 sof Exp $ * * (c) The GHC Team, 1998-2002 * @@ -17,7 +17,7 @@ #include "Schedule.h" /* initScheduler */ #include "Stats.h" /* initStats */ #include "Signals.h" -#include "Itimer.h" +#include "Timer.h" /* startTimer, stopTimer */ #include "Weak.h" #include "Ticky.h" #include "StgRun.h" @@ -145,7 +145,7 @@ hs_init(int *argc, char **argv[]) #endif /* start the virtual timer 'subsystem'. */ - startVirtTimer(TICK_MILLISECS); + startTimer(TICK_MILLISECS); /* Initialise the stats department */ initStats(); @@ -304,7 +304,7 @@ hs_exit(void) #endif /* stop the ticker */ - stopVirtTimer(); + stopTimer(); /* reset the standard file descriptors to blocking mode */ resetNonBlockingFd(0); diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c index 497a0c6b40aa..09fb05b8c6a9 100644 --- a/ghc/rts/Schedule.c +++ b/ghc/rts/Schedule.c @@ -1,5 +1,5 @@ /* --------------------------------------------------------------------------- - * $Id: Schedule.c,v 1.161 2003/01/25 15:54:49 wolfgang Exp $ + * $Id: Schedule.c,v 1.162 2003/02/22 04:51:53 sof Exp $ * * (c) The GHC Team, 1998-2000 * @@ -95,7 +95,7 @@ #include "Signals.h" #include "Sanity.h" #include "Stats.h" -#include "Itimer.h" +#include "Timer.h" #include "Prelude.h" #include "ThreadLabels.h" #ifdef PROFILING diff --git a/ghc/rts/Select.c b/ghc/rts/Select.c index 5f43ec0874f0..e698d8ee36f8 100644 --- a/ghc/rts/Select.c +++ b/ghc/rts/Select.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Select.c,v 1.24 2003/02/21 05:34:16 sof Exp $ + * $Id: Select.c,v 1.25 2003/02/22 04:51:57 sof Exp $ * * (c) The GHC Team 1995-2002 * @@ -7,14 +7,18 @@ * * ---------------------------------------------------------------------------*/ + /* we're outside the realms of POSIX here... */ /* #include "PosixSource.h" */ #include "Rts.h" +#ifndef mingw32_TARGET_OS +/* to the end */ + #include "Schedule.h" #include "RtsUtils.h" #include "RtsFlags.h" -#include "Itimer.h" +#include "Timer.h" #include "Signals.h" #include "Capability.h" @@ -26,11 +30,6 @@ # include # endif -# ifdef mingw32_TARGET_OS -# include -# include "win32/AsyncIO.h" -# endif - #include #include @@ -40,11 +39,9 @@ nat timestamp = 0; #ifdef RTS_SUPPORTS_THREADS static rtsBool isWorkerBlockedInAwaitEvent = rtsFalse; static rtsBool workerWakeupPending = rtsFalse; -#ifndef mingw32_TARGET_OS static int workerWakeupPipe[2]; static rtsBool workerWakeupInited = rtsFalse; #endif -#endif /* 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 @@ -95,10 +92,8 @@ 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; struct timeval tv; @@ -136,7 +131,6 @@ awaitEvent(rtsBool wait) min = 0x7ffffff; } -#ifndef mingw32_TARGET_OS /* * Collect all of the fd's that we're interested in */ @@ -230,22 +224,11 @@ awaitEvent(rtsBool wait) barf("select failed"); } } -#else /* on mingwin */ -#ifdef RTS_SUPPORTS_THREADS - isWorkerBlockedInAwaitEvent = rtsTrue; -#endif - RELEASE_LOCK(&sched_mutex); - while (1) { - if (!awaitRequests(wait)) { - Sleep(0); /* don't busy wait */ - } -#endif /* mingw32_TARGET_OS */ ACQUIRE_LOCK(&sched_mutex); #ifdef RTS_SUPPORTS_THREADS isWorkerBlockedInAwaitEvent = rtsFalse; #endif -#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 @@ -257,7 +240,6 @@ awaitEvent(rtsBool wait) ACQUIRE_LOCK(&sched_mutex); return; /* still hold the lock */ } -#endif /* we were interrupted, return to the scheduler immediately. */ @@ -334,7 +316,7 @@ awaitEvent(rtsBool wait) } } -#if defined(RTS_SUPPORTS_THREADS) && !defined(mingw32_TARGET_OS) +#if defined(RTS_SUPPORTS_THREADS) // if we were woken up by wakeBlockedWorkerThread, // read the dummy byte from the pipe if(select_succeeded && FD_ISSET(workerWakeupPipe[0], &rfd)) { @@ -354,11 +336,9 @@ awaitEvent(rtsBool wait) * wake it. * Must be called with sched_mutex held. */ - void wakeBlockedWorkerThread() { -#ifndef mingw32_TARGET_OS if(isWorkerBlockedInAwaitEvent && !workerWakeupPending) { unsigned char dummy = 42; // Any value will do here @@ -366,10 +346,7 @@ wakeBlockedWorkerThread() write(workerWakeupPipe[1],&dummy,1); workerWakeupPending = rtsTrue; } -#else - // The Win32 implementation currently uses a polling loop, - // so there is no need to explicitly wake it -#endif } - #endif + +#endif /* !mingw_TARGET_OS */ diff --git a/ghc/rts/Timer.c b/ghc/rts/Timer.c new file mode 100644 index 000000000000..1f9db85aad13 --- /dev/null +++ b/ghc/rts/Timer.c @@ -0,0 +1,67 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2003 + * + * Interval timer service for profiling and pre-emptive scheduling. + * + * ---------------------------------------------------------------------------*/ + +/* + * The interval timer is used for profiling and for context switching in the + * threaded build. + * + * This file defines the platform-independent view of interval timing, relying + * on platform-specific services to install and run the timers. + * + */ +#include "Rts.h" +#include "RtsFlags.h" +#include "Proftimer.h" +#include "Schedule.h" +#include "Timer.h" + +#ifndef mingw32_TARGET_OS +#include "Itimer.h" +#else +#include "win32/Ticker.h" +#endif + +/* ticks left before next pre-emptive context switch */ +static int ticks_to_ctxt_switch = 0; + +/* + * Function: handle_tick() + * + * At each occurrence of a tick, the OS timer will invoke + * handle_tick(). + */ +void +handle_tick(int unused STG_UNUSED) +{ +#ifdef PROFILING + handleProfTick(); +#endif + if (RtsFlags.ConcFlags.ctxtSwitchTicks > 0) { + ticks_to_ctxt_switch--; + if (ticks_to_ctxt_switch <= 0) { + ticks_to_ctxt_switch = RtsFlags.ConcFlags.ctxtSwitchTicks; + context_switch = 1; /* schedule a context switch */ + } + } +} + +int +startTimer(nat ms) +{ +#ifdef PROFILING + initProfTimer(); +#endif + + return startTicker(ms); +} + +int +stopTimer() +{ + return stopTicker(); +} diff --git a/ghc/rts/Timer.h b/ghc/rts/Timer.h new file mode 100644 index 000000000000..e13570fa117e --- /dev/null +++ b/ghc/rts/Timer.h @@ -0,0 +1,22 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2003 + * + * Interval timer service for profiling and pre-emptive scheduling. + * + * ---------------------------------------------------------------------------*/ +#ifndef __TIMER_H__ +#define __TIMER_H__ + +# define TICK_FREQUENCY 50 /* ticks per second */ +# define TICK_MILLISECS (1000/TICK_FREQUENCY) /* ms per tick */ + +/* Context switch timing constants. Context switches happen after a + * whole number of ticks, the default being every tick. + */ +#define CS_MIN_MILLISECS TICK_MILLISECS /* milliseconds per slice */ + +extern void handle_tick(int unused); +extern int startTimer(nat ms); +extern int stopTimer(void); +#endif /* __TIMER_H__ */ diff --git a/ghc/rts/rts.conf.in b/ghc/rts/rts.conf.in index 13a84a3bf63b..298fbc286b73 100644 --- a/ghc/rts/rts.conf.in +++ b/ghc/rts/rts.conf.in @@ -30,7 +30,6 @@ Package { #endif #endif #ifdef mingw32_TARGET_OS - ,"winmm" /* for the threadDelay timer */ ,"wsock32" /* for the linker */ #endif #if defined(DEBUG) && defined(HAVE_LIBBFD) diff --git a/ghc/rts/win32/AsyncIO.c b/ghc/rts/win32/AsyncIO.c index 8b15470243f3..b823308b5672 100644 --- a/ghc/rts/win32/AsyncIO.c +++ b/ghc/rts/win32/AsyncIO.c @@ -43,6 +43,8 @@ typedef struct CompletedReq { static CRITICAL_SECTION queue_lock; static HANDLE completed_req_event; +static HANDLE abandon_req_wait; +static HANDLE wait_handles[2]; static CompletedReq completedTable[MAX_REQUESTS]; static int completed_hw; static int issued_reqs; @@ -97,6 +99,18 @@ addIORequest(int fd, return AddIORequest(fd,forWriting,isSock,len,buf,0,onIOComplete); } +unsigned int +addDelayRequest(int msecs) +{ + EnterCriticalSection(&queue_lock); + issued_reqs++; + LeaveCriticalSection(&queue_lock); +#if 0 + fprintf(stderr, "addDelayReq: %d %d %d\n", msecs); fflush(stderr); +#endif + return AddDelayRequest(msecs,0,onIOComplete); +} + int startupAsyncIO() { @@ -104,9 +118,20 @@ startupAsyncIO() return 0; } InitializeCriticalSection(&queue_lock); - completed_req_event = CreateEvent (NULL, TRUE, FALSE, NULL); + /* Create a pair of events: + * + * - completed_req_event -- signals the deposit of request result; manual reset. + * - abandon_req_wait -- external OS thread tells current RTS/Scheduler + * thread to abandon wait for IO request completion. + * Auto reset. + */ + completed_req_event = CreateEvent (NULL, TRUE, FALSE, NULL); + abandon_req_wait = CreateEvent (NULL, FALSE, FALSE, NULL); + wait_handles[0] = completed_req_event; + wait_handles[1] = abandon_req_wait; completed_hw = 0; - return 1; + return ( completed_req_event != INVALID_HANDLE_VALUE && + abandon_req_wait != INVALID_HANDLE_VALUE ); } void @@ -134,7 +159,17 @@ awaitRequests(rtsBool wait) /* empty table, drop lock and wait */ LeaveCriticalSection(&queue_lock); if (wait) { - WaitForSingleObject( completed_req_event, INFINITE ); + DWORD dwRes = WaitForMultipleObjects(2, wait_handles, FALSE, INFINITE); + switch (dwRes) { + case WAIT_OBJECT_0: + break; + case WAIT_OBJECT_0 + 1: + case WAIT_TIMEOUT: + return 0; + default: + fprintf(stderr, "awaitRequests: unexpected wait return code %lu\n", dwRes); fflush(stderr); + return 0; + } } else { return 0; /* cannot happen */ } @@ -148,14 +183,17 @@ awaitRequests(rtsBool wait) prev = NULL; for(tso = blocked_queue_hd ; tso != END_TSO_QUEUE; tso = tso->link) { switch(tso->why_blocked) { + case BlockedOnDelay: case BlockedOnRead: case BlockedOnWrite: if (tso->block_info.async_result->reqID == rID) { /* Found the thread blocked waiting on request; stodgily fill * in its result block. */ - tso->block_info.async_result->len = completedTable[i].len; - tso->block_info.async_result->errCode = completedTable[i].errCode; + if (tso->why_blocked != BlockedOnDelay) { + tso->block_info.async_result->len = completedTable[i].len; + tso->block_info.async_result->errCode = completedTable[i].errCode; + } /* Drop the matched TSO from blocked_queue */ if (prev) { @@ -185,3 +223,13 @@ awaitRequests(rtsBool wait) return 1; } } + +void +abandonRequestWait() +{ + /* the event is auto-reset, but in case there's no thread + * already waiting on the event, we want to return it to + * a non-signalled state. + */ + PulseEvent(abandon_req_wait); +} diff --git a/ghc/rts/win32/AsyncIO.h b/ghc/rts/win32/AsyncIO.h index 831f7921f5ba..d30d55d9dc16 100644 --- a/ghc/rts/win32/AsyncIO.h +++ b/ghc/rts/win32/AsyncIO.h @@ -12,10 +12,12 @@ addIORequest(int fd, int isSock, int len, char* buf); - +extern unsigned int addDelayRequest(int msecs); extern int startupAsyncIO(void); extern void shutdownAsyncIO(void); extern int awaitRequests(rtsBool wait); +extern void abandonRequestWait(void); + #endif /* __ASYNCHIO_H__ */ diff --git a/ghc/rts/win32/AwaitEvent.c b/ghc/rts/win32/AwaitEvent.c new file mode 100644 index 000000000000..e6a551d7ae2e --- /dev/null +++ b/ghc/rts/win32/AwaitEvent.c @@ -0,0 +1,62 @@ +/* + * Wait/check for external events. Periodically, the + * Scheduler checks for the completion of external operations, + * like the expiration of timers, completion of I/O requests + * issued by Haskell threads. + * + * If the Scheduler is otherwise out of work, it'll block + * herein waiting for external events to occur. + * + * This file mirrors the select()-based functionality + * for POSIX / Unix platforms in rts/Select.c, but for + * Win32. + * + */ +#include "Rts.h" +#include "Schedule.h" +#include +#include "win32/AsyncIO.h" + +void +awaitEvent(rtsBool wait) +{ + RELEASE_LOCK(&sched_mutex); + do { + /* Try to de-queue completed IO requests */ + if (!awaitRequests(wait)) { + return; + } + ACQUIRE_LOCK(&sched_mutex); + /* we were interrupted, return to the scheduler immediately. + */ + if (interrupted) { + return; /* still hold the lock */ + } + + /* If new runnable threads have arrived, stop waiting for + * I/O and run them. + */ + if (run_queue_hd != END_TSO_QUEUE) { + return; /* still hold the lock */ + } + +#ifdef RTS_SUPPORTS_THREADS + /* If another worker thread wants to take over, + * return to the scheduler + */ + if (needToYieldToReturningWorker()) { + return; /* still hold the lock */ + } +#endif + RELEASE_LOCK(&sched_mutex); + } while (wait && !interrupted && run_queue_hd == END_TSO_QUEUE); +} + +#ifdef RTS_SUPPORTS_THREADS +void +wakeBlockedWorkerThread() +{ + abandonRequestWait(); +} +#endif + diff --git a/ghc/rts/win32/IOManager.c b/ghc/rts/win32/IOManager.c index f9d56c613bb4..85bfcb0d6af9 100644 --- a/ghc/rts/win32/IOManager.c +++ b/ghc/rts/win32/IOManager.c @@ -132,7 +132,6 @@ NewIOWorkerThread(IOManagerState* iom) (LPVOID)iom, 0, NULL) ); - //CreateThread( NULL, 0, IOWorkerProc, (LPVOID)iom, 0, NULL)); } BOOL diff --git a/ghc/rts/win32/Ticker.c b/ghc/rts/win32/Ticker.c new file mode 100644 index 000000000000..bfc89c01f13b --- /dev/null +++ b/ghc/rts/win32/Ticker.c @@ -0,0 +1,95 @@ +/* + * RTS periodic timers. + * + */ +#include "Rts.h" +#include "Timer.h" +#include "Ticker.h" +#include +#include +#include + +/* + * Provide a timer service for the RTS, periodically + * notifying it that a number of 'ticks' has passed. + * + */ + +/* To signal shutdown of the timer service, we use a local + * event which the timer thread listens to (and stopVirtTimer() + * signals.) + */ +static HANDLE hStopEvent = INVALID_HANDLE_VALUE; + +/* + * Ticking is done by a separate thread which periodically + * wakes up to handle a tick. + * + * This is the portable way of providing a timer service under + * Win32; features like waitable timers or timer queues are only + * supported by a subset of the Win32 platforms (notably not + * under Win9x.) + * + */ +static +unsigned +WINAPI +TimerProc(PVOID param) +{ + int ms = (int)param; + DWORD waitRes; + + /* interpret a < 0 timeout period as 'instantaneous' */ + if (ms < 0) ms = 0; + + while (1) { + waitRes = WaitForSingleObject(hStopEvent, ms); + + switch (waitRes) { + case WAIT_OBJECT_0: + /* event has become signalled */ + CloseHandle(hStopEvent); + return 0; + case WAIT_TIMEOUT: + /* tick */ + handle_tick(0); + break; + default: + fprintf(stderr, "timer: unexpected result %lu\n", waitRes); fflush(stderr); + break; + } + } + return 0; +} + + +int +startTicker(nat ms) +{ + + /* 'hStopEvent' is a manual-reset event that's signalled upon + * shutdown of timer service (=> timer thread.) + */ + hStopEvent = CreateEvent ( NULL, + TRUE, + FALSE, + NULL); + if (hStopEvent == INVALID_HANDLE_VALUE) { + return 0; + } + return ( 0 != _beginthreadex(NULL, + 0, + TimerProc, + (LPVOID)ms, + 0, + NULL) ); +} + +int +stopTicker(void) +{ + if (hStopEvent != INVALID_HANDLE_VALUE) { + SetEvent(hStopEvent); + } + return 0; +} diff --git a/ghc/rts/win32/Ticker.h b/ghc/rts/win32/Ticker.h new file mode 100644 index 000000000000..669a0a193e81 --- /dev/null +++ b/ghc/rts/win32/Ticker.h @@ -0,0 +1,9 @@ +/* + * RTS periodic timers (win32) + */ +#ifndef __TICKER_H__ +#define __TICKER_H__ +extern int startTicker( nat ms ); +extern int stopTicker ( void ); +#endif /* __TICKER_H__ */ +