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

/* Copyright (C) 2002 Free Software Foundation, Inc.
 * 
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version.
 *
 * This library 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
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 */


\f

#include "libguile/validate.h"
#include "libguile/root.h"
#include "libguile/stackchk.h"
#include "libguile/async.h"
#include <sys/time.h>
#include <sys/types.h>
#include <time.h>
#include <stdio.h>

void *scm_null_threads_data;

static SCM main_thread;

typedef struct {
  int level;
} scm_null_mutex;

typedef struct {
  int signalled;
} scm_null_cond;

void
scm_threads_init (SCM_STACKITEM *i)
{
  scm_tc16_thread = scm_make_smob_type ("thread", 0);
  scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (scm_null_mutex));
  scm_tc16_condvar = scm_make_smob_type ("condition-variable",
					 sizeof (scm_null_cond));

  main_thread = scm_permanent_object (scm_cell (scm_tc16_thread, 0));
  scm_null_threads_data = NULL;
}

#ifdef __ia64__
# define SCM_MARK_BACKING_STORE() do {                                \
    ucontext_t ctx;                                                   \
    SCM_STACKITEM * top, * bot;                                       \
    getcontext (&ctx);                                                \
    scm_mark_locations ((SCM_STACKITEM *) &ctx.uc_mcontext,           \
      ((size_t) (sizeof (SCM_STACKITEM) - 1 + sizeof ctx.uc_mcontext) \
       / sizeof (SCM_STACKITEM)));                                    \
    bot = (SCM_STACKITEM *) __libc_ia64_register_backing_store_base;  \
    top = (SCM_STACKITEM *) ctx.uc_mcontext.sc_ar_bsp;                \
    scm_mark_locations (bot, top - bot); } while (0)
#else
# define SCM_MARK_BACKING_STORE()
#endif

void
scm_threads_mark_stacks (void)
{
  /* Mark objects on the C stack. */
  SCM_FLUSH_REGISTER_WINDOWS;
  /* This assumes that all registers are saved into the jmp_buf */
  setjmp (scm_save_regs_gc_mark);
  scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark,
		      (   (size_t) (sizeof (SCM_STACKITEM) - 1 +
				       sizeof scm_save_regs_gc_mark)
			  / sizeof (SCM_STACKITEM)));

  {
    unsigned long stack_len = scm_stack_size (scm_stack_base);
#if SCM_STACK_GROWS_UP
    scm_mark_locations (scm_stack_base, stack_len);
#else
    scm_mark_locations (scm_stack_base - stack_len, stack_len);
#endif
  }
  SCM_MARK_BACKING_STORE();
}

SCM
scm_call_with_new_thread (SCM argl)
#define FUNC_NAME s_call_with_new_thread
{
  SCM_MISC_ERROR ("threads are not supported in this version of Guile",
		  SCM_EOL);
  return SCM_BOOL_F;
}
#undef FUNC_NAME

SCM
scm_spawn_thread (scm_t_catch_body body, void *body_data,
		  scm_t_catch_handler handler, void *handler_data)
{
  scm_misc_error ("scm_spawn_thread", 
		  "threads are not supported in this version of Guile",
		  SCM_EOL);
  return SCM_BOOL_F;
}

SCM
scm_current_thread (void)
{
  return main_thread;
}

SCM
scm_all_threads (void)
{
  return scm_list_1 (main_thread);
}

scm_root_state *
scm_i_thread_root (SCM thread)
{
  return (scm_root_state *)scm_null_threads_data;
}

SCM
scm_join_thread (SCM thread)
#define FUNC_NAME s_join_thread
{
  SCM_MISC_ERROR ("threads are not supported in this version of Guile",
		  SCM_EOL);
  return SCM_BOOL_F;
}
#undef FUNC_NAME

int
scm_c_thread_exited_p (SCM thread)
#define FUNC_NAME s_scm_thread_exited_p
{
  return 0;
}
#undef FUNC_NAME

SCM
scm_yield (void)
{
  return SCM_BOOL_T;
}

SCM
scm_make_mutex (void)
{
  SCM m = scm_make_smob (scm_tc16_mutex);
  scm_null_mutex *mx = SCM_MUTEX_DATA(m);
  mx->level = 0;
  return m;
}

SCM
scm_lock_mutex (SCM m)
{
  scm_null_mutex *mx;
  SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex);
  mx = SCM_MUTEX_DATA(m);
  mx->level++;
  return SCM_BOOL_T;
}

