[bpt/guile.git] / libguile / pthread-threads.c

/* Copyright (C) 2002 Free Software Foundation, Inc.
 * 
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 * 
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 * Boston, MA 02111-1307 USA
 *
 * As a special exception, the Free Software Foundation gives permission
 * for additional uses of the text contained in its release of GUILE.
 *
 * The exception is that, if you link the GUILE library with other files
 * to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the GUILE library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the
 * Free Software Foundation under the name GUILE.  If you copy
 * code from other Free Software Foundation releases into a copy of
 * GUILE, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for GUILE, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.  */


\f

#include "libguile/scmconfig.h"

scm_t_mutexattr scm_i_plugin_mutex;

scm_t_mutexattr scm_i_plugin_rec_mutex;

#if !defined (SCM_MUTEX_RECURSIVE) || defined (SCM_DEBUG_THREADS)

typedef struct rec_mutex {
#ifdef SCM_DEBUG_THREADS
  int kind;
#endif
  scm_t_mutex mutex;
  scm_thread *owner;
  int count;
} rec_mutex;

/* Mutex for recursive mutex administration */
static scm_t_mutex rec_mutex_mutex;

#ifdef SCM_DEBUG_THREADS

#define FAST_MUTEX 1
#define REC_MUTEX 2

typedef struct mutex {
  int kind;
  pthread_mutex_t mutex;
  scm_thread *owner;
  int count;
} mutex;

static pthread_mutex_t mutex_mutex;

int
scm_i_plugin_mutex_init (scm_t_mutex *mx, const scm_t_mutexattr *a)
{
  mutex *m = (mutex *) mx;
  pthread_mutex_init (&m->mutex, &scm_i_plugin_mutex);
  m->owner = 0;
  m->count = 0;
  m->kind = FAST_MUTEX;
  return 0;
}

int
scm_i_plugin_mutex_lock (scm_t_mutex *mx)
{
  mutex *m = (mutex *) mx;
  scm_thread *t = SCM_CURRENT_THREAD;
  pthread_mutex_lock (&mutex_mutex);
  if (m->kind != FAST_MUTEX)
    {
      fprintf (stderr,
	       m->kind == REC_MUTEX
	       ? "locking wrong mutex type\n"
	       : "locking uninitialized mutex\n");
      abort ();
    }
  if (m->owner == t)
    {
      fprintf (stderr, "locking mutex already locked by self\n");
      abort ();
    }
  pthread_mutex_unlock (&mutex_mutex);
  pthread_mutex_lock (&m->mutex);
  m->count = 1;
  m->owner = t;
  return 0;
}

int
scm_i_plugin_mutex_unlock (scm_t_mutex *mx)
{
  mutex *m = (mutex *) mx;
  pthread_mutex_lock (&mutex_mutex);
  if (m->kind != FAST_MUTEX)
    {
      fprintf (stderr,
	       m->kind == REC_MUTEX
	       ? "locking wrong mutex type\n"
	       : "locking uninitialized mutex\n");
      abort ();
    }
  if (m->count != 1)
    {
      fprintf (stderr,
	       m->count == 0
	       ? "unlocking unlocked mutex\n"
	       : "bogus internal state");
      abort ();
    }
  m->owner = 0;
  m->count = 0;
  pthread_mutex_unlock (&m->mutex);
  pthread_mutex_unlock (&mutex_mutex);
  return 0;
}

int
scm_i_plugin_cond_wait (scm_t_cond *c, scm_t_mutex *mx)
{
  mutex *m = (mutex *) mx;
  int res;
  if (m->owner != SCM_CURRENT_THREAD || m->count != 1)
    {
      fprintf (stderr, "mutex not locked by self\n");
      abort ();
    }
  res = pthread_cond_wait ((pthread_cond_t *) c, &m->mutex);
  if (m->owner != 0 || m->count != 0)
    {
      fprintf (stderr, "strange internal state\n");
      abort ();
    }
  m->owner = SCM_CURRENT_THREAD;
  m->count = 1;
  return res;
}

