ghc/rts/Itimer.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team, 1995-1999
   4  *
   5  * Interval timer for profiling and pre-emptive scheduling.
   6  *
   7  * ---------------------------------------------------------------------------*/
   8
   9 /*
  10  * The interval timer is used for profiling and for context switching in the
  11  * threaded build.  Though POSIX 1003.1b includes a standard interface for
  12  * such things, no one really seems to be implementing them yet.  Even
  13  * Solaris 2.3 only seems to provide support for @CLOCK_REAL@, whereas we're
  14  * keen on getting access to @CLOCK_VIRTUAL@.
  15  *
  16  * Hence, we use the old-fashioned @setitimer@ that just about everyone seems
  17  * to support.  So much for standards.
  18  */
  19 #include "Rts.h"
  20 #include "RtsFlags.h"
  21 #include "Timer.h"
  22 #include "Itimer.h"
  23 #include "Proftimer.h"
  24 #include "Schedule.h"
  25
  26 /* As recommended in the autoconf manual */
  27 # ifdef TIME_WITH_SYS_TIME
  28 #  include <sys/time.h>
  29 #  include <time.h>
  30 # else
  31 #  ifdef HAVE_SYS_TIME_H
  32 #   include <sys/time.h>
  33 #  else
  34 #   include <time.h>
  35 #  endif
  36 # endif
  37
  38 #ifdef HAVE_SIGNAL_H
  39 # include <signal.h>
  40 #endif
  41
  42 /* Major bogosity:
  43  *
  44  * In the threaded RTS, we can't set the virtual timer because the
  45  * thread which has the virtual timer might be sitting waiting for a
  46  * capability, and the virtual timer only ticks in CPU time.
  47  *
  48  * So, possible solutions:
  49  *
  50  * (1) tick in realtime.  Not very good, because this ticker is used for
  51  *     profiling, and this will give us unreliable time profiling
  52  *     results.  Furthermore, this requires picking a single OS thread
  53  *     to be the timekeeper, which is a bad idea because the thread in
  54  *     question might just be making a temporary call into Haskell land.
  55  *
  56  * (2) save/restore the virtual timer around excursions into STG land.
  57  *     Sounds great, but I tried it and the resolution of the virtual timer
  58  *     isn't good enough (on Linux) - most of our excursions fall
  59  *     within the timer's resolution and we never make any progress.
  60  *
  61  * (3) have a virtual timer in every OS thread.  Might be reasonable,
  62  *     because most of the time there is only ever one of these
  63  *     threads running, so it approximates a single virtual timer.
  64  *     But still quite bogus (and I got crashes when I tried this).
  65  *
  66  * For now, we're using (1), but this needs a better solution. --SDM
  67  */
  68 #ifdef RTS_SUPPORTS_THREADS
  69 #define ITIMER_FLAVOUR  ITIMER_REAL
  70 #define ITIMER_SIGNAL   SIGALRM
  71 #else
  72 #define ITIMER_FLAVOUR  ITIMER_VIRTUAL
  73 #define ITIMER_SIGNAL   SIGVTALRM
  74 #endif
  75
  76 static
  77 int
  78 install_vtalrm_handler(TickProc handle_tick)
  79 {
  80     struct sigaction action;
  81
  82     action.sa_handler = handle_tick;
  83
  84     sigemptyset(&action.sa_mask);
  85     action.sa_flags = 0;
  86
  87     return sigaction(ITIMER_SIGNAL, &action, NULL);
  88 }
  89
  90 int
  91 startTicker(nat ms, TickProc handle_tick)
  92 {
  93 # ifndef HAVE_SETITIMER
  94   /*    debugBelch("No virtual timer on this system\n"); */
  95     return -1;
  96 # else
  97     struct itimerval it;
  98
  99     install_vtalrm_handler(handle_tick);
 100
 101     timestamp = getourtimeofday();
 102
 103     it.it_value.tv_sec = ms / 1000;
 104     it.it_value.tv_usec = 1000 * (ms - (1000 * it.it_value.tv_sec));
 105     it.it_interval = it.it_value;
 106     return (setitimer(ITIMER_FLAVOUR, &it, NULL));
 107 # endif
 108 }
 109
 110 int
 111 stopTicker()
 112 {
 113 # ifndef HAVE_SETITIMER
 114   /*    debugBelch("No virtual timer on this system\n"); */
 115     return -1;
 116 # else
 117     struct itimerval it;
 118
 119     it.it_value.tv_sec = 0;
 120     it.it_value.tv_usec = 0;
 121     it.it_interval = it.it_value;
 122     return (setitimer(ITIMER_FLAVOUR, &it, NULL));
 123 # endif
 124 }
 125
 126 # if 0
 127 /* This is a potential POSIX version */
 128 int
 129 startTicker(nat ms)
 130 {
 131     struct sigevent se;
 132     struct itimerspec it;
 133     timer_t tid;
 134
 135     timestamp = getourtimeofday();
 136
 137     se.sigev_notify = SIGEV_SIGNAL;
 138     se.sigev_signo = ITIMER_SIGNAL;
 139     se.sigev_value.sival_int = ITIMER_SIGNAL;
 140     if (timer_create(CLOCK_VIRTUAL, &se, &tid)) {
 141         barf("can't create virtual timer");
 142     }
 143     it.it_value.tv_sec = ms / 1000;
 144     it.it_value.tv_nsec = 1000000 * (ms - 1000 * it.it_value.tv_sec);
 145     it.it_interval = it.it_value;
 146     return timer_settime(tid, TIMER_RELTIME, &it, NULL);
 147 }
 148
 149 int
 150 stopTicker()
 151 {
 152     struct sigevent se;
 153     struct itimerspec it;
 154     timer_t tid;
 155
 156     timestamp = getourtimeofday();
 157
 158     se.sigev_notify = SIGEV_SIGNAL;
 159     se.sigev_signo = ITIMER_SIGNAL;
 160     se.sigev_value.sival_int = ITIMER_SIGNAL;
 161     if (timer_create(CLOCK_VIRTUAL, &se, &tid)) {
 162         barf("can't create virtual timer");
 163     }
 164     it.it_value.tv_sec = 0;
 165     it.it_value.tv_nsec = 0;
 166     it.it_interval = it.it_value;
 167     return timer_settime(tid, TIMER_RELTIME, &it, NULL);
 168 }
 169 # endif
 170
 171 #if 0
 172 /* Currently unused */
 173 void
 174 block_vtalrm_signal(void)
 175 {
 176     sigset_t signals;
 177
 178     sigemptyset(&signals);
 179     sigaddset(&signals, ITIMER_SIGNAL);
 180
 181     (void) sigprocmask(SIG_BLOCK, &signals, NULL);
 182 }
 183
 184 void
 185 unblock_vtalrm_signal(void)
 186 {
 187     sigset_t signals;
 188
 189     sigemptyset(&signals);
 190     sigaddset(&signals, ITIMER_SIGNAL);
 191
 192     (void) sigprocmask(SIG_UNBLOCK, &signals, NULL);
 193 }
 194 #endif
 195
 196 /* gettimeofday() takes around 1us on our 500MHz PIII.  Since we're
 197  * only calling it 50 times/s, it shouldn't have any great impact.
 198  */
 199 nat
 200 getourtimeofday(void)
 201 {
 202   struct timeval tv;
 203   gettimeofday(&tv, (struct timezone *) NULL);
 204         // cast to nat because nat may be 64 bit when int is only 32 bit
 205   return ((nat)tv.tv_sec * TICK_FREQUENCY +
 206           (nat)tv.tv_usec * TICK_FREQUENCY / 1000000);
 207 }
 208