diff options
Diffstat (limited to 'rts/posix')
| -rw-r--r-- | rts/posix/GetTime.c | 141 | ||||
| -rw-r--r-- | rts/posix/Itimer.c | 226 | ||||
| -rw-r--r-- | rts/posix/Itimer.h | 19 | ||||
| -rw-r--r-- | rts/posix/OSThreads.c | 166 | ||||
| -rw-r--r-- | rts/posix/Select.c | 279 | ||||
| -rw-r--r-- | rts/posix/Select.h | 26 | ||||
| -rw-r--r-- | rts/posix/Signals.c | 510 | ||||
| -rw-r--r-- | rts/posix/Signals.h | 26 |
8 files changed, 1393 insertions, 0 deletions
diff --git a/rts/posix/GetTime.c b/rts/posix/GetTime.c new file mode 100644 index 0000000000..3a0764cb91 --- /dev/null +++ b/rts/posix/GetTime.c @@ -0,0 +1,141 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2005 + * + * Machine-dependent time measurement functions + * + * ---------------------------------------------------------------------------*/ + +// Not POSIX, due to use of ru_majflt in getPageFaults() +// #include "PosixSource.h" + +#include "Rts.h" +#include "GetTime.h" + +#ifdef HAVE_TIME_H +# include <time.h> +#endif + +#ifdef HAVE_SYS_TIME_H +# include <sys/time.h> +#endif + +#if HAVE_SYS_RESOURCE_H +# include <sys/resource.h> +#endif + +#ifdef HAVE_UNISTD_H +# include <unistd.h> +#endif + +#ifdef HAVE_SYS_TIMES_H +# include <sys/times.h> +#endif + +#if ! ((defined(HAVE_GETRUSAGE) && !irix_HOST_OS) || defined(HAVE_TIMES)) +#error No implementation for getProcessCPUTime() available. +#endif + +#if defined(HAVE_GETTIMEOFDAY) && defined(HAVE_GETRUSAGE) && !irix_HOST_OS +// we'll implement getProcessCPUTime() and getProcessElapsedTime() +// separately, using getrusage() and gettimeofday() respectively + +Ticks getProcessCPUTime(void) +{ + struct rusage t; + getrusage(RUSAGE_SELF, &t); + return (t.ru_utime.tv_sec * TICKS_PER_SECOND + + ((Ticks)t.ru_utime.tv_usec * TICKS_PER_SECOND)/1000000); +} + +Ticks getProcessElapsedTime(void) +{ + struct timeval tv; + gettimeofday(&tv, (struct timezone *) NULL); + return (tv.tv_sec * TICKS_PER_SECOND + + ((Ticks)tv.tv_usec * TICKS_PER_SECOND)/1000000); +} + +void getProcessTimes(Ticks *user, Ticks *elapsed) +{ + *user = getProcessCPUTime(); + *elapsed = getProcessElapsedTime(); +} + +#elif defined(HAVE_TIMES) + +// we'll use the old times() API. + +Ticks getProcessCPUTime(void) +{ + Ticks user, elapsed; + getProcessTimes(&user,&elapsed); + return user; +} + +Ticks getProcessElapsedTime(void) +{ + Ticks user, elapsed; + getProcessTimes(&user,&elapsed); + return elapsed; +} + +void getProcessTimes(Ticks *user, Ticks *elapsed) +{ + static nat ClockFreq = 0; + + if (ClockFreq == 0) { +#if defined(HAVE_SYSCONF) + long ticks; + ticks = sysconf(_SC_CLK_TCK); + if ( ticks == -1 ) { + errorBelch("sysconf\n"); + stg_exit(EXIT_FAILURE); + } + ClockFreq = ticks; +#elif defined(CLK_TCK) /* defined by POSIX */ + ClockFreq = CLK_TCK; +#elif defined(HZ) + ClockFreq = HZ; +#elif defined(CLOCKS_PER_SEC) + ClockFreq = CLOCKS_PER_SEC; +#else + errorBelch("can't get clock resolution"); + stg_exit(EXIT_FAILURE); +#endif + } + + struct tms t; + clock_t r = times(&t); + *user = (((Ticks)t.tms_utime * TICKS_PER_SECOND) / ClockFreq); + *elapsed = (((Ticks)r * TICKS_PER_SECOND) / ClockFreq); +} + +#endif // HAVE_TIMES + +Ticks getThreadCPUTime(void) +{ +#if defined(HAVE_CLOCK_GETTIME) && defined(CLOCK_THREAD_CPUTIME_ID) + // clock_gettime() gives us per-thread CPU time. It isn't + // reliable on Linux, but it's the best we have. + struct timespec ts; + clock_gettime(CLOCK_THREAD_CPUTIME_ID, &ts); + return (ts.tv_sec * TICKS_PER_SECOND + + ((Ticks)ts.tv_nsec * TICKS_PER_SECOND) / 1000000000); +#else + return getProcessCPUTime(); +#endif +} + +nat +getPageFaults(void) +{ +#if !defined(HAVE_GETRUSAGE) || irix_HOST_OS + return 0; +#else + struct rusage t; + getrusage(RUSAGE_SELF, &t); + return(t.ru_majflt); +#endif +} + diff --git a/rts/posix/Itimer.c b/rts/posix/Itimer.c new file mode 100644 index 0000000000..83ed84d6ef --- /dev/null +++ b/rts/posix/Itimer.c @@ -0,0 +1,226 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-1999 + * + * Interval timer for profiling and pre-emptive scheduling. + * + * ---------------------------------------------------------------------------*/ + +/* + * The interval timer is used for profiling and for context switching in the + * threaded build. Though POSIX 1003.1b includes a standard interface for + * such things, no one really seems to be implementing them yet. Even + * Solaris 2.3 only seems to provide support for @CLOCK_REAL@, whereas we're + * keen on getting access to @CLOCK_VIRTUAL@. + * + * Hence, we use the old-fashioned @setitimer@ that just about everyone seems + * to support. So much for standards. + */ +#include "Rts.h" +#include "RtsFlags.h" +#include "Timer.h" +#include "Ticker.h" +#include "posix/Itimer.h" +#include "Proftimer.h" +#include "Schedule.h" +#include "posix/Select.h" + +/* As recommended in the autoconf manual */ +# ifdef TIME_WITH_SYS_TIME +# include <sys/time.h> +# include <time.h> +# else +# ifdef HAVE_SYS_TIME_H +# include <sys/time.h> +# else +# include <time.h> +# endif +# endif + +#ifdef HAVE_SIGNAL_H +# include <signal.h> +#endif + +/* Major bogosity: + * + * In the threaded RTS, we can't set the virtual timer because the + * thread which has the virtual timer might be sitting waiting for a + * capability, and the virtual timer only ticks in CPU time. + * + * So, possible solutions: + * + * (1) tick in realtime. Not very good, because this ticker is used for + * profiling, and this will give us unreliable time profiling + * results. Furthermore, this requires picking a single OS thread + * to be the timekeeper, which is a bad idea because the thread in + * question might just be making a temporary call into Haskell land. + * + * (2) save/restore the virtual timer around excursions into STG land. + * Sounds great, but I tried it and the resolution of the virtual timer + * isn't good enough (on Linux) - most of our excursions fall + * within the timer's resolution and we never make any progress. + * + * (3) have a virtual timer in every OS thread. Might be reasonable, + * because most of the time there is only ever one of these + * threads running, so it approximates a single virtual timer. + * But still quite bogus (and I got crashes when I tried this). + * + * For now, we're using (1), but this needs a better solution. --SDM + */ +#ifdef THREADED_RTS +#define ITIMER_FLAVOUR ITIMER_REAL +#define ITIMER_SIGNAL SIGALRM +#else +#define ITIMER_FLAVOUR ITIMER_VIRTUAL +#define ITIMER_SIGNAL SIGVTALRM +#endif + +static +int +install_vtalrm_handler(TickProc handle_tick) +{ + struct sigaction action; + + action.sa_handler = handle_tick; + + sigemptyset(&action.sa_mask); + +#ifdef SA_RESTART + // specify SA_RESTART. One consequence if we don't do this is + // that readline gets confused by the -threaded RTS. It seems + // that if a SIGALRM handler is installed without SA_RESTART, + // readline installs its own SIGALRM signal handler (see + // readline's signals.c), and this somehow causes readline to go + // wrong when the input exceeds a single line (try it). + action.sa_flags = SA_RESTART; +#else + action.sa_flags = 0; +#endif + + return sigaction(ITIMER_SIGNAL, &action, NULL); +} + +int +startTicker(nat ms, TickProc handle_tick) +{ +# ifndef HAVE_SETITIMER + /* debugBelch("No virtual timer on this system\n"); */ + return -1; +# else + struct itimerval it; + + install_vtalrm_handler(handle_tick); + +#if !defined(THREADED_RTS) + timestamp = getourtimeofday(); +#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; + return (setitimer(ITIMER_FLAVOUR, &it, NULL)); +# endif +} + +int +stopTicker() +{ +# ifndef HAVE_SETITIMER + /* debugBelch("No virtual timer on this system\n"); */ + return -1; +# else + struct itimerval it; + + it.it_value.tv_sec = 0; + it.it_value.tv_usec = 0; + it.it_interval = it.it_value; + return (setitimer(ITIMER_FLAVOUR, &it, NULL)); +# endif +} + +# if 0 +/* This is a potential POSIX version */ +int +startTicker(nat ms) +{ + struct sigevent se; + struct itimerspec it; + timer_t tid; + +#if !defined(THREADED_RTS) + timestamp = getourtimeofday(); +#endif + + se.sigev_notify = SIGEV_SIGNAL; + se.sigev_signo = ITIMER_SIGNAL; + se.sigev_value.sival_int = ITIMER_SIGNAL; + if (timer_create(CLOCK_VIRTUAL, &se, &tid)) { + barf("can't create virtual timer"); + } + it.it_value.tv_sec = ms / 1000; + it.it_value.tv_nsec = 1000000 * (ms - 1000 * it.it_value.tv_sec); + it.it_interval = it.it_value; + return timer_settime(tid, TIMER_RELTIME, &it, NULL); +} + +int +stopTicker() +{ + struct sigevent se; + struct itimerspec it; + timer_t tid; + +#if !defined(THREADED_RTS) + timestamp = getourtimeofday(); +#endif + + se.sigev_notify = SIGEV_SIGNAL; + se.sigev_signo = ITIMER_SIGNAL; + se.sigev_value.sival_int = ITIMER_SIGNAL; + if (timer_create(CLOCK_VIRTUAL, &se, &tid)) { + barf("can't create virtual timer"); + } + it.it_value.tv_sec = 0; + it.it_value.tv_nsec = 0; + it.it_interval = it.it_value; + return timer_settime(tid, TIMER_RELTIME, &it, NULL); +} +# endif + +#if 0 +/* Currently unused */ +void +block_vtalrm_signal(void) +{ + sigset_t signals; + + sigemptyset(&signals); + sigaddset(&signals, ITIMER_SIGNAL); + + (void) sigprocmask(SIG_BLOCK, &signals, NULL); +} + +void +unblock_vtalrm_signal(void) +{ + sigset_t signals; + + sigemptyset(&signals); + sigaddset(&signals, ITIMER_SIGNAL); + + (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. + */ +lnat +getourtimeofday(void) +{ + struct timeval tv; + gettimeofday(&tv, (struct timezone *) NULL); + // cast to lnat because nat may be 64 bit when int is only 32 bit + return ((lnat)tv.tv_sec * TICK_FREQUENCY + + (lnat)tv.tv_usec * TICK_FREQUENCY / 1000000); +} diff --git a/rts/posix/Itimer.h b/rts/posix/Itimer.h new file mode 100644 index 0000000000..09d01bde54 --- /dev/null +++ b/rts/posix/Itimer.h @@ -0,0 +1,19 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 1998-2005 + * + * Interval timer for profiling and pre-emptive scheduling. + * + * ---------------------------------------------------------------------------*/ + +#ifndef ITIMER_H +#define ITIMER_H + +extern lnat getourtimeofday ( void ); +#if 0 +/* unused */ +extern void block_vtalrm_signal ( void ); +extern void unblock_vtalrm_signal ( void ); +#endif + +#endif /* ITIMER_H */ diff --git a/rts/posix/OSThreads.c b/rts/posix/OSThreads.c new file mode 100644 index 0000000000..07bd762130 --- /dev/null +++ b/rts/posix/OSThreads.c @@ -0,0 +1,166 @@ +/* --------------------------------------------------------------------------- + * + * (c) The GHC Team, 2001-2005 + * + * Accessing OS threads functionality in a (mostly) OS-independent + * manner. + * + * --------------------------------------------------------------------------*/ + +#if defined(DEBUG) && defined(__linux__) +/* We want GNU extensions in DEBUG mode for mutex error checking */ +#define _GNU_SOURCE +#endif + +#include "Rts.h" +#if defined(THREADED_RTS) +#include "OSThreads.h" +#include "RtsUtils.h" + +#if HAVE_STRING_H +#include <string.h> +#endif + +#if !defined(HAVE_PTHREAD_H) +#error pthreads.h is required for the threaded RTS on Posix platforms +#endif + +/* + * This (allegedly) OS threads independent layer was initially + * abstracted away from code that used Pthreads, so the functions + * provided here are mostly just wrappers to the Pthreads API. + * + */ + +void +initCondition( Condition* pCond ) +{ + pthread_cond_init(pCond, NULL); + return; +} + +void +closeCondition( Condition* pCond ) +{ + pthread_cond_destroy(pCond); + return; +} + +rtsBool +broadcastCondition ( Condition* pCond ) +{ + return (pthread_cond_broadcast(pCond) == 0); +} + +rtsBool +signalCondition ( Condition* pCond ) +{ + return (pthread_cond_signal(pCond) == 0); +} + +rtsBool +waitCondition ( Condition* pCond, Mutex* pMut ) +{ + return (pthread_cond_wait(pCond,pMut) == 0); +} + +void +yieldThread() +{ + sched_yield(); + return; +} + +void +shutdownThread() +{ + pthread_exit(NULL); +} + +int +createOSThread (OSThreadId* pId, OSThreadProc *startProc, void *param) +{ + int result = pthread_create(pId, NULL, (void *(*)(void *))startProc, param); + if(!result) + pthread_detach(*pId); + return result; +} + +OSThreadId +osThreadId() +{ + return pthread_self(); +} + +void +initMutex(Mutex* pMut) +{ +#if defined(DEBUG) && defined(linux_HOST_OS) + pthread_mutexattr_t attr; + pthread_mutexattr_init(&attr); + pthread_mutexattr_settype(&attr,PTHREAD_MUTEX_ERRORCHECK_NP); + pthread_mutex_init(pMut,&attr); +#else + pthread_mutex_init(pMut,NULL); +#endif + return; +} + +void +newThreadLocalKey (ThreadLocalKey *key) +{ + int r; + if ((r = pthread_key_create(key, NULL)) != 0) { + barf("newThreadLocalKey: %s", strerror(r)); + } +} + +void * +getThreadLocalVar (ThreadLocalKey *key) +{ + return pthread_getspecific(*key); + // Note: a return value of NULL can indicate that either the key + // is not valid, or the key is valid and the data value has not + // yet been set. We need to use the latter case, so we cannot + // detect errors here. +} + +void +setThreadLocalVar (ThreadLocalKey *key, void *value) +{ + int r; + if ((r = pthread_setspecific(*key,value)) != 0) { + barf("setThreadLocalVar: %s", strerror(r)); + } +} + +static void * +forkOS_createThreadWrapper ( void * entry ) +{ + Capability *cap; + cap = rts_lock(); + cap = rts_evalStableIO(cap, (HsStablePtr) entry, NULL); + rts_unlock(cap); + return NULL; +} + +int +forkOS_createThread ( HsStablePtr entry ) +{ + pthread_t tid; + int result = pthread_create(&tid, NULL, + forkOS_createThreadWrapper, (void*)entry); + if(!result) + pthread_detach(tid); + return result; +} + +#else /* !defined(THREADED_RTS) */ + +int +forkOS_createThread ( HsStablePtr entry STG_UNUSED ) +{ + return -1; +} + +#endif /* !defined(THREADED_RTS) */ diff --git a/rts/posix/Select.c b/rts/posix/Select.c new file mode 100644 index 0000000000..e21ced03ab --- /dev/null +++ b/rts/posix/Select.c @@ -0,0 +1,279 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 1995-2002 + * + * Support for concurrent non-blocking I/O and thread waiting. + * + * ---------------------------------------------------------------------------*/ + +/* we're outside the realms of POSIX here... */ +/* #include "PosixSource.h" */ + +#include "Rts.h" +#include "Schedule.h" +#include "RtsUtils.h" +#include "RtsFlags.h" +#include "Timer.h" +#include "Itimer.h" +#include "Signals.h" +#include "Capability.h" +#include "posix/Select.h" + +# ifdef HAVE_SYS_TYPES_H +# include <sys/types.h> +# endif + +# ifdef HAVE_SYS_TIME_H +# include <sys/time.h> +# endif + +#include <errno.h> +#include <string.h> + +#ifdef HAVE_UNISTD_H +#include <unistd.h> +#endif + +#if !defined(THREADED_RTS) +/* last timestamp */ +lnat timestamp = 0; + +/* + * 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 + * (it's actually 31 bits of microseconds), we can safely check + * whether a timer has expired even if our timer will wrap around + * before the target is reached, using the following formula: + * + * (int)((uint)current_time - (uint)target_time) < 0 + * + * if this is true, then our time has expired. + * (idea due to Andy Gill). + */ +static rtsBool +wakeUpSleepingThreads(lnat ticks) +{ + StgTSO *tso; + rtsBool flag = rtsFalse; + + while (sleeping_queue != END_TSO_QUEUE && + (int)(ticks - sleeping_queue->block_info.target) > 0) { + tso = sleeping_queue; + sleeping_queue = tso->link; + tso->why_blocked = NotBlocked; + tso->link = END_TSO_QUEUE; + IF_DEBUG(scheduler,debugBelch("Waking up sleeping thread %d\n", tso->id)); + // MainCapability: this code is !THREADED_RTS + pushOnRunQueue(&MainCapability,tso); + flag = rtsTrue; + } + return flag; +} + +/* Argument 'wait' says whether to wait for I/O to become available, + * or whether to just check and return immediately. If there are + * other threads ready to run, we normally do the non-waiting variety, + * otherwise we wait (see Schedule.c). + * + * SMP note: must be called with sched_mutex locked. + * + * Windows: select only works on sockets, so this doesn't really work, + * though it makes things better than before. MsgWaitForMultipleObjects + * should really be used, though it only seems to work for read handles, + * not write handles. + * + */ +void +awaitEvent(rtsBool wait) +{ + StgTSO *tso, *prev, *next; + rtsBool ready; + fd_set rfd,wfd; + int numFound; + int maxfd = -1; + rtsBool select_succeeded = rtsTrue; + rtsBool unblock_all = rtsFalse; + struct timeval tv; + lnat min, ticks; + + tv.tv_sec = 0; + tv.tv_usec = 0; + + IF_DEBUG(scheduler, + debugBelch("scheduler: checking for threads blocked on I/O"); + if (wait) { + debugBelch(" (waiting)"); + } + debugBelch("\n"); + ); + + /* loop until we've woken up some threads. This loop is needed + * because the select timing isn't accurate, we sometimes sleep + * for a while but not long enough to wake up a thread in + * a threadDelay. + */ + do { + + ticks = timestamp = getourtimeofday(); + if (wakeUpSleepingThreads(ticks)) { + return; + } + + if (!wait) { + min = 0; + } else if (sleeping_queue != END_TSO_QUEUE) { + min = (sleeping_queue->block_info.target - ticks) + * TICK_MILLISECS * 1000; + } else { + min = 0x7ffffff; + } + + /* + * Collect all of the fd's that we're interested in + */ + FD_ZERO(&rfd); + FD_ZERO(&wfd); + + for(tso = blocked_queue_hd; tso != END_TSO_QUEUE; tso = next) { + next = tso->link; + + switch (tso->why_blocked) { + case BlockedOnRead: + { + int fd = tso->block_info.fd; + if (fd >= FD_SETSIZE) { + barf("awaitEvent: descriptor out of range"); + } + maxfd = (fd > maxfd) ? fd : maxfd; + FD_SET(fd, &rfd); + continue; + } + + case BlockedOnWrite: + { + int fd = tso->block_info.fd; + if (fd >= FD_SETSIZE) { + barf("awaitEvent: descriptor out of range"); + } + maxfd = (fd > maxfd) ? fd : maxfd; + FD_SET(fd, &wfd); + continue; + } + + default: + barf("AwaitEvent"); + } + } + + /* Check for any interesting events */ + + tv.tv_sec = min / 1000000; + tv.tv_usec = min % 1000000; + + while ((numFound = select(maxfd+1, &rfd, &wfd, NULL, &tv)) < 0) { + if (errno != EINTR) { + /* Handle bad file descriptors by unblocking all the + waiting threads. Why? Because a thread might have been + a bit naughty and closed a file descriptor while another + was blocked waiting. This is less-than-good programming + practice, but having the RTS as a result fall over isn't + acceptable, so we simply unblock all the waiting threads + should we see a bad file descriptor & give the threads + a chance to clean up their act. + + 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 ) { + unblock_all = rtsTrue; + break; + } else { + perror("select"); + barf("select failed"); + } + } + + /* 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()) { + startSignalHandlers(&MainCapability); + return; /* still hold the lock */ + } +#endif + + /* we were interrupted, return to the scheduler immediately. + */ + if (sched_state >= SCHED_INTERRUPTING) { + return; /* still hold the lock */ + } + + /* check for threads that need waking up + */ + wakeUpSleepingThreads(getourtimeofday()); + + /* If new runnable threads have arrived, stop waiting for + * I/O and run them. + */ + if (!emptyRunQueue(&MainCapability)) { + return; /* still hold the lock */ + } + } + + /* Step through the waiting queue, unblocking every thread that now has + * a file descriptor in a ready state. + */ + + prev = NULL; + if (select_succeeded || unblock_all) { + for(tso = blocked_queue_hd; tso != END_TSO_QUEUE; tso = next) { + next = tso->link; + switch (tso->why_blocked) { + case BlockedOnRead: + ready = unblock_all || FD_ISSET(tso->block_info.fd, &rfd); + break; + case BlockedOnWrite: + ready = unblock_all || FD_ISSET(tso->block_info.fd, &wfd); + break; + default: + barf("awaitEvent"); + } + + if (ready) { + IF_DEBUG(scheduler,debugBelch("Waking up blocked thread %d\n", tso->id)); + tso->why_blocked = NotBlocked; + tso->link = END_TSO_QUEUE; + pushOnRunQueue(&MainCapability,tso); + } else { + if (prev == NULL) + blocked_queue_hd = tso; + else + prev->link = tso; + prev = tso; + } + } + + if (prev == NULL) + blocked_queue_hd = blocked_queue_tl = END_TSO_QUEUE; + else { + prev->link = END_TSO_QUEUE; + blocked_queue_tl = prev; + } + } + + } while (wait && sched_state == SCHED_RUNNING + && emptyRunQueue(&MainCapability)); +} + +#endif /* THREADED_RTS */ diff --git a/rts/posix/Select.h b/rts/posix/Select.h new file mode 100644 index 0000000000..8825562974 --- /dev/null +++ b/rts/posix/Select.h @@ -0,0 +1,26 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 1998-2005 + * + * Prototypes for functions in Select.c + * + * -------------------------------------------------------------------------*/ + +#ifndef SELECT_H +#define SELECT_H + +#if !defined(THREADED_RTS) +/* In Select.c */ +extern lnat RTS_VAR(timestamp); + +/* awaitEvent(rtsBool wait) + * + * Checks for blocked threads that need to be woken. + * + * Called from STG : NO + * Locks assumed : sched_mutex + */ +void awaitEvent(rtsBool wait); /* In Select.c */ +#endif + +#endif /* SELECT_H */ diff --git a/rts/posix/Signals.c b/rts/posix/Signals.c new file mode 100644 index 0000000000..5f5f77fd39 --- /dev/null +++ b/rts/posix/Signals.c @@ -0,0 +1,510 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2005 + * + * Signal processing / handling. + * + * ---------------------------------------------------------------------------*/ + +/* This is non-Posix-compliant. + #include "PosixSource.h" +*/ +#include "Rts.h" +#include "SchedAPI.h" +#include "Schedule.h" +#include "RtsSignals.h" +#include "posix/Signals.h" +#include "RtsUtils.h" +#include "RtsFlags.h" + +#ifdef alpha_HOST_ARCH +# if defined(linux_HOST_OS) +# include <asm/fpu.h> +# else +# include <machine/fpu.h> +# endif +#endif + +#ifdef HAVE_UNISTD_H +# include <unistd.h> +#endif + +#ifdef HAVE_SIGNAL_H +# include <signal.h> +#endif + +#include <stdlib.h> + +/* This curious flag is provided for the benefit of the Haskell binding + * to POSIX.1 to control whether or not to include SA_NOCLDSTOP when + * installing a SIGCHLD handler. + */ +StgInt nocldstop = 0; + +/* ----------------------------------------------------------------------------- + * The table of signal handlers + * -------------------------------------------------------------------------- */ + +#if defined(RTS_USER_SIGNALS) + +/* SUP: The type of handlers is a little bit, well, doubtful... */ +StgInt *signal_handlers = NULL; /* Dynamically grown array of signal handlers */ +static StgInt nHandlers = 0; /* Size of handlers array */ + +static nat n_haskell_handlers = 0; + +/* ----------------------------------------------------------------------------- + * Allocate/resize the table of signal handlers. + * -------------------------------------------------------------------------- */ + +static void +more_handlers(I_ sig) +{ + StgInt i; + + if (sig < nHandlers) + return; + + if (signal_handlers == NULL) + signal_handlers = (StgInt *)stgMallocBytes((sig + 1) * sizeof(StgInt), "more_handlers"); + else + signal_handlers = (StgInt *)stgReallocBytes(signal_handlers, (sig + 1) * sizeof(StgInt), "more_handlers"); + + for(i = nHandlers; i <= sig; i++) + // Fill in the new slots with default actions + signal_handlers[i] = STG_SIG_DFL; + + nHandlers = sig + 1; +} + +/* ----------------------------------------------------------------------------- + * Pending Handlers + * + * The mechanism for starting handlers differs between the threaded + * (THREADED_RTS) and non-threaded versions of the RTS. + * + * When the RTS is single-threaded, we just write the pending signal + * handlers into a buffer, and start a thread for each one in the + * scheduler loop. + * + * When THREADED_RTS, the problem is that signals might be + * delivered to multiple threads, so we would need to synchronise + * access to pending_handler_buf somehow. Using thread + * synchronisation from a signal handler isn't possible in general + * (some OSs support it, eg. MacOS X, but not all). So instead: + * + * - the signal handler writes the signal number into the pipe + * managed by the IO manager thread (see GHC.Conc). + * - the IO manager picks up the signal number and calls + * startSignalHandler() to start the thread. + * + * This also has the nice property that we don't need to arrange to + * wake up a worker task to start the signal handler: the IO manager + * wakes up when we write into the pipe. + * + * -------------------------------------------------------------------------- */ + +// Here's the pipe into which we will send our signals +static int io_manager_pipe = -1; + +void +setIOManagerPipe (int fd) +{ + // only called when THREADED_RTS, but unconditionally + // compiled here because GHC.Conc depends on it. + io_manager_pipe = fd; +} + +#if !defined(THREADED_RTS) + +#define N_PENDING_HANDLERS 16 + +StgPtr pending_handler_buf[N_PENDING_HANDLERS]; +StgPtr *next_pending_handler = pending_handler_buf; + +#endif /* THREADED_RTS */ + +/* ----------------------------------------------------------------------------- + * SIGCONT handler + * + * It seems that shells tend to put stdin back into blocking mode + * following a suspend/resume of the process. Here we arrange to put + * it back into non-blocking mode. We don't do anything to + * stdout/stderr because these handles don't get put into non-blocking + * mode at all - see the comments on stdout/stderr in PrelHandle.hsc. + * -------------------------------------------------------------------------- */ + +static void +cont_handler(int sig STG_UNUSED) +{ + setNonBlockingFd(0); +} + +/* ----------------------------------------------------------------------------- + * Low-level signal handler + * + * Places the requested handler on a stack of pending handlers to be + * started up at the next context switch. + * -------------------------------------------------------------------------- */ + +static void +generic_handler(int sig) +{ + sigset_t signals; + +#if defined(THREADED_RTS) + + if (io_manager_pipe != -1) + { + // Write the signal number into the pipe as a single byte. We + // hope that signals fit into a byte... + StgWord8 csig = (StgWord8)sig; + write(io_manager_pipe, &csig, 1); + } + // If the IO manager hasn't told us what the FD of the write end + // of its pipe is, there's not much we can do here, so just ignore + // the signal.. + +#else /* not THREADED_RTS */ + + /* Can't call allocate from here. Probably can't call malloc + either. However, we have to schedule a new thread somehow. + + It's probably ok to request a context switch and allow the + scheduler to start the handler thread, but how do we + communicate this to the scheduler? + + We need some kind of locking, but with low overhead (i.e. no + blocking signals every time around the scheduler). + + Signal Handlers are atomic (i.e. they can't be interrupted), and + we can make use of this. We just need to make sure the + critical section of the scheduler can't be interrupted - the + only way to do this is to block signals. However, we can lower + the overhead by only blocking signals when there are any + handlers to run, i.e. the set of pending handlers is + non-empty. + */ + + /* We use a stack to store the pending signals. We can't + dynamically grow this since we can't allocate any memory from + within a signal handler. + + Hence unfortunately we have to bomb out if the buffer + overflows. It might be acceptable to carry on in certain + circumstances, depending on the signal. + */ + + *next_pending_handler++ = deRefStablePtr((StgStablePtr)signal_handlers[sig]); + + // stack full? + if (next_pending_handler == &pending_handler_buf[N_PENDING_HANDLERS]) { + errorBelch("too many pending signals"); + stg_exit(EXIT_FAILURE); + } + +#endif /* THREADED_RTS */ + + // re-establish the signal handler, and carry on + sigemptyset(&signals); + sigaddset(&signals, sig); + sigprocmask(SIG_UNBLOCK, &signals, NULL); + + // *always* do the SIGCONT handler, even if the user overrides it. + if (sig == SIGCONT) { + cont_handler(sig); + } + + context_switch = 1; +} + +/* ----------------------------------------------------------------------------- + * Blocking/Unblocking of the user signals + * -------------------------------------------------------------------------- */ + +static sigset_t userSignals; +static sigset_t savedSignals; + +void +initUserSignals(void) +{ + sigemptyset(&userSignals); +} + +void +blockUserSignals(void) +{ + sigprocmask(SIG_BLOCK, &userSignals, &savedSignals); +} + +void +unblockUserSignals(void) +{ + sigprocmask(SIG_SETMASK, &savedSignals, NULL); +} + +rtsBool +anyUserHandlers(void) +{ + return n_haskell_handlers != 0; +} + +#if !defined(THREADED_RTS) +void +awaitUserSignals(void) +{ + while (!signals_pending() && sched_state == SCHED_RUNNING) { + pause(); + } +} +#endif + +/* ----------------------------------------------------------------------------- + * Install a Haskell signal handler. + * -------------------------------------------------------------------------- */ + +int +stg_sig_install(int sig, int spi, StgStablePtr *handler, void *mask) +{ + sigset_t signals, osignals; + struct sigaction action; + StgInt previous_spi; + + // Block the signal until we figure out what to do + // Count on this to fail if the signal number is invalid + if (sig < 0 || sigemptyset(&signals) || + sigaddset(&signals, sig) || sigprocmask(SIG_BLOCK, &signals, &osignals)) { + return STG_SIG_ERR; + } + + more_handlers(sig); + + previous_spi = signal_handlers[sig]; + + action.sa_flags = 0; + + switch(spi) { + case STG_SIG_IGN: + signal_handlers[sig] = STG_SIG_IGN; + sigdelset(&userSignals, sig); + action.sa_handler = SIG_IGN; + break; + + case STG_SIG_DFL: + signal_handlers[sig] = STG_SIG_DFL; + sigdelset(&userSignals, sig); + action.sa_handler = SIG_DFL; + break; + + case STG_SIG_HAN: + case STG_SIG_RST: + signal_handlers[sig] = (StgInt)*handler; + sigaddset(&userSignals, sig); + action.sa_handler = generic_handler; + if (spi == STG_SIG_RST) { + action.sa_flags = SA_RESETHAND; + } + n_haskell_handlers++; + break; + + default: + barf("stg_sig_install: bad spi"); + } + + if (mask != NULL) + action.sa_mask = *(sigset_t *)mask; + else + sigemptyset(&action.sa_mask); + + action.sa_flags |= sig == SIGCHLD && nocldstop ? SA_NOCLDSTOP : 0; + + if (sigaction(sig, &action, NULL) || + sigprocmask(SIG_SETMASK, &osignals, NULL)) + { + // need to return an error code, so avoid a stable pointer leak + // by freeing the previous handler if there was one. + if (previous_spi >= 0) { + freeStablePtr(stgCast(StgStablePtr,signal_handlers[sig])); + n_haskell_handlers--; + } + return STG_SIG_ERR; + } + + if (previous_spi == STG_SIG_DFL || previous_spi == STG_SIG_IGN + || previous_spi == STG_SIG_ERR) { + return previous_spi; + } else { + *handler = (StgStablePtr)previous_spi; + return STG_SIG_HAN; + } +} + +/* ----------------------------------------------------------------------------- + * Creating new threads for signal handlers. + * -------------------------------------------------------------------------- */ + +#if !defined(THREADED_RTS) +void +startSignalHandlers(Capability *cap) +{ + blockUserSignals(); + + while (next_pending_handler != pending_handler_buf) { + + next_pending_handler--; + + scheduleThread (cap, + createIOThread(cap, + RtsFlags.GcFlags.initialStkSize, + (StgClosure *) *next_pending_handler)); + } + + unblockUserSignals(); +} +#endif + +/* ---------------------------------------------------------------------------- + * Mark signal handlers during GC. + * + * We do this rather than trying to start all the signal handlers + * prior to GC, because that requires extra heap for the new threads. + * Signals must be blocked (see blockUserSignals() above) during GC to + * avoid race conditions. + * -------------------------------------------------------------------------- */ + +#if !defined(THREADED_RTS) +void +markSignalHandlers (evac_fn evac) +{ + StgPtr *p; + + p = next_pending_handler; + while (p != pending_handler_buf) { + p--; + evac((StgClosure **)p); + } +} +#else +void +markSignalHandlers (evac_fn evac STG_UNUSED) +{ +} +#endif + +#else /* !RTS_USER_SIGNALS */ +StgInt +stg_sig_install(StgInt sig STG_UNUSED, + StgInt spi STG_UNUSED, + StgStablePtr* handler STG_UNUSED, + void* mask STG_UNUSED) +{ + //barf("User signals not supported"); + return STG_SIG_DFL; +} + +#endif + +#if defined(RTS_USER_SIGNALS) +/* ----------------------------------------------------------------------------- + * SIGINT handler. + * + * We like to shutdown nicely after receiving a SIGINT, write out the + * stats, write profiling info, close open files and flush buffers etc. + * -------------------------------------------------------------------------- */ +#ifdef SMP +pthread_t startup_guy; +#endif + +static void +shutdown_handler(int sig STG_UNUSED) +{ +#ifdef SMP + // if I'm a worker thread, send this signal to the guy who + // originally called startupHaskell(). Since we're handling + // the signal, it won't be a "send to all threads" type of signal + // (according to the POSIX threads spec). + if (pthread_self() != startup_guy) { + pthread_kill(startup_guy, sig); + return; + } +#endif + + // If we're already trying to interrupt the RTS, terminate with + // extreme prejudice. So the first ^C tries to exit the program + // cleanly, and the second one just kills it. + if (sched_state >= SCHED_INTERRUPTING) { + stg_exit(EXIT_INTERRUPTED); + } else { + interruptStgRts(); + } +} + +/* ----------------------------------------------------------------------------- + * Install default signal handlers. + * + * The RTS installs a default signal handler for catching + * SIGINT, so that we can perform an orderly shutdown. + * + * Haskell code may install their own SIGINT handler, which is + * fine, provided they're so kind as to put back the old one + * when they de-install. + * + * In addition to handling SIGINT, the RTS also handles SIGFPE + * by ignoring it. Apparently IEEE requires floating-point + * exceptions to be ignored by default, but alpha-dec-osf3 + * doesn't seem to do so. + * -------------------------------------------------------------------------- */ +void +initDefaultHandlers() +{ + struct sigaction action,oact; + +#ifdef SMP + startup_guy = pthread_self(); +#endif + + // install the SIGINT handler + action.sa_handler = shutdown_handler; + sigemptyset(&action.sa_mask); + action.sa_flags = 0; + if (sigaction(SIGINT, &action, &oact) != 0) { + errorBelch("warning: failed to install SIGINT handler"); + } + +#if defined(HAVE_SIGINTERRUPT) + siginterrupt(SIGINT, 1); // isn't this the default? --SDM +#endif + + // install the SIGCONT handler + action.sa_handler = cont_handler; + sigemptyset(&action.sa_mask); + action.sa_flags = 0; + if (sigaction(SIGCONT, &action, &oact) != 0) { + errorBelch("warning: failed to install SIGCONT handler"); + } + + // install the SIGFPE handler + + // In addition to handling SIGINT, also handle SIGFPE by ignoring it. + // Apparently IEEE requires floating-point exceptions to be ignored by + // default, but alpha-dec-osf3 doesn't seem to do so. + + // Commented out by SDM 2/7/2002: this causes an infinite loop on + // some architectures when an integer division by zero occurs: we + // don't recover from the floating point exception, and the + // program just generates another one immediately. +#if 0 + action.sa_handler = SIG_IGN; + sigemptyset(&action.sa_mask); + action.sa_flags = 0; + if (sigaction(SIGFPE, &action, &oact) != 0) { + errorBelch("warning: failed to install SIGFPE handler"); + } +#endif + +#ifdef alpha_HOST_ARCH + ieee_set_fp_control(0); +#endif +} + +#endif /* RTS_USER_SIGNALS */ diff --git a/rts/posix/Signals.h b/rts/posix/Signals.h new file mode 100644 index 0000000000..39477f8c6a --- /dev/null +++ b/rts/posix/Signals.h @@ -0,0 +1,26 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2005 + * + * Signal processing / handling. + * + * ---------------------------------------------------------------------------*/ + +#ifndef POSIX_SIGNALS_H +#define POSIX_SIGNALS_H + +extern rtsBool anyUserHandlers(void); + +#if !defined(THREADED_RTS) + +extern StgPtr pending_handler_buf[]; +extern StgPtr *next_pending_handler; +#define signals_pending() (next_pending_handler != pending_handler_buf) +void startSignalHandlers(Capability *cap); + +#endif + +extern StgInt *signal_handlers; + +#endif /* POSIX_SIGNALS_H */ + |