int
scm_i_plugin_cond_timedwait (scm_t_cond *c,
			scm_t_mutex *mx,
			const struct timespec *t)
{
  mutex *m = (mutex *) mx;
  return pthread_cond_timedwait ((pthread_cond_t *) c, &m->mutex, t);
}

void
scm_i_assert_heap_locked ()
{
  mutex *m = (mutex *) &SCM_CURRENT_THREAD->heap_mutex;
  pthread_mutex_lock (&mutex_mutex);
  if (gc_running)
    {
      fprintf (stderr, "thread running during gc\n");
      abort ();
    }
  if (m->count != 1)
    {
      fprintf (stderr, "mutex not locked\n");
      abort ();
    }
  pthread_mutex_unlock (&mutex_mutex);
}

#endif

/* The following section belongs in threads.c, or rather
   thread-plugin.c.  It is generic and not tied to any particular
   thread library. */

int
scm_i_plugin_rec_mutex_init (scm_t_rec_mutex *mx, const scm_t_mutexattr *a)
{
  rec_mutex *m = (rec_mutex *) mx;
  scm_i_plugin_mutex_init (&m->mutex, &scm_i_plugin_mutex);
  m->owner = 0;
  m->count = 0;
#ifdef SCM_DEBUG_THREADS
  m->kind = REC_MUTEX;
#endif
  return 0;
}

int
scm_i_plugin_rec_mutex_lock (scm_t_rec_mutex *mx)
{
  rec_mutex *m = (rec_mutex *) mx;
  scm_thread *t = SCM_CURRENT_THREAD;
  scm_i_plugin_mutex_lock (&rec_mutex_mutex);
#ifdef SCM_DEBUG_THREADS
  if (m->kind != REC_MUTEX)
    {
      fprintf (stderr,
	       m->kind == FAST_MUTEX
	       ? "locking wrong mutex type\n"
	       : "locking uninitialized mutex\n");
      abort ();
    }
#endif
  if (m->count && m->owner == t)
    {
      ++m->count;
      scm_i_plugin_mutex_unlock (&rec_mutex_mutex);
    }
  else
    {
      scm_i_plugin_mutex_unlock (&rec_mutex_mutex);
      scm_i_plugin_mutex_lock (&m->mutex);
      m->count = 1;
      m->owner = t;
    }
  return 0;
}

int
scm_i_plugin_rec_mutex_trylock (scm_t_rec_mutex *mx)
{
  rec_mutex *m = (rec_mutex *) mx;
  scm_thread *t = SCM_CURRENT_THREAD;
  scm_i_plugin_mutex_lock (&rec_mutex_mutex);
  if (m->owner != 0 && m->owner != t)
    return EBUSY;
  else if (m->count)
    {
      ++m->count;
      scm_i_plugin_mutex_unlock (&rec_mutex_mutex);
    }
  else
    {
      scm_i_plugin_mutex_unlock (&rec_mutex_mutex);
      scm_i_plugin_mutex_lock (&m->mutex);
      m->count = 1;
      m->owner = t;
    }
  return 0;
}

int
scm_i_plugin_rec_mutex_unlock (scm_t_rec_mutex *mx)
{
  rec_mutex *m = (rec_mutex *) mx;
  scm_i_plugin_mutex_lock (&rec_mutex_mutex);
#ifdef SCM_DEBUG_THREADS
  if (m->kind != REC_MUTEX)
    {
      fprintf (stderr,
	       m->kind == FAST_MUTEX
	       ? "locking wrong mutex type\n"
	       : "locking uninitialized mutex\n");
      abort ();
    }
  if (m->count == 0)
    {
      fprintf (stderr, "unlocking unlocked mutex\n");
      abort ();
    }
#endif
  if (!--m->count)
    {
      m->owner = 0;
      scm_i_plugin_mutex_unlock (&m->mutex);
    }
  scm_i_plugin_mutex_unlock (&rec_mutex_mutex);
  return 0;
}