SCM
scm_try_mutex (SCM m)
{
  return scm_lock_mutex (m); /* will always succeed right away. */
}

SCM
scm_unlock_mutex (SCM m)
{
  scm_null_mutex *mx;
  SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex);
  mx = SCM_MUTEX_DATA(m);
  if (mx->level == 0)
    scm_misc_error (s_unlock_mutex, "mutex is not locked", SCM_EOL);
  mx->level--;
  return SCM_BOOL_T;
}

SCM
scm_make_condition_variable (void)
{
  scm_null_cond *cv;
  SCM c = scm_make_smob (scm_tc16_condvar);
  cv = SCM_CONDVAR_DATA (c);
  cv->signalled = 0;
  return c;
}

/* Subtract the `struct timeval' values X and Y,
   storing the result in RESULT.  Might modify Y.
   Return 1 if the difference is negative or zero, otherwise 0.  */

static int
timeval_subtract (result, x, y)
     struct timeval *result, *x, *y;
{
  /* Perform the carry for the later subtraction by updating Y. */
  if (x->tv_usec < y->tv_usec) {
    int nsec = (y->tv_usec - x->tv_usec) / 1000000 + 1;
    y->tv_usec -= 1000000 * nsec;
    y->tv_sec += nsec;
  }
  if (x->tv_usec - y->tv_usec > 1000000) {
    int nsec = (x->tv_usec - y->tv_usec) / 1000000;
    y->tv_usec += 1000000 * nsec;
    y->tv_sec -= nsec;
  }
  
  /* Compute the time remaining to wait.
     `tv_usec' is certainly positive. */
  result->tv_sec = x->tv_sec - y->tv_sec;
  result->tv_usec = x->tv_usec - y->tv_usec;
  
  /* Return 1 if result is negative or zero. */
  return x->tv_sec < y->tv_sec
    || (result->tv_sec == 0 && result->tv_usec == 0);
}

SCM
scm_timed_wait_condition_variable (SCM c, SCM m, SCM t)
#define FUNC_NAME s_wait_condition_variable
{
  scm_null_cond *cv;
  struct timeval waittime;

  SCM_ASSERT (SCM_CONDVARP (c),
	      c,
	      SCM_ARG1,
	      s_wait_condition_variable);
  SCM_ASSERT (SCM_MUTEXP (m),
	      m,
	      SCM_ARG2,
	      s_wait_condition_variable);
  if (!SCM_UNBNDP (t))
    {
      if (scm_is_pair (t))
	{
	  SCM_VALIDATE_UINT_COPY (3, SCM_CAR(t), waittime.tv_sec);
	  SCM_VALIDATE_UINT_COPY (3, SCM_CDR(t), waittime.tv_usec);
	}
      else
	{
	  SCM_VALIDATE_UINT_COPY (3, t, waittime.tv_sec);
	  waittime.tv_usec = 0;
	}
    }

  cv = SCM_CONDVAR_DATA (c);

  scm_unlock_mutex (m);
  while (!cv->signalled)
    {
      if (SCM_UNBNDP (t))
	select (0, NULL, NULL, NULL, NULL);
      else
	{
	  struct timeval now, then, diff;
	  then = waittime;
	  gettimeofday (&now, NULL);
	  if (timeval_subtract (&diff, &then, &now))
	    break;
	  select (0, NULL, NULL, NULL, &diff);
	}
      SCM_ASYNC_TICK;
    }
  scm_lock_mutex (m);
  if (cv->signalled)
    {
      cv->signalled = 0;
      return SCM_BOOL_T;
    }
  return SCM_BOOL_F;
}
#undef FUNC_NAME

SCM
scm_signal_condition_variable (SCM c)
{
  scm_null_cond *cv;
  SCM_ASSERT (SCM_CONDVARP (c),
	      c,
	      SCM_ARG1,
	      s_signal_condition_variable);
  cv = SCM_CONDVAR_DATA (c);
  cv->signalled = 1;
  return SCM_BOOL_T;
}

SCM
scm_broadcast_condition_variable (SCM c)
{
  return scm_signal_condition_variable (c); /* only one thread anyway. */
}

unsigned long 
scm_thread_usleep (unsigned long usec)
{
  struct timeval timeout;
  timeout.tv_sec = 0;
  timeout.tv_usec = usec;
  select (0, NULL, NULL, NULL, &timeout);
  return 0;  /* Maybe we should calculate actual time slept,
		but this is faster... :) */
}

