Description: adds additional thread debugging functions. Status: Not applied/groked Author: Christian Lynbech Here is a set of patches that makes it a lot easier to debug multithreaded applications. It basically adds 5 new functions: - thread-count: returns the number of threads in the system. - thread-all: returns a list of all threads. - thread-status: takes a thread and returns its current status. If it is waiting, it details what it is waiting for. - waits-mutex and waits-condition-variable: takes a mutex (or condvar) and returns the threads waiting on that. The patch may look somewhat frightening because some of the above functions require changes to the internal representations, and made the main thread more of a proper thread. Index: libguile/coop-defs.h =================================================================== RCS file: /nmc/Repository/tools/guile/guile-core/libguile/coop-defs.h,v retrieving revision 1.1.1.3 diff -u -r1.1.1.3 coop-defs.h --- libguile/coop-defs.h 1998/10/04 19:04:42 1.1.1.3 +++ libguile/coop-defs.h 1998/12/22 13:42:18 @@ -81,6 +81,7 @@ void *sto; /* `malloc'-allocated stack. */ struct coop_t *next; /* Next thread in the queue. */ + struct coop_q_t *my_q; /* The queue on which I am waiting */ struct coop_t *all_next; struct coop_t *all_prev; @@ -118,6 +119,8 @@ typedef struct coop_q_t { coop_t t; coop_t *tail; + char kind; /* 'g' = global, 'c' = condvar, 'm' = mutex */ + void *which; /* the coop_c or the coop_m */ } coop_q_t; /* A Mutex variable is made up of a owner thread, and a queue of threads @@ -126,6 +129,7 @@ typedef struct coop_m { coop_t *owner; /* Mutex owner */ coop_q_t waiting; /* Queue of waiting threads */ + SCM my_mutex; } coop_m; typedef coop_m scm_mutex_t; @@ -144,6 +148,7 @@ typedef struct coop_c { coop_q_t waiting; /* Queue of waiting threads */ + SCM my_condvar; } coop_c; typedef coop_c scm_cond_t; Index: libguile/coop-threads.c =================================================================== RCS file: /nmc/Repository/tools/guile/guile-core/libguile/coop-threads.c,v retrieving revision 1.1.1.3 diff -u -r1.1.1.3 coop-threads.c --- libguile/coop-threads.c 1998/10/03 20:43:20 1.1.1.3 +++ libguile/coop-threads.c 1998/12/22 13:42:18 @@ -110,6 +110,9 @@ coop_global_main.sto = i; coop_global_main.base = i; coop_global_curr = &coop_global_main; + SCM_NEWCELL (scm_root_thread); + SCM_SETCDR (scm_root_thread, &coop_global_main); + SCM_SETCAR (scm_root_thread, scm_tc16_thread); coop_all_qput (&coop_global_allq, coop_global_curr); coop_mutex_init (&scm_critical_section_mutex); @@ -424,6 +427,66 @@ #ifdef __STDC__ SCM +scm_thread_status (SCM t) +#else +SCM +scm_thread_status (t) + SCM t; +#endif +{ + SCM z; + coop_t *ct; + coop_q_t *q; + SCM_ASSERT (SCM_NIMP (t) && SCM_THREADP (t), t, SCM_ARG1, s_thread_status); + ct = SCM_THREAD_DATA (t); + z = SCM_EOL; + q = ct->my_q; + + if (q == &coop_global_sleepq) { + z = SCM_CAR (scm_intern0 ("sleeping")); +#ifdef GUILE_ISELECT + if (ct->readfds || ct->writefds || ct->exceptfds) { + int i; SCM tmp; + for (i=0; i < ct->nfds; i++) { + if (ct->readfds && FD_ISSET (i, ct->readfds)) { + SCM_NEWCELL (tmp); + SCM_SETCAR (tmp, SCM_CAR (scm_intern0 ("input"))); + SCM_SETCDR (tmp, SCM_MAKINUM (i)); + z = scm_cons (tmp, z); + } + if (ct->writefds && FD_ISSET (i, ct->writefds)) { + SCM_NEWCELL (tmp); + SCM_SETCAR (tmp, SCM_CAR (scm_intern0 ("output"))); + SCM_SETCDR (tmp, SCM_MAKINUM (i)); + z = scm_cons (tmp, z); + } + if (ct->exceptfds && FD_ISSET (i, ct->exceptfds)) { + SCM_NEWCELL (tmp); + SCM_SETCAR (tmp, SCM_CAR (scm_intern0 ("except"))); + SCM_SETCDR (tmp, SCM_MAKINUM (i)); + z = scm_cons (tmp, z); + } + } + if (ct->timeoutp) { + z = scm_cons (scm_cons (scm_long2num ((long) ct->wakeup_time.tv_sec), + scm_long2num ((long) ct->wakeup_time.tv_usec)), + z); + } + } +#endif + } else if (q == &coop_global_runq) { + z = SCM_CAR (scm_intern0 ("runnable")); + } else if (q->kind == 'c') { + z = ((coop_c*)(q->which))->my_condvar; + } else if (q->kind == 'm') { + z = ((coop_m*)(q->which))->my_mutex; + } + + return z; +} + +#ifdef __STDC__ +SCM scm_join_thread (SCM t) #else SCM @@ -466,6 +529,43 @@ #ifdef __STDC__ SCM +scm_thread_count_p () +#else +SCM +scm_thread_count_p () +#endif +{ + return (SCM_MAKINUM(scm_thread_count)); +} + +#define SCM_SMOB_OF_COOP_T(t) (((t) == &coop_global_main) ? scm_root_thread: (SCM_CAR((SCM) (((qt_word_t*)(QT_ADJ((t)->base)))[QT_ARGU_INDEX])))) + +#ifdef __STDC__ +SCM +scm_thread_all () +#else +SCM +scm_thread_all () +#endif +{ + SCM z; + coop_t *thread; + + + z = SCM_EOL; + + + for (thread = coop_global_allq.t.all_next; + thread != NULL; thread = thread->all_next) + { + z = scm_cons( SCM_SMOB_OF_COOP_T(thread), z); + } + + return z; +} + +#ifdef __STDC__ +SCM scm_make_mutex () #else SCM @@ -478,6 +578,7 @@ SCM_DEFER_INTS; SCM_SETCAR (m, scm_tc16_mutex); SCM_SETCDR (m, data); + data->my_mutex = m; SCM_ALLOW_INTS; coop_mutex_init (data); return m; @@ -518,6 +619,36 @@ #ifdef __STDC__ SCM +scm_waits_mutex (SCM m) +#else +SCM +scm_waits_mutex (m) + SCM m; +#endif +{ + coop_m *md; + coop_q_t *qt; + coop_t *t; + SCM z; + + SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), + m, + SCM_ARG1, + s_waits_mutex); + + md = SCM_MUTEX_DATA (m); + qt = &md->waiting; + z = SCM_EOL; + + for (t = qt->t.next; t != &qt->t; t = t->next) { + z = scm_cons(SCM_SMOB_OF_COOP_T(t) , z); + } + + return scm_cons( (md->owner) ? SCM_SMOB_OF_COOP_T(md->owner) : SCM_EOL ,z); +} + +#ifdef __STDC__ +SCM scm_make_condition_variable () #else SCM @@ -530,6 +661,7 @@ SCM_DEFER_INTS; SCM_SETCAR (c, scm_tc16_condvar); SCM_SETCDR (c, data); + data->my_condvar = c; SCM_ALLOW_INTS; coop_condition_variable_init (SCM_CONDVAR_DATA (c)); return c; @@ -557,6 +689,37 @@ SCM_MUTEX_DATA (m)); return SCM_BOOL_T; } + +#ifdef __STDC__ +SCM +scm_waits_condition_variable (SCM c) +#else +SCM +scm_waits_condition_variable (c) + SCM c; +#endif +{ + coop_c *cd; + coop_q_t *qt; + coop_t *t; + SCM z; + + SCM_ASSERT (SCM_NIMP (c) && SCM_CONDVARP (c), + c, + SCM_ARG1, + s_waits_condition_variable); + + cd = SCM_CONDVAR_DATA (c); + qt = &cd->waiting; + z = SCM_EOL; + + for (t = qt->t.next; t != &qt->t; t = t->next) { + z = scm_cons(SCM_SMOB_OF_COOP_T(t) , z); + } + + return z; +} + #ifdef __STDC__ SCM Index: libguile/coop.c =================================================================== RCS file: /nmc/Repository/tools/guile/guile-core/libguile/coop.c,v retrieving revision 1.1.1.5.6.1 diff -u -r1.1.1.5.6.1 coop.c --- libguile/coop.c 1998/11/22 21:42:04 1.1.1.5.6.1 +++ libguile/coop.c 1998/12/22 13:50:59 @@ -73,6 +73,7 @@ { q->t.next = q->tail = &q->t; + q->t.my_q = NULL; q->t.all_prev = NULL; q->t.all_next = NULL; #ifdef GUILE_ISELECT @@ -82,6 +83,8 @@ q->t.exceptfds = NULL; q->t.timeoutp = 0; #endif + q->kind = 'g'; + q->which = NULL; } @@ -121,6 +124,7 @@ q->tail->next = t; t->next = &q->t; q->tail = t; + t->my_q = q; } #ifdef __STDC__ @@ -276,6 +280,8 @@ { m->owner = NULL; coop_qinit(&(m->waiting)); + (m->waiting).kind = 'm'; + (m->waiting).which = m; return 0; } @@ -369,6 +375,8 @@ #endif { coop_qinit(&(c->waiting)); + (c->waiting).kind = 'c'; + (c->waiting).which = c; return 0; } Index: libguile/root.h =================================================================== RCS file: /nmc/Repository/tools/guile/guile-core/libguile/root.h,v retrieving revision 1.1.1.4 diff -u -r1.1.1.4 root.h --- libguile/root.h 1998/10/20 03:40:19 1.1.1.4 +++ libguile/root.h 1998/12/22 13:42:19 @@ -69,11 +69,12 @@ #define scm_permobjs scm_sys_protects[13] #define scm_asyncs scm_sys_protects[14] #define scm_protects scm_sys_protects[15] +#define scm_root_thread scm_sys_protects[16] #ifdef DEBUG_EXTENSIONS -#define scm_source_whash scm_sys_protects[16] -#define SCM_NUM_PROTECTS 17 +#define scm_source_whash scm_sys_protects[17] +#define SCM_NUM_PROTECTS 18 #else -#define SCM_NUM_PROTECTS 16 +#define SCM_NUM_PROTECTS 17 #endif extern SCM scm_sys_protects[]; Index: libguile/threads.c =================================================================== RCS file: /nmc/Repository/tools/guile/guile-core/libguile/threads.c,v retrieving revision 1.1.1.4 diff -u -r1.1.1.4 threads.c --- libguile/threads.c 1998/10/20 03:47:04 1.1.1.4 +++ libguile/threads.c 1998/12/22 13:42:19 @@ -79,16 +79,21 @@ #ifdef USE_COOP_THREADS SCM_PROC(s_single_thread_p, "single-active-thread?", 0, 0, 0, scm_single_thread_p); +SCM_PROC(s_thread_count, "thread-count", 0, 0, 0, scm_thread_count_p); +SCM_PROC(s_thread_all, "thread-all", 0, 0, 0, scm_thread_all); #endif SCM_PROC(s_yield, "yield", 0, 0, 0, scm_yield); SCM_PROC(s_call_with_new_thread, "call-with-new-thread", 0, 0, 1, scm_call_with_new_thread); SCM_PROC(s_join_thread, "join-thread", 1, 0, 0, scm_join_thread); +SCM_PROC(s_thread_status, "thread-status", 1, 0, 0, scm_thread_status); SCM_PROC(s_make_mutex, "make-mutex", 0, 0, 0, scm_make_mutex); SCM_PROC(s_lock_mutex, "lock-mutex", 1, 0, 0, scm_lock_mutex); SCM_PROC(s_unlock_mutex, "unlock-mutex", 1, 0, 0, scm_unlock_mutex); +SCM_PROC(s_waits_mutex, "waits-mutex", 1, 0, 0, scm_waits_mutex); SCM_PROC(s_make_condition_variable, "make-condition-variable", 0, 0, 0, scm_make_condition_variable); SCM_PROC(s_wait_condition_variable, "wait-condition-variable", 2, 0, 0, scm_wait_condition_variable); SCM_PROC(s_signal_condition_variable, "signal-condition-variable", 1, 0, 0, scm_signal_condition_variable); +SCM_PROC(s_waits_condition_variable, "waits-condition-variable", 1, 0, 0, scm_waits_condition_variable); Index: libguile/threads.h =================================================================== RCS file: /nmc/Repository/tools/guile/guile-core/libguile/threads.h,v retrieving revision 1.1.1.4 diff -u -r1.1.1.4 threads.h --- libguile/threads.h 1998/10/29 13:00:46 1.1.1.4 +++ libguile/threads.h 1998/12/22 13:42:19 @@ -85,15 +85,20 @@ /* The C versions of the Scheme-visible thread functions. */ #ifdef USE_COOP_THREADS extern SCM scm_single_thread_p (void); +extern SCM scm_thread_count_p (void); +extern SCM scm_thread_all (void); #endif extern SCM scm_yield (void); extern SCM scm_call_with_new_thread (SCM argl); extern SCM scm_join_thread (SCM t); +extern SCM scm_thread_status (SCM t); extern SCM scm_make_mutex (void); extern SCM scm_lock_mutex (SCM m); extern SCM scm_unlock_mutex (SCM m); +extern SCM scm_waits_mutex (SCM m); extern SCM scm_make_condition_variable (void); extern SCM scm_wait_condition_variable (SCM cond, SCM mutex); +extern SCM scm_waits_condition_variable (SCM cond); extern SCM scm_signal_condition_variable (SCM cond); #if 0