#endif /* !PTHREAD_MUTEX_RECURSIVE */

#ifndef SCM_MUTEXATTR_SETTYPE_DECLARED
int pthread_mutexattr_settype (pthread_mutexattr_t *, int);
#endif

void
scm_init_pthread_threads ()
{
  size_t mutex_size, rec_mutex_size;
  pthread_mutexattr_init (&scm_i_plugin_mutex);
#ifdef SCM_MUTEX_FAST
  pthread_mutexattr_settype (&scm_i_plugin_mutex, SCM_MUTEX_FAST);
#endif

#if defined (SCM_MUTEX_RECURSIVE) && !defined (SCM_DEBUG_THREADS)
  rec_mutex_size = sizeof (pthread_mutex_t);
  pthread_mutexattr_init (&scm_i_plugin_rec_mutex);
  pthread_mutexattr_settype (&scm_i_plugin_rec_mutex, SCM_MUTEX_RECURSIVE);
#else
  /* If PTHREAD_MUTEX_RECURSIVE is not defined,
     scm_i_plugin_rec_mutex_init won't pay attention to it anyway
  */
  rec_mutex_size = sizeof (rec_mutex);
  scm_i_plugin_mutex_init (&rec_mutex_mutex, &scm_i_plugin_mutex);
#endif
#ifdef SCM_DEBUG_THREADS
  mutex_size = sizeof (mutex);
  pthread_mutex_init (&mutex_mutex, &scm_i_plugin_mutex);
#else
  mutex_size = sizeof (pthread_mutex_t);
#endif
  if (mutex_size > SCM_MUTEX_MAXSIZE || rec_mutex_size > SCM_REC_MUTEX_MAXSIZE)
    {
      fprintf (stderr, "Internal error: Need to upgrade mutex size\n");
      abort ();
    }
}

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/
Commit	Line	Data
93cd4dcd MD	1	/* Copyright (C) 2002 Free Software Foundation, Inc.
	2	*
	3	* This program is free software; you can redistribute it and/or modify
	4	* it under the terms of the GNU General Public License as published by
	5	* the Free Software Foundation; either version 2, or (at your option)
	6	* any later version.
	7	*
	8	* This program is distributed in the hope that it will be useful,
	9	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	10	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	11	* GNU General Public License for more details.
	12	*
	13	* You should have received a copy of the GNU General Public License
	14	* along with this software; see the file COPYING. If not, write to
	15	* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
	16	* Boston, MA 02111-1307 USA
	17	*
	18	* As a special exception, the Free Software Foundation gives permission
	19	* for additional uses of the text contained in its release of GUILE.
	20	*
	21	* The exception is that, if you link the GUILE library with other files
	22	* to produce an executable, this does not by itself cause the
	23	* resulting executable to be covered by the GNU General Public License.
	24	* Your use of that executable is in no way restricted on account of
	25	* linking the GUILE library code into it.
	26	*
	27	* This exception does not however invalidate any other reasons why
	28	* the executable file might be covered by the GNU General Public License.
	29	*
	30	* This exception applies only to the code released by the
	31	* Free Software Foundation under the name GUILE. If you copy
	32	* code from other Free Software Foundation releases into a copy of
	33	* GUILE, as the General Public License permits, the exception does
	34	* not apply to the code that you add in this way. To avoid misleading
	35	* anyone as to the status of such modified files, you must delete
	36	* this exception notice from them.
	37	*
	38	* If you write modifications of your own for GUILE, it is your choice
	39	* whether to permit this exception to apply to your modifications.
	40	* If you do not wish that, delete this exception notice. */
	41
	42
	43	\f
	44
	45	#include "libguile/scmconfig.h"
	46
	47	scm_t_mutexattr scm_i_plugin_mutex;
	48
	49	scm_t_mutexattr scm_i_plugin_rec_mutex;
	50