unsigned long
scm_thread_sleep (unsigned long sec)
{
  time_t now = time (NULL);
  struct timeval timeout;
  unsigned long slept;
  timeout.tv_sec = sec;
  timeout.tv_usec = 0;
  select (0, NULL, NULL, NULL, &timeout);
  slept = time (NULL) - now;
  return slept > sec ? 0 : sec - slept;
}

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/
Commit	Line	Data
3d527b27 MV	1	/* Copyright (C) 2002 Free Software Foundation, Inc.
3d527b27 MV	2	*
73be1d9e MV	3	* This library is free software; you can redistribute it and/or
	4	* modify it under the terms of the GNU Lesser General Public
	5	* License as published by the Free Software Foundation; either
	6	* version 2.1 of the License, or (at your option) any later version.
3d527b27	7	*
73be1d9e MV	8	* This library 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 GNU
	11	* Lesser General Public License for more details.
3d527b27	12	*
73be1d9e MV	13	* You should have received a copy of the GNU Lesser General Public
	14	* License along with this library; if not, write to the Free Software
	15	* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	16	*/
3d527b27 MV	17
	18
	19	\f
	20
	21	#include "libguile/validate.h"
	22	#include "libguile/root.h"
	23	#include "libguile/stackchk.h"
	24	#include "libguile/async.h"
64e00566 MV	25	#include <sys/time.h>
	26	#include <sys/types.h>
	27	#include <time.h>
4b9154e7	28	#include <stdio.h>
3d527b27 MV	29
	30	void *scm_null_threads_data;
	31
	32	static SCM main_thread;
	33
4b9154e7 MV	34	typedef struct {
	35	int level;
	36	} scm_null_mutex;
	37
	38	typedef struct {
	39	int signalled;
	40	} scm_null_cond;
	41
3d527b27 MV	42	void
	43	scm_threads_init (SCM_STACKITEM *i)
	44	{
4b9154e7 MV	45	scm_tc16_thread = scm_make_smob_type ("thread", 0);
	46	scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (scm_null_mutex));
	47	scm_tc16_condvar = scm_make_smob_type ("condition-variable",
	48	sizeof (scm_null_cond));
	49
3d527b27 MV	50	main_thread = scm_permanent_object (scm_cell (scm_tc16_thread, 0));
	51	scm_null_threads_data = NULL;
	52	}
	53
	54	#ifdef __ia64__
	55	# define SCM_MARK_BACKING_STORE() do { \
	56	ucontext_t ctx; \
	57	SCM_STACKITEM * top, * bot; \
	58	getcontext (&ctx); \
	59	scm_mark_locations ((SCM_STACKITEM *) &ctx.uc_mcontext, \
	60	((size_t) (sizeof (SCM_STACKITEM) - 1 + sizeof ctx.uc_mcontext) \
	61	/ sizeof (SCM_STACKITEM))); \
	62	bot = (SCM_STACKITEM *) __libc_ia64_register_backing_store_base; \
	63	top = (SCM_STACKITEM *) ctx.uc_mcontext.sc_ar_bsp; \
	64	scm_mark_locations (bot, top - bot); } while (0)
	65	#else
	66	# define SCM_MARK_BACKING_STORE()
	67	#endif
	68
	69	void
	70	scm_threads_mark_stacks (void)
	71	{
	72	/* Mark objects on the C stack. */
	73	SCM_FLUSH_REGISTER_WINDOWS;
	74	/* This assumes that all registers are saved into the jmp_buf */
	75	setjmp (scm_save_regs_gc_mark);
	76	scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark,
	77	( (size_t) (sizeof (SCM_STACKITEM) - 1 +
	78	sizeof scm_save_regs_gc_mark)
	79	/ sizeof (SCM_STACKITEM)));
	80
	81	{
	82	unsigned long stack_len = scm_stack_size (scm_stack_base);
b075613e	83	#if SCM_STACK_GROWS_UP
3d527b27 MV	84	scm_mark_locations (scm_stack_base, stack_len);
	85	#else
	86	scm_mark_locations (scm_stack_base - stack_len, stack_len);
	87	#endif
	88	}
	89	SCM_MARK_BACKING_STORE();
	90	}
	91
	92	SCM
	93	scm_call_with_new_thread (SCM argl)
	94	#define FUNC_NAME s_call_with_new_thread
	95	{
	96	SCM_MISC_ERROR ("threads are not supported in this version of Guile",
	97	SCM_EOL);
	98	return SCM_BOOL_F;
	99	}
	100	#undef FUNC_NAME
	101
	102	SCM
	103	scm_spawn_thread (scm_t_catch_body body, void *body_data,
	104	scm_t_catch_handler handler, void *handler_data)
	105	{
	106	scm_misc_error ("scm_spawn_thread",
	107	"threads are not supported in this version of Guile",
	108	SCM_EOL);
	109	return SCM_BOOL_F;
	110	}
	111
	112	SCM
	113	scm_current_thread (void)
	114	{
	115	return main_thread;
	116	}
	117
	118	SCM
	119	scm_all_threads (void)
	120	{
	121	return scm_list_1 (main_thread);
	122	}
	123
	124	scm_root_state *
	125	scm_i_thread_root (SCM thread)
	126	{
	127	return (scm_root_state *)scm_null_threads_data;
	128	}
	129
	130	SCM
	131	scm_join_thread (SCM thread)
	132	#define FUNC_NAME s_join_thread
	133	{
	134	SCM_MISC_ERROR ("threads are not supported in this version of Guile",
	135	SCM_EOL);
	136	return SCM_BOOL_F;
	137	}
	138	#undef FUNC_NAME
	139
