[project @ 2003-02-22 04:51:50 by sof]
authorsof <unknown>
Sat, 22 Feb 2003 04:51:58 +0000 (04:51 +0000)
committersof <unknown>
Sat, 22 Feb 2003 04:51:58 +0000 (04:51 +0000)
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.

20 files changed:
ghc/rts/Itimer.c
ghc/rts/Itimer.h
ghc/rts/LdvProfile.c
ghc/rts/PrimOps.hc
ghc/rts/Profiling.c
ghc/rts/Proftimer.c
ghc/rts/RetainerProfile.c
ghc/rts/RtsFlags.c
ghc/rts/RtsStartup.c
ghc/rts/Schedule.c
ghc/rts/Select.c
ghc/rts/Timer.c [new file with mode: 0644]
ghc/rts/Timer.h [new file with mode: 0644]
ghc/rts/rts.conf.in
ghc/rts/win32/AsyncIO.c
ghc/rts/win32/AsyncIO.h
ghc/rts/win32/AwaitEvent.c [new file with mode: 0644]
ghc/rts/win32/IOManager.c
ghc/rts/win32/Ticker.c [new file with mode: 0644]
ghc/rts/win32/Ticker.h [new file with mode: 0644]

index bbc8738..f1dd823 100644 (file)
@@ -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
  *
  * 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"
 #  endif
 # endif
 
-#if HAVE_WINDOWS_H
-# include <windows.h>
-#endif
 #ifdef HAVE_SIGNAL_H
 # include <signal.h>
 #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 */
index 3e41e49..03e47d8 100644 (file)
@@ -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__ */
index e325374..31777e5 100644 (file)
@@ -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"
index 00e35e2..e5d286d 100644 (file)
@@ -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
  *
 #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 <sys/types.h>
@@ -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_
index b9136ee..c5baff0 100644 (file)
@@ -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"
index 41863c4..dc36df9 100644 (file)
@@ -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"
 
index de3ae09..916ce90 100644 (file)
@@ -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"
 
index 789d73d..ebd55b6 100644 (file)
@@ -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
 #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 <ctype.h>
 #endif
index 418ed6e..4971bed 100644 (file)
@@ -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);
index 497a0c6..09fb05b 100644 (file)
@@ -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
index 5f43ec0..e698d8e 100644 (file)
@@ -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"
 
 #  include <sys/time.h>
 # endif
 
-# ifdef mingw32_TARGET_OS
-#  include <windows.h>
-#  include "win32/AsyncIO.h"
-# endif
-
 #include <errno.h>
 #include <string.h>
 
@@ -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 (file)
index 0000000..1f9db85
--- /dev/null
@@ -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 (file)
index 0000000..e13570f
--- /dev/null
@@ -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__ */
index 13a84a3..298fbc2 100644 (file)
@@ -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)
index 8b15470..b823308 100644 (file)
@@ -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 @@ start:
     /* 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 @@ start:
       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 @@ start:
     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);
+}
index 831f792..d30d55d 100644 (file)
@@ -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 (file)
index 0000000..e6a551d
--- /dev/null
@@ -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 <windows.h>
+#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
+
index f9d56c6..85bfcb0 100644 (file)
@@ -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 (file)
index 0000000..bfc89c0
--- /dev/null
@@ -0,0 +1,95 @@
+/*
+ * RTS periodic timers.
+ * 
+ */
+#include "Rts.h"
+#include "Timer.h"
+#include "Ticker.h"
+#include <windows.h>
+#include <stdio.h>
+#include <process.h>
+
+/*
+ * 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 (file)
index 0000000..669a0a1
--- /dev/null
@@ -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__ */
+