0b6843b1 MD	51	#if !defined (SCM_MUTEX_RECURSIVE) \|\| defined (SCM_DEBUG_THREADS)
0b6843b1 MD	52
93cd4dcd	53	typedef struct rec_mutex {
0b6843b1 MD	54	#ifdef SCM_DEBUG_THREADS
	55	int kind;
	56	#endif
93cd4dcd MD	57	scm_t_mutex mutex;
	58	scm_thread *owner;
	59	int count;
	60	} rec_mutex;
	61
	62	/* Mutex for recursive mutex administration */
	63	static scm_t_mutex rec_mutex_mutex;
	64
0b6843b1 MD	65	#ifdef SCM_DEBUG_THREADS
	66
	67	#define FAST_MUTEX 1
	68	#define REC_MUTEX 2
	69
	70	typedef struct mutex {
0b6843b1	71	int kind;
0b6843b1 MD	72	pthread_mutex_t mutex;
	73	scm_thread *owner;
	74	int count;
	75	} mutex;
	76
	77	static pthread_mutex_t mutex_mutex;
	78
	79	int
	80	scm_i_plugin_mutex_init (scm_t_mutex mx, const scm_t_mutexattr a)
	81	{
	82	mutex m = (mutex ) mx;
	83	pthread_mutex_init (&m->mutex, &scm_i_plugin_mutex);
	84	m->owner = 0;
	85	m->count = 0;
	86	m->kind = FAST_MUTEX;
	87	return 0;
	88	}
	89
	90	int
	91	scm_i_plugin_mutex_lock (scm_t_mutex *mx)
	92	{
	93	mutex m = (mutex ) mx;
	94	scm_thread *t = SCM_CURRENT_THREAD;
	95	pthread_mutex_lock (&mutex_mutex);
	96	if (m->kind != FAST_MUTEX)
	97	{
	98	fprintf (stderr,
	99	m->kind == REC_MUTEX
	100	? "locking wrong mutex type\n"
	101	: "locking uninitialized mutex\n");
	102	abort ();
	103	}
	104	if (m->owner == t)
	105	{
	106	fprintf (stderr, "locking mutex already locked by self\n");
	107	abort ();
	108	}
	109	pthread_mutex_unlock (&mutex_mutex);
	110	pthread_mutex_lock (&m->mutex);
	111	m->count = 1;
	112	m->owner = t;
	113	return 0;
	114	}
	115
	116	int
	117	scm_i_plugin_mutex_unlock (scm_t_mutex *mx)
	118	{
	119	mutex m = (mutex ) mx;
	120	pthread_mutex_lock (&mutex_mutex);
	121	if (m->kind != FAST_MUTEX)
	122	{
	123	fprintf (stderr,
	124	m->kind == REC_MUTEX
	125	? "locking wrong mutex type\n"
	126	: "locking uninitialized mutex\n");
	127	abort ();
	128	}
	129	if (m->count != 1)
	130	{
	131	fprintf (stderr,
	132	m->count == 0
	133	? "unlocking unlocked mutex\n"
	134	: "bogus internal state");
	135	abort ();
136	}
137	m->owner = 0;
138	m->count = 0;
139	pthread_mutex_unlock (&m->mutex);
140	pthread_mutex_unlock (&mutex_mutex);
141	return 0;
142	}
6da2dfc4 MD	143
	144	int
	145	scm_i_plugin_cond_wait (scm_t_cond c, scm_t_mutex mx)
	146	{
	147	mutex m = (mutex ) mx;
e29e0b09 MD	148	int res;
	149	if (m->owner != SCM_CURRENT_THREAD \|\| m->count != 1)
	150	{
	151	fprintf (stderr, "mutex not locked by self\n");
	152	abort ();
	153	}
	154	res = pthread_cond_wait ((pthread_cond_t *) c, &m->mutex);
	155	if (m->owner != 0 \|\| m->count != 0)
	156	{
	157	fprintf (stderr, "strange internal state\n");
	158	abort ();
	159	}
	160	m->owner = SCM_CURRENT_THREAD;
	161	m->count = 1;
	162	return res;
6da2dfc4 MD	163	}
	164
	165	int