3d527b27	140	int
4b9154e7 MV	141	scm_c_thread_exited_p (SCM thread)
4b9154e7 MV	142	#define FUNC_NAME s_scm_thread_exited_p
3d527b27	143	{
3d527b27 MV	144	return 0;
3d527b27 MV	145	}
4b9154e7	146	#undef FUNC_NAME
3d527b27	147
4b9154e7 MV	148	SCM
4b9154e7 MV	149	scm_yield (void)
3d527b27	150	{
4b9154e7	151	return SCM_BOOL_T;
3d527b27 MV	152	}
	153
	154	SCM
	155	scm_make_mutex (void)
	156	{
	157	SCM m = scm_make_smob (scm_tc16_mutex);
4b9154e7 MV	158	scm_null_mutex *mx = SCM_MUTEX_DATA(m);
4b9154e7 MV	159	mx->level = 0;
3d527b27 MV	160	return m;
	161	}
	162
	163	SCM
	164	scm_lock_mutex (SCM m)
	165	{
4b9154e7	166	scm_null_mutex *mx;
3d527b27	167	SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex);
4b9154e7 MV	168	mx = SCM_MUTEX_DATA(m);
4b9154e7 MV	169	mx->level++;
3d527b27 MV	170	return SCM_BOOL_T;
	171	}
	172
4b9154e7 MV	173	SCM
	174	scm_try_mutex (SCM m)
	175	{
	176	return scm_lock_mutex (m); /* will always succeed right away. */
	177	}
	178
3d527b27 MV	179	SCM
	180	scm_unlock_mutex (SCM m)
	181	{
4b9154e7	182	scm_null_mutex *mx;
3d527b27	183	SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex);
4b9154e7 MV	184	mx = SCM_MUTEX_DATA(m);
4b9154e7 MV	185	if (mx->level == 0)
3d527b27	186	scm_misc_error (s_unlock_mutex, "mutex is not locked", SCM_EOL);
4b9154e7	187	mx->level--;
3d527b27 MV	188	return SCM_BOOL_T;
	189	}
	190
4b9154e7 MV	191	SCM
4b9154e7 MV	192	scm_make_condition_variable (void)
3d527b27	193	{
4b9154e7 MV	194	scm_null_cond *cv;
	195	SCM c = scm_make_smob (scm_tc16_condvar);
	196	cv = SCM_CONDVAR_DATA (c);
	197	cv->signalled = 0;
	198	return c;
3d527b27 MV	199	}
3d527b27 MV	200
4b9154e7 MV	201	/* Subtract the `struct timeval' values X and Y,
	202	storing the result in RESULT. Might modify Y.
	203	Return 1 if the difference is negative or zero, otherwise 0. */
3d527b27	204
4b9154e7 MV	205	static int
	206	timeval_subtract (result, x, y)
	207	struct timeval result, x, *y;
3d527b27	208	{
4b9154e7 MV	209	/* Perform the carry for the later subtraction by updating Y. */
	210	if (x->tv_usec < y->tv_usec) {
	211	int nsec = (y->tv_usec - x->tv_usec) / 1000000 + 1;
	212	y->tv_usec -= 1000000 * nsec;
	213	y->tv_sec += nsec;
	214	}
	215	if (x->tv_usec - y->tv_usec > 1000000) {
	216	int nsec = (x->tv_usec - y->tv_usec) / 1000000;
	217	y->tv_usec += 1000000 * nsec;
	218	y->tv_sec -= nsec;
	219	}
	220
	221	/* Compute the time remaining to wait.
	222	`tv_usec' is certainly positive. */
	223	result->tv_sec = x->tv_sec - y->tv_sec;
	224	result->tv_usec = x->tv_usec - y->tv_usec;
	225
	226	/* Return 1 if result is negative or zero. */
	227	return x->tv_sec < y->tv_sec
	228	\|\| (result->tv_sec == 0 && result->tv_usec == 0);
3d527b27 MV	229	}
	230
	231	SCM
