enqueue (SCM q, SCM t)
{
SCM c = scm_cons (t, SCM_EOL);
- if (SCM_NULLP (SCM_CDR (q)))
+ if (scm_is_null (SCM_CDR (q)))
SCM_SETCDR (q, c);
else
SCM_SETCDR (SCM_CAR (q), c);
remqueue (SCM q, SCM c)
{
SCM p, prev = q;
- for (p = SCM_CDR (q); !SCM_NULLP (p); p = SCM_CDR (p))
+ for (p = SCM_CDR (q); !scm_is_null (p); p = SCM_CDR (p))
{
- if (SCM_EQ_P (p, c))
+ if (scm_is_eq (p, c))
{
- if (SCM_EQ_P (c, SCM_CAR (q)))
+ if (scm_is_eq (c, SCM_CAR (q)))
SCM_SETCAR (q, SCM_CDR (c));
SCM_SETCDR (prev, SCM_CDR (c));
return;
dequeue (SCM q)
{
SCM c = SCM_CDR (q);
- if (SCM_NULLP (c))
+ if (scm_is_null (c))
return SCM_BOOL_F;
else
{
SCM_SETCDR (q, SCM_CDR (c));
- if (SCM_NULLP (SCM_CDR (q)))
+ if (scm_is_null (SCM_CDR (q)))
SCM_SETCAR (q, SCM_EOL);
return SCM_CAR (c);
}
{
scm_thread *t = SCM_THREAD_DATA (exp);
scm_puts ("#<thread ", port);
- scm_intprint ((unsigned long)t->thread, 10, port);
+ scm_uintprint ((size_t)t->thread, 10, port);
scm_puts (" (", port);
- scm_intprint ((unsigned long)t, 16, port);
+ scm_uintprint ((scm_t_bits)t, 16, port);
scm_puts (")>", port);
return 1;
}
SCM res;
SCM_VALIDATE_THREAD (1, thread);
- if (SCM_EQ_P (cur_thread, thread))
+ if (scm_is_eq (cur_thread, thread))
SCM_MISC_ERROR ("can not join the current thread", SCM_EOL);
t = SCM_THREAD_DATA (thread);
if (!SCM_UNBNDP (t))
{
- if (SCM_CONSP (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_nsec);
scm_threads_mark_stacks (void)
{
volatile SCM c;
- for (c = all_threads; !SCM_NULLP (c); c = SCM_CDR (c))
+
+ for (c = all_threads; !scm_is_null (c); c = SCM_CDR (c))
{
scm_thread *t = SCM_THREAD_DATA (SCM_CAR (c));
if (!THREAD_INITIALIZED_P (t))
/* Not fully initialized yet. */
continue;
}
+
if (t->top == NULL)
{
- long stack_len;
-#ifdef SCM_DEBUG
- if (t->thread != scm_thread_self ())
- abort ();
-#endif
- /* Active thread */
- /* stack_len is long rather than size_t in order to guarantee
- that &stack_len is long aligned */
-#if SCM_STACK_GROWS_UP
- stack_len = SCM_STACK_PTR (&t) - t->base;
-
- /* Protect from the C stack. This must be the first marking
- * done because it provides information about what objects
- * are "in-use" by the C code. "in-use" objects are those
- * for which the information about length and base address must
- * remain usable. This requirement is stricter than a liveness
- * requirement -- in particular, it constrains the implementation
- * of scm_resizuve.
- */
- 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_save_regs_gc_mark
- / sizeof (SCM_STACKITEM)));
-
- scm_mark_locations (t->base, (size_t) stack_len);
-#else
- stack_len = t->base - SCM_STACK_PTR (&t);
-
- /* Protect from the C stack. This must be the first marking
- * done because it provides information about what objects
- * are "in-use" by the C code. "in-use" objects are those
- * for which the information about length and base address must
- * remain usable. This requirement is stricter than a liveness
- * requirement -- in particular, it constrains the implementation
- * of scm_resizuve.
+ /* Thread has not been suspended, which should never happen.
*/
- 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_save_regs_gc_mark
- / sizeof (SCM_STACKITEM)));
-
- scm_mark_locations (SCM_STACK_PTR (&t), stack_len);
-#endif
+ abort ();
}
- else
- {
- /* Suspended thread */
+
+ {
#if SCM_STACK_GROWS_UP
- long stack_len = t->top - t->base;
- scm_mark_locations (t->base, stack_len);
+ scm_mark_locations (t->base, t->top - t->base);
#else
- long stack_len = t->base - t->top;
- scm_mark_locations (t->top, stack_len);
+ scm_mark_locations (t->top, t->base - t->top);
#endif
- scm_mark_locations ((SCM_STACKITEM *) t->regs,
- ((size_t) sizeof(t->regs)
- / sizeof (SCM_STACKITEM)));
- }
+ }
+ scm_mark_locations ((SCM_STACKITEM *) t->regs,
+ ((size_t) sizeof(t->regs)
+ / sizeof (SCM_STACKITEM)));
}
+
+ SCM_MARK_BACKING_STORE ();
}
/*** Select */
static scm_t_cond wake_up_cond;
int scm_i_thread_go_to_sleep;
-static int gc_section_count = 0;
static int threads_initialized_p = 0;
void
scm_i_thread_put_to_sleep ()
{
- if (threads_initialized_p && !gc_section_count++)
+ if (threads_initialized_p)
{
SCM threads;
+
+ /* We leave Guile completely before locking the
+ thread_admin_mutex. This ensures that other threads can put
+ us to sleep while we block on that mutex.
+ */
+ scm_i_leave_guile ();
scm_i_plugin_mutex_lock (&thread_admin_mutex);
threads = all_threads;
/* Signal all threads to go to sleep */
scm_i_thread_go_to_sleep = 1;
- for (; !SCM_NULLP (threads); threads = SCM_CDR (threads))
- if (SCM_CAR (threads) != cur_thread)
- {
- scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads));
- scm_i_plugin_mutex_lock (&t->heap_mutex);
- }
+ for (; !scm_is_null (threads); threads = SCM_CDR (threads))
+ {
+ scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads));
+ scm_i_plugin_mutex_lock (&t->heap_mutex);
+ }
scm_i_thread_go_to_sleep = 0;
}
}
{
/* Don't need to lock thread_admin_mutex here since we are single threaded */
SCM threads = all_threads;
- for (; !SCM_NULLP (threads); threads = SCM_CDR (threads))
+ for (; !scm_is_null (threads); threads = SCM_CDR (threads))
if (SCM_CAR (threads) != cur_thread)
{
scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads));
void
scm_i_thread_wake_up ()
{
- if (threads_initialized_p && !--gc_section_count)
+ if (threads_initialized_p)
{
SCM threads;
threads = all_threads;
scm_i_plugin_cond_broadcast (&wake_up_cond);
- for (; !SCM_NULLP (threads); threads = SCM_CDR (threads))
- if (SCM_CAR (threads) != cur_thread)
- {
- scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads));
- scm_i_plugin_mutex_unlock (&t->heap_mutex);
- }
+ for (; !scm_is_null (threads); threads = SCM_CDR (threads))
+ {
+ scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads));
+ scm_i_plugin_mutex_unlock (&t->heap_mutex);
+ }
scm_i_plugin_mutex_unlock (&thread_admin_mutex);
+ scm_i_enter_guile (SCM_CURRENT_THREAD);
}
}
HCoop / bpt / guile.git / blobdiff