dad98102	166	scm_i_plugin_cond_timedwait (scm_t_cond *c,
6da2dfc4 MD	167	scm_t_mutex *mx,
	168	const struct timespec *t)
	169	{
	170	mutex m = (mutex ) mx;
dad98102	171	return pthread_cond_timedwait ((pthread_cond_t *) c, &m->mutex, t);
6da2dfc4 MD	172	}
6da2dfc4 MD	173
e29e0b09 MD	174	void
	175	scm_i_assert_heap_locked ()
	176	{
	177	mutex m = (mutex ) &SCM_CURRENT_THREAD->heap_mutex;
	178	pthread_mutex_lock (&mutex_mutex);
	179	if (gc_running)
	180	{
	181	fprintf (stderr, "thread running during gc\n");
	182	abort ();
	183	}
	184	if (m->count != 1)
	185	{
	186	fprintf (stderr, "mutex not locked\n");
	187	abort ();
	188	}
	189	pthread_mutex_unlock (&mutex_mutex);
	190	}
	191
0b6843b1 MD	192	#endif
	193
	194	/* The following section belongs in threads.c, or rather
	195	thread-plugin.c. It is generic and not tied to any particular
	196	thread library. */
	197
93cd4dcd MD	198	int
	199	scm_i_plugin_rec_mutex_init (scm_t_rec_mutex mx, const scm_t_mutexattr a)
	200	{
	201	rec_mutex m = (rec_mutex ) mx;
	202	scm_i_plugin_mutex_init (&m->mutex, &scm_i_plugin_mutex);
	203	m->owner = 0;
	204	m->count = 0;
0b6843b1 MD	205	#ifdef SCM_DEBUG_THREADS
	206	m->kind = REC_MUTEX;
	207	#endif
93cd4dcd MD	208	return 0;
	209	}
	210
	211	int
	212	scm_i_plugin_rec_mutex_lock (scm_t_rec_mutex *mx)
	213	{
	214	rec_mutex m = (rec_mutex ) mx;
	215	scm_thread *t = SCM_CURRENT_THREAD;
	216	scm_i_plugin_mutex_lock (&rec_mutex_mutex);
0b6843b1 MD	217	#ifdef SCM_DEBUG_THREADS
	218	if (m->kind != REC_MUTEX)
	219	{
	220	fprintf (stderr,
	221	m->kind == FAST_MUTEX
	222	? "locking wrong mutex type\n"
	223	: "locking uninitialized mutex\n");
	224	abort ();
	225	}
	226	#endif
93cd4dcd MD	227	if (m->count && m->owner == t)
	228	{
	229	++m->count;
	230	scm_i_plugin_mutex_unlock (&rec_mutex_mutex);
	231	}
	232	else
	233	{
	234	scm_i_plugin_mutex_unlock (&rec_mutex_mutex);
	235	scm_i_plugin_mutex_lock (&m->mutex);
	236	m->count = 1;
	237	m->owner = t;
	238	}
	239	return 0;
	240	}
	241
	242	int
	243	scm_i_plugin_rec_mutex_trylock (scm_t_rec_mutex *mx)
	244	{
	245	rec_mutex m = (rec_mutex ) mx;
	246	scm_thread *t = SCM_CURRENT_THREAD;
	247	scm_i_plugin_mutex_lock (&rec_mutex_mutex);
	248	if (m->owner != 0 && m->owner != t)
	249	return EBUSY;
	250	else if (m->count)
	251	{
	252	++m->count;
	253	scm_i_plugin_mutex_unlock (&rec_mutex_mutex);
	254	}
	255	else
	256	{
	257	scm_i_plugin_mutex_unlock (&rec_mutex_mutex);
	258	scm_i_plugin_mutex_lock (&m->mutex);
	259	m->count = 1;
	260	m->owner = t;
	261	}
	262	return 0;
	263	}
	264
	265	int
	266	scm_i_plugin_rec_mutex_unlock (scm_t_rec_mutex *mx)
	267	{
	268	rec_mutex m = (rec_mutex ) mx;
	269	scm_i_plugin_mutex_lock (&rec_mutex_mutex);
0b6843b1 MD	270	#ifdef SCM_DEBUG_THREADS
	271	if (m->kind != REC_MUTEX)
	272	{
	273	fprintf (stderr,
	274	m->kind == FAST_MUTEX
	275	? "locking wrong mutex type\n"
	276	: "locking uninitialized mutex\n");
	277	abort ();
	278	}
	279	if (m->count == 0)
	280	{
	281	fprintf (stderr, "unlocking unlocked mutex\n");
	282	abort ();
	283	}
	284	#endif
93cd4dcd MD	285	if (!--m->count)
	286	{
	287	m->owner = 0;
	288	scm_i_plugin_mutex_unlock (&m->mutex);
	289	}
	290	scm_i_plugin_mutex_unlock (&rec_mutex_mutex);
	291	return 0;
	292	}
	293
	294	#endif /* !PTHREAD_MUTEX_RECURSIVE */
	295
	296	#ifndef SCM_MUTEXATTR_SETTYPE_DECLARED
	297	int pthread_mutexattr_settype (pthread_mutexattr_t *, int);
	298	#endif
	299
	300	void
	301	scm_init_pthread_threads ()
	302	{
e29e0b09	303	size_t mutex_size, rec_mutex_size;
93cd4dcd MD	304	pthread_mutexattr_init (&scm_i_plugin_mutex);
	305	#ifdef SCM_MUTEX_FAST
	306	pthread_mutexattr_settype (&scm_i_plugin_mutex, SCM_MUTEX_FAST);
	307	#endif
	308
0b6843b1	309	#if defined (SCM_MUTEX_RECURSIVE) && !defined (SCM_DEBUG_THREADS)
e29e0b09 MD	310	rec_mutex_size = sizeof (pthread_mutex_t);
e29e0b09 MD	311	pthread_mutexattr_init (&scm_i_plugin_rec_mutex);
93cd4dcd MD	312	pthread_mutexattr_settype (&scm_i_plugin_rec_mutex, SCM_MUTEX_RECURSIVE);
	313	#else
	314	/* If PTHREAD_MUTEX_RECURSIVE is not defined,
	315	scm_i_plugin_rec_mutex_init won't pay attention to it anyway
	316	*/
e29e0b09	317	rec_mutex_size = sizeof (rec_mutex);
93cd4dcd MD	318	scm_i_plugin_mutex_init (&rec_mutex_mutex, &scm_i_plugin_mutex);
93cd4dcd MD	319	#endif
0b6843b1	320	#ifdef SCM_DEBUG_THREADS
e29e0b09	321	mutex_size = sizeof (mutex);
0b6843b1	322	pthread_mutex_init (&mutex_mutex, &scm_i_plugin_mutex);
e29e0b09 MD	323	#else
e29e0b09 MD	324	mutex_size = sizeof (pthread_mutex_t);
0b6843b1	325	#endif
e29e0b09 MD	326	if (mutex_size > SCM_MUTEX_MAXSIZE \|\| rec_mutex_size > SCM_REC_MUTEX_MAXSIZE)
	327	{
	328	fprintf (stderr, "Internal error: Need to upgrade mutex size\n");
	329	abort ();
	330	}
93cd4dcd MD	331	}
	332
	333	/*
	334	Local Variables:
	335	c-file-style: "gnu"
	336	End:
	337	*/