4b9154e7 MV	232	scm_timed_wait_condition_variable (SCM c, SCM m, SCM t)
4b9154e7 MV	233	#define FUNC_NAME s_wait_condition_variable
3d527b27	234	{
4b9154e7 MV	235	scm_null_cond *cv;
4b9154e7 MV	236	struct timeval waittime;
3d527b27	237
3d527b27 MV	238	SCM_ASSERT (SCM_CONDVARP (c),
	239	c,
	240	SCM_ARG1,
	241	s_wait_condition_variable);
	242	SCM_ASSERT (SCM_MUTEXP (m),
	243	m,
	244	SCM_ARG2,
	245	s_wait_condition_variable);
4b9154e7 MV	246	if (!SCM_UNBNDP (t))
4b9154e7 MV	247	{
d2e53ed6	248	if (scm_is_pair (t))
4b9154e7 MV	249	{
	250	SCM_VALIDATE_UINT_COPY (3, SCM_CAR(t), waittime.tv_sec);
	251	SCM_VALIDATE_UINT_COPY (3, SCM_CDR(t), waittime.tv_usec);
	252	}
	253	else
	254	{
	255	SCM_VALIDATE_UINT_COPY (3, t, waittime.tv_sec);
	256	waittime.tv_usec = 0;
	257	}
	258	}
	259
	260	cv = SCM_CONDVAR_DATA (c);
	261
	262	scm_unlock_mutex (m);
	263	while (!cv->signalled)
	264	{
	265	if (SCM_UNBNDP (t))
	266	select (0, NULL, NULL, NULL, NULL);
	267	else
	268	{
	269	struct timeval now, then, diff;
	270	then = waittime;
	271	gettimeofday (&now, NULL);
	272	if (timeval_subtract (&diff, &then, &now))
	273	break;
	274	select (0, NULL, NULL, NULL, &diff);
	275	}
	276	SCM_ASYNC_TICK;
	277	}
	278	scm_lock_mutex (m);
	279	if (cv->signalled)
	280	{
	281	cv->signalled = 0;
	282	return SCM_BOOL_T;
	283	}
	284	return SCM_BOOL_F;
3d527b27	285	}
4b9154e7	286	#undef FUNC_NAME
3d527b27 MV	287
	288	SCM
	289	scm_signal_condition_variable (SCM c)
	290	{
4b9154e7	291	scm_null_cond *cv;
3d527b27 MV	292	SCM_ASSERT (SCM_CONDVARP (c),
	293	c,
	294	SCM_ARG1,
	295	s_signal_condition_variable);
4b9154e7 MV	296	cv = SCM_CONDVAR_DATA (c);
4b9154e7 MV	297	cv->signalled = 1;
3d527b27 MV	298	return SCM_BOOL_T;
	299	}
	300
4b9154e7 MV	301	SCM
	302	scm_broadcast_condition_variable (SCM c)
	303	{
	304	return scm_signal_condition_variable (c); /* only one thread anyway. */
	305	}
	306
3d527b27 MV	307	unsigned long
	308	scm_thread_usleep (unsigned long usec)
	309	{
	310	struct timeval timeout;
	311	timeout.tv_sec = 0;
	312	timeout.tv_usec = usec;
	313	select (0, NULL, NULL, NULL, &timeout);
	314	return 0; /* Maybe we should calculate actual time slept,
	315	but this is faster... :) */
	316	}
	317
	318	unsigned long
	319	scm_thread_sleep (unsigned long sec)
	320	{
	321	time_t now = time (NULL);
	322	struct timeval timeout;
	323	unsigned long slept;
	324	timeout.tv_sec = sec;
	325	timeout.tv_usec = 0;
	326	select (0, NULL, NULL, NULL, &timeout);
	327	slept = time (NULL) - now;
	328	return slept > sec ? 0 : sec - slept;
	329	}
	330
	331	/*
	332	Local Variables:
	333	c-file-style: "gnu"
	334	End:
	335	*/