diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 225f30f1d..cada13665 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,4 +1,53 @@ -1998-01-26 Mikael Djurfeldt +1998-01-30 Mikael Djurfeldt + + * dynwind.c (scm_wind_chain): New debug function. + + * coop-threads.c (scheme_launch_data, scheme_body_bootstrip, + scheme_handler_bootstrip, scheme_launch_thread, c_launch_data, + c_body_bootstrip, c_handler_bootstrip, c_launch_thread): Add an + extra layer of functions around the body and handler of a thread. + This extra layer makes sure that the handler is called in the + dynamic context of the surround (= empty dynwind list), but under + the *dynamic root* of the body. We can not use the dynamic root + of the surround since that root belongs to another thread => stack + is not handled correctly. It may seem ugly to use this extra + layer, but the extra cost in terms of execution time is really + negligible compared to the total amount of time required to create + a thread, and it would reduce maintainability to duplicate the + crucial and complicated steps performed by cwdr. + + * __scm.h (SCM_ASYNC_TICK): Removed thread switching code. + (SCM_ALLOW_INTS): Added thread switching code before interrupts + get re-enabled. The important effect of this is that interrupts + are blocked during thread switching so that thread data structures + don't risk getting messed up by an unfortunate signal. + (SCM_REDEFER_INTS, SCM_REALLOW_INTS): It turned out that gcc-2.8.0 + seems to do more aggressive optimization which actually move + instructions around in these macros in a fatal way. Therefore: + Introduce Anthony's SCM_FENCE macro! (And I who thought he was + just superstitious...) + (SCM_TICK): Maybe do a context switch and take care of asyncs. + This macro should be used instead of SCM_ASYNC_TICK since the + latter doesn't do context switches any more. + + * eval.c (scm_eval, scm_deval), eq.c (scm_equal_p): Use SCM_TICK + instead of SCM_ASYNC_TICK. + + * coop.c, iselect.c: Since thread switches are now performed with + interrupts masked, we can't use the old mechanism of delivering + signals immediately when they arrive. Signals must instead be + delivered when the asyncs run *after* the end of the critical + section in scm_internal_select. But this also means after context + switch so that the signal will be delivered to a different thread. + To avoid this, I have changed the protocol of + coop_wait_for_runnable_thread and friends so that they are allowed + to return the original thread. So, if a signal arrives during + scm_internal_select, we won't any longer be forced do a context + switch, but can remain in the same thread and deliver the signal + to it. + + * async.c, async.h (asyncs_pending): Renamed asyncs_pending --> + scm_asyncs_pending and made it global. * iselect.c: Small fixes. diff --git a/libguile/iselect.c b/libguile/iselect.c index 6edfbb4b9..c03a75792 100644 --- a/libguile/iselect.c +++ b/libguile/iselect.c @@ -97,6 +97,8 @@ typedef unsigned long *ulongptr; static char bc[256]; /* Bit counting array. bc[x] is the number of bits in x. */ +int scm_I_am_dead; + /* This flag indicates that several threads are waiting on the same file descriptor. When this is the case, the common fd sets are updated in a more inefficient way. */ @@ -415,8 +417,8 @@ first_interesting_fd (void) } /* Revive all threads with an error status. */ -static void -error_revive (void) +void +scm_error_revive_threads (void) { coop_t *t; @@ -424,8 +426,10 @@ error_revive (void) { t->_errno = errno; t->retval = -1; - coop_qput (&coop_global_runq, t); + if (t != coop_global_curr) + coop_qput (&coop_global_runq, t); } + collisionp = 0; gnfds = 0; FD_ZERO (&greadfds); FD_ZERO (&gwritefds); @@ -436,12 +440,21 @@ error_revive (void) try to wake up some threads and return the first one. Return NULL if we couldn't find any. */ static coop_t * -find_thread (int n, struct timeval *now) +find_thread (int n, struct timeval *now, int sleepingp) { coop_t *t; int fd; - if (n == 0) + if (n < 0) + /* An error or a signal has occured. Wake all threads. Since we + don't care to calculate if there is a sinner we report the + error to all of them. */ + { + scm_error_revive_threads (); + if (!scm_I_am_dead) + return coop_global_curr; + } + else if (n == 0) { while (!QEMPTYP (coop_global_sleepq) && (t = QFIRST (coop_global_sleepq))->timeoutp @@ -510,11 +523,6 @@ find_thread (int n, struct timeval *now) coop_qput (&coop_global_sleepq, t); } } - else /* n < 0 */ - /* An error has occured. Wake all threads. Since we don't care - to calculate if there is a sinner we report the error to all of - them. */ - error_revive (); return coop_qget (&coop_global_runq); } @@ -532,9 +540,13 @@ coop_next_runnable_thread () /* Just return next thread on the runq if the sleepq is empty. */ if (QEMPTYP (coop_global_sleepq)) - return coop_qget (&coop_global_runq); + { + if (QEMPTYP (coop_global_runq)) + return coop_global_curr; + else + return coop_qget (&coop_global_runq); + } - ++scm_ints_disabled; if (gnfds > 0) n = safe_select (gnfds, &greadfds, &gwritefds, &gexceptfds, &timeout0); else @@ -542,13 +554,11 @@ coop_next_runnable_thread () if (QFIRST (coop_global_sleepq)->timeoutp) { gettimeofday (&now, NULL); - t = find_thread (n, &now); + t = find_thread (n, &now, 0); } else - t = find_thread (n, 0); - if (!--scm_ints_disabled) - SCM_ASYNC_TICK; - return t; + t = find_thread (n, 0, 0); + return t == NULL ? coop_global_curr : t; } coop_t * @@ -557,13 +567,12 @@ coop_wait_for_runnable_thread_now (struct timeval *now) int n; coop_t *t; - ++scm_ints_disabled; if (gnfds > 0) n = safe_select (gnfds, &greadfds, &gwritefds, &gexceptfds, &timeout0); else n = 0; /* Is there any other runnable thread? */ - t = find_thread (n, now); + t = find_thread (n, now, 1); while (t == NULL) { /* No. Let the process go to sleep. */ @@ -582,11 +591,9 @@ coop_wait_for_runnable_thread_now (struct timeval *now) else n = safe_select (gnfds, &greadfds, &gwritefds, &gexceptfds, NULL); gettimeofday (now, NULL); - t = find_thread (n, now); + t = find_thread (n, now, 1); } - if (!--scm_ints_disabled) - SCM_ASYNC_TICK; return t; } @@ -596,7 +603,12 @@ coop_wait_for_runnable_thread () struct timeval now; if (QEMPTYP (coop_global_sleepq)) - return coop_qget (&coop_global_runq); + { + if (QEMPTYP (coop_global_runq)) + return coop_global_curr; + else + return coop_qget (&coop_global_runq); + } if (QFIRST (coop_global_sleepq)->timeoutp) gettimeofday (&now, NULL); @@ -613,14 +625,14 @@ scm_internal_select (int nfds, { struct timeval now; coop_t *t, *curr = coop_global_curr; - + /* If the timeout is 0, we're polling and can handle it quickly. */ if (timeout != NULL && timeout->tv_sec == 0 && timeout->tv_usec == 0) return select (nfds, readfds, writefds, exceptfds, timeout); - ++scm_ints_disabled; + SCM_DEFER_INTS; /* Add our file descriptor flags to the common set. */ curr->nfds = nfds; @@ -652,20 +664,18 @@ scm_internal_select (int nfds, t = coop_wait_for_runnable_thread_now (&now); } - if (!--scm_ints_disabled) - SCM_ASYNC_TICK; - /* If the new thread is the same as the sleeping thread, do nothing */ - if (t != curr) + if (t != coop_global_curr) { /* Do a context switch. */ coop_global_curr = t; QT_BLOCK (coop_sleephelp, curr, NULL, t->sp); } - if (curr->retval == -1) - errno = curr->_errno; - return curr->retval; + if (coop_global_curr->retval == -1) + errno = coop_global_curr->_errno; + SCM_ALLOW_INTS; + return coop_global_curr->retval; } /* Initialize bit counting array */ diff --git a/libguile/iselect.h b/libguile/iselect.h index 3b95a7fdf..5a3be73d7 100644 --- a/libguile/iselect.h +++ b/libguile/iselect.h @@ -83,11 +83,14 @@ #endif /* no FD_SET */ +extern int scm_I_am_dead; + extern int scm_internal_select (int fds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds, struct timeval *timeout); +extern void scm_error_revive_threads (void); extern void scm_init_iselect (void); #endif