mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-16 16:50:21 +02:00
* __scm.h (USE_THREADS, GUILE_ISELECT): Define when
SCM_DEBUG_DEPRECATED. Removed their use thru-out Guile.
This commit is contained in:
Marius Vollmer
parent
5cbed2d017
commit
3d7f708f21
20 changed files with 26 additions and 284 deletions
|
|
@ -148,9 +148,7 @@ redisplay ()
|
|||
}
|
||||
|
||||
static int in_readline = 0;
|
||||
#ifdef USE_THREADS
|
||||
static SCM reentry_barrier_mutex;
|
||||
#endif
|
||||
|
||||
static SCM internal_readline (SCM text);
|
||||
static SCM handle_error (void *data, SCM tag, SCM args);
|
||||
|
|
@ -227,17 +225,13 @@ static void
|
|||
reentry_barrier ()
|
||||
{
|
||||
int reentryp = 0;
|
||||
#ifdef USE_THREADS
|
||||
/* We should rather use scm_try_mutex when it becomes available */
|
||||
scm_lock_mutex (reentry_barrier_mutex);
|
||||
#endif
|
||||
if (in_readline)
|
||||
reentryp = 1;
|
||||
else
|
||||
++in_readline;
|
||||
#ifdef USE_THREADS
|
||||
scm_unlock_mutex (reentry_barrier_mutex);
|
||||
#endif
|
||||
if (reentryp)
|
||||
scm_misc_error (s_scm_readline, "readline is not reentrant", SCM_EOL);
|
||||
}
|
||||
|
|
@ -576,9 +570,7 @@ scm_init_readline ()
|
|||
rl_pre_input_hook = sigwinch_enable_restart;
|
||||
#endif
|
||||
|
||||
#ifdef USE_THREADS
|
||||
reentry_barrier_mutex = scm_permanent_object (scm_make_mutex ());
|
||||
#endif
|
||||
scm_init_opts (scm_readline_options,
|
||||
scm_readline_opts,
|
||||
SCM_N_READLINE_OPTIONS);
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#ifndef SCM_LIBGUILE_H
|
||||
#define SCM_LIBGUILE_H
|
||||
|
||||
/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 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
|
||||
|
|
@ -129,9 +129,7 @@ extern "C" {
|
|||
#include "libguile/debug.h"
|
||||
#include "libguile/stacks.h"
|
||||
#endif
|
||||
#ifdef USE_THREADS
|
||||
#include "libguile/threads.h"
|
||||
#endif
|
||||
#include "libguile/inline.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
|
|
|
|||
|
|
@ -94,9 +94,6 @@
|
|||
* These may be defined or undefined.
|
||||
*/
|
||||
|
||||
/* Old async mechanism */
|
||||
/* #define GUILE_OLD_ASYNC_CLICK */
|
||||
|
||||
/* #define GUILE_DEBUG_FREELIST */
|
||||
|
||||
/* All the number support there is.
|
||||
|
|
@ -151,6 +148,15 @@
|
|||
# define SCM_API extern
|
||||
#endif
|
||||
|
||||
#if defined (SCM_ENABLE_DEPRECATED)
|
||||
|
||||
/* These options are always active.
|
||||
*/
|
||||
#define USE_THREADS
|
||||
#define GUILE_ISELECT
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
/* What did the configure script discover about the outside world? */
|
||||
|
|
@ -400,12 +406,6 @@ typedef long SCM_STACKITEM;
|
|||
#endif
|
||||
|
||||
|
||||
#ifndef USE_THREADS
|
||||
#define SCM_CRITICAL_SECTION_START
|
||||
#define SCM_CRITICAL_SECTION_END
|
||||
#define SCM_THREAD_SWITCHING_CODE
|
||||
#endif
|
||||
|
||||
#define SCM_ASYNC_TICK /*fixme* should change names */ \
|
||||
do { \
|
||||
if (scm_root->pending_asyncs) \
|
||||
|
|
|
|||
|
|
@ -74,10 +74,7 @@
|
|||
#include "libguile/numbers.h" /* Everyone deals with fixnums. */
|
||||
#include "libguile/symbols.h" /* For length, chars, values, miscellany. */
|
||||
#include "libguile/boolean.h" /* Everyone wonders about the truth. */
|
||||
#ifdef USE_THREADS
|
||||
#include "libguile/threads.h" /* The cooperative thread package does
|
||||
switching at async ticks. */
|
||||
#endif
|
||||
#include "libguile/threads.h" /* You are not alone. */
|
||||
#include "libguile/snarf.h" /* Everyone snarfs. */
|
||||
#include "libguile/variable.h"
|
||||
#include "libguile/modules.h"
|
||||
|
|
|
|||
|
|
@ -248,7 +248,6 @@ SCM_DEFINE (scm_system_async_mark_for_thread, "system-async-mark", 1, 1, 0,
|
|||
"signal handlers.")
|
||||
#define FUNC_NAME s_scm_system_async_mark_for_thread
|
||||
{
|
||||
#ifdef USE_THREADS
|
||||
if (SCM_UNBNDP (thread))
|
||||
thread = scm_current_thread ();
|
||||
else
|
||||
|
|
@ -259,9 +258,6 @@ SCM_DEFINE (scm_system_async_mark_for_thread, "system-async-mark", 1, 1, 0,
|
|||
}
|
||||
scm_i_queue_async_cell (scm_cons (proc, SCM_BOOL_F),
|
||||
scm_i_thread_root (thread));
|
||||
#else
|
||||
scm_i_queue_async_cell (scm_cons (proc, SCM_BOOL_F), scm_root);
|
||||
#endif
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
|
|
|||
|
|
@ -59,9 +59,7 @@
|
|||
# endif
|
||||
# endif
|
||||
|
||||
#ifdef GUILE_ISELECT
|
||||
#include "libguile/iselect.h"
|
||||
#endif
|
||||
|
||||
#if HAVE_WINSOCK2_H
|
||||
#include <winsock2.h>
|
||||
|
|
@ -106,7 +104,6 @@ typedef struct coop_t {
|
|||
|
||||
SCM handle; /* SCM handle, protected via scm_all_threads. */
|
||||
|
||||
#ifdef GUILE_ISELECT
|
||||
int nfds;
|
||||
SELECT_TYPE *readfds;
|
||||
SELECT_TYPE *writefds;
|
||||
|
|
@ -115,9 +112,6 @@ typedef struct coop_t {
|
|||
struct timeval wakeup_time; /* Time to stop sleeping */
|
||||
int _errno;
|
||||
int retval;
|
||||
#else
|
||||
time_t wakeup_time; /* Time to stop sleeping */
|
||||
#endif
|
||||
|
||||
#ifdef GUILE_PTHREAD_COMPAT
|
||||
pthread_t dummy_thread;
|
||||
|
|
@ -203,10 +197,9 @@ SCM_API size_t scm_thread_count;
|
|||
iselect.h, but they use coop_t, defined above, which uses things
|
||||
defined in iselect.h. Basically, we're making at best a flailing
|
||||
(and failing) attempt at modularity here, and I don't have time to
|
||||
rethink this at the moment. This code awaits a Hero. --JimB */
|
||||
#ifdef GUILE_ISELECT
|
||||
rethink this at the moment. This code awaits a Hero. --JimB
|
||||
*/
|
||||
SCM_API void coop_timeout_qinsert (coop_q_t *, coop_t *);
|
||||
#endif
|
||||
SCM_API coop_t *coop_next_runnable_thread (void);
|
||||
SCM_API coop_t *coop_wait_for_runnable_thread_now (struct timeval *);
|
||||
SCM_API coop_t *coop_wait_for_runnable_thread (void);
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
#ifndef SCM_COOP_THREADS_H
|
||||
#define SCM_COOP_THREADS_H
|
||||
|
||||
/* Copyright (C) 1996,1997,1998,2000 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1996,1997,1998,2000, 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
|
||||
|
|
@ -112,15 +112,13 @@ SCM_API coop_t *coop_qget (coop_q_t *);
|
|||
SCM_API void coop_qput (coop_q_t *, coop_t *);
|
||||
SCM_API void *coop_sleephelp (qt_t *, void *, void *);
|
||||
|
||||
#ifdef GUILE_ISELECT
|
||||
SCM_API coop_t *coop_wait_for_runnable_thread ();
|
||||
#endif
|
||||
|
||||
SCM_API coop_q_t coop_global_runq; /* A queue of runable threads. */
|
||||
SCM_API coop_q_t coop_global_sleepq;
|
||||
SCM_API coop_q_t coop_tmp_queue;
|
||||
SCM_API coop_q_t coop_global_allq; /* A queue of all threads. */
|
||||
SCM_API coop_t *coop_global_curr; /* Currently-executing thread. */
|
||||
SCM_API coop_t *coop_global_curr; /* Currently-executing thread. */
|
||||
|
||||
#endif /* SCM_COOP_THREADS_H */
|
||||
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@
|
|||
* If you do not wish that, delete this exception notice. */
|
||||
|
||||
|
||||
/* $Id: coop.c,v 1.32 2002-10-27 20:12:07 mvo Exp $ */
|
||||
/* $Id: coop.c,v 1.33 2002-11-03 22:05:10 mvo Exp $ */
|
||||
|
||||
/* Cooperative thread library, based on QuickThreads */
|
||||
|
||||
|
|
@ -73,13 +73,11 @@ coop_qinit (coop_q_t *q)
|
|||
|
||||
q->t.all_prev = NULL;
|
||||
q->t.all_next = NULL;
|
||||
#ifdef GUILE_ISELECT
|
||||
q->t.nfds = 0;
|
||||
q->t.readfds = NULL;
|
||||
q->t.writefds = NULL;
|
||||
q->t.exceptfds = NULL;
|
||||
q->t.timeoutp = 0;
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -131,7 +129,6 @@ coop_all_qremove (coop_q_t *q, coop_t *t)
|
|||
t->all_next->all_prev = t->all_prev;
|
||||
}
|
||||
|
||||
#ifdef GUILE_ISELECT
|
||||
/* Insert thread t into the ordered queue q.
|
||||
q is ordered after wakeup_time. Threads which aren't sleeping but
|
||||
waiting for I/O go last into the queue. */
|
||||
|
|
@ -152,10 +149,10 @@ coop_timeout_qinsert (coop_q_t *q, coop_t *t)
|
|||
if (t->next == &q->t)
|
||||
q->tail = t;
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
/* Thread routines. */
|
||||
/* Thread routines. */
|
||||
|
||||
coop_q_t coop_global_runq; /* A queue of runable threads. */
|
||||
coop_q_t coop_global_sleepq; /* A queue of sleeping threads. */
|
||||
|
|
@ -230,7 +227,6 @@ coop_init ()
|
|||
and there are sleeping threads - wait until one wakes up. Otherwise,
|
||||
return NULL. */
|
||||
|
||||
#ifndef GUILE_ISELECT
|
||||
coop_t *
|
||||
coop_next_runnable_thread()
|
||||
{
|
||||
|
|
@ -260,7 +256,6 @@ coop_next_runnable_thread()
|
|||
|
||||
return t;
|
||||
}
|
||||
#endif
|
||||
|
||||
void
|
||||
coop_start()
|
||||
|
|
@ -333,13 +328,9 @@ coop_mutex_lock (coop_m *m)
|
|||
/* Record the current top-of-stack before going to sleep */
|
||||
coop_global_curr->top = &old;
|
||||
|
||||
#ifdef GUILE_ISELECT
|
||||
newthread = coop_wait_for_runnable_thread();
|
||||
if (newthread == coop_global_curr)
|
||||
coop_abort ();
|
||||
#else
|
||||
newthread = coop_next_runnable_thread();
|
||||
#endif
|
||||
old = coop_global_curr;
|
||||
coop_global_curr = newthread;
|
||||
QT_BLOCK (coop_yieldhelp, old, &(m->waiting), newthread->sp);
|
||||
|
|
@ -417,13 +408,9 @@ coop_condition_variable_wait_mutex (coop_c *c, coop_m *m)
|
|||
{
|
||||
m->owner = NULL;
|
||||
/*fixme* Should we really wait here? Isn't it OK just to proceed? */
|
||||
#ifdef GUILE_ISELECT
|
||||
newthread = coop_wait_for_runnable_thread();
|
||||
if (newthread == coop_global_curr)
|
||||
coop_abort ();
|
||||
#else
|
||||
newthread = coop_next_runnable_thread();
|
||||
#endif
|
||||
}
|
||||
coop_global_curr->top = &old;
|
||||
old = coop_global_curr;
|
||||
|
|
@ -457,16 +444,11 @@ coop_condition_variable_timed_wait_mutex (coop_c *c,
|
|||
else
|
||||
{
|
||||
m->owner = NULL;
|
||||
#ifdef GUILE_ISELECT
|
||||
coop_global_curr->timeoutp = 1;
|
||||
coop_global_curr->wakeup_time.tv_sec = abstime->tv_sec;
|
||||
coop_global_curr->wakeup_time.tv_usec = abstime->tv_nsec / 1000;
|
||||
coop_timeout_qinsert (&coop_global_sleepq, coop_global_curr);
|
||||
t = coop_wait_for_runnable_thread();
|
||||
#else
|
||||
/*fixme* Implement!*/
|
||||
t = coop_next_runnable_thread();
|
||||
#endif
|
||||
}
|
||||
if (t != coop_global_curr)
|
||||
{
|
||||
|
|
@ -712,15 +694,11 @@ coop_abort ()
|
|||
free (coop_global_curr->joining);
|
||||
}
|
||||
|
||||
#ifdef GUILE_ISELECT
|
||||
scm_I_am_dead = 1;
|
||||
do {
|
||||
newthread = coop_wait_for_runnable_thread();
|
||||
} while (newthread == coop_global_curr);
|
||||
scm_I_am_dead = 0;
|
||||
#else
|
||||
newthread = coop_next_runnable_thread();
|
||||
#endif
|
||||
coop_all_qremove (&coop_global_allq, coop_global_curr);
|
||||
old = coop_global_curr;
|
||||
coop_global_curr = newthread;
|
||||
|
|
@ -758,13 +736,9 @@ coop_join(coop_t *t)
|
|||
coop_qinit((coop_q_t *) t->joining);
|
||||
}
|
||||
|
||||
#ifdef GUILE_ISELECT
|
||||
newthread = coop_wait_for_runnable_thread();
|
||||
if (newthread == coop_global_curr)
|
||||
return;
|
||||
#else
|
||||
newthread = coop_next_runnable_thread();
|
||||
#endif
|
||||
old = coop_global_curr;
|
||||
coop_global_curr = newthread;
|
||||
QT_BLOCK (coop_yieldhelp, old, (coop_q_t *) t->joining, newthread->sp);
|
||||
|
|
@ -780,13 +754,8 @@ coop_yield()
|
|||
|
||||
/* There may be no other runnable threads. Return if this is the
|
||||
case. */
|
||||
#if GUILE_ISELECT
|
||||
if (newthread == coop_global_curr)
|
||||
return;
|
||||
#else
|
||||
if (newthread == NULL)
|
||||
return;
|
||||
#endif
|
||||
|
||||
old = coop_global_curr;
|
||||
|
||||
|
|
@ -815,8 +784,6 @@ coop_sleephelp (qt_t *sp, void *old, void *blockq)
|
|||
return NULL;
|
||||
}
|
||||
|
||||
#ifdef GUILE_ISELECT
|
||||
|
||||
unsigned long
|
||||
scm_thread_usleep (unsigned long usec)
|
||||
{
|
||||
|
|
@ -841,43 +808,6 @@ scm_thread_sleep (unsigned long sec)
|
|||
return slept > sec ? 0 : sec - slept;
|
||||
}
|
||||
|
||||
#else /* GUILE_ISELECT */
|
||||
|
||||
unsigned long
|
||||
scm_thread_sleep (unsigned long s)
|
||||
{
|
||||
coop_t *newthread, *old;
|
||||
time_t now = time (NULL);
|
||||
coop_global_curr->wakeup_time = now + s;
|
||||
|
||||
/* Put the current thread on the sleep queue */
|
||||
coop_qput (&coop_global_sleepq, coop_global_curr);
|
||||
|
||||
newthread = coop_next_runnable_thread();
|
||||
|
||||
/* If newthread is the same as the sleeping thread, do nothing */
|
||||
if (newthread == coop_global_curr)
|
||||
return s;
|
||||
|
||||
old = coop_global_curr;
|
||||
|
||||
coop_global_curr = newthread;
|
||||
QT_BLOCK (coop_sleephelp, old, NULL, newthread->sp);
|
||||
|
||||
return s;
|
||||
}
|
||||
|
||||
unsigned long
|
||||
scm_thread_usleep (unsigned long usec)
|
||||
{
|
||||
/* We're so cheap. */
|
||||
scm_thread_sleep (usec / 1000000);
|
||||
return 0; /* Maybe we should calculate actual time slept,
|
||||
but this is faster... :) */
|
||||
}
|
||||
|
||||
#endif /* GUILE_ISELECT */
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
c-file-style: "gnu"
|
||||
|
|
|
|||
|
|
@ -126,10 +126,6 @@ typedef struct scm_t_debug_frame
|
|||
scm_t_debug_info *info;
|
||||
} scm_t_debug_frame;
|
||||
|
||||
#ifndef USE_THREADS
|
||||
SCM_API scm_t_debug_frame *scm_last_debug_frame;
|
||||
#endif
|
||||
|
||||
#define SCM_EVALFRAME (0L << 11)
|
||||
#define SCM_APPLYFRAME (1L << 11)
|
||||
#define SCM_VOIDFRAME (3L << 11)
|
||||
|
|
|
|||
|
|
@ -167,8 +167,6 @@ scm_ilookup (SCM iloc, SCM env)
|
|||
return SCM_CARLOC (SCM_CDR (er));
|
||||
}
|
||||
|
||||
#ifdef USE_THREADS
|
||||
|
||||
/* The Lookup Car Race
|
||||
- by Eva Luator
|
||||
|
||||
|
|
@ -242,17 +240,10 @@ scm_ilookup (SCM iloc, SCM env)
|
|||
for NULL. I think I've found the only places where this
|
||||
applies. */
|
||||
|
||||
#endif /* USE_THREADS */
|
||||
|
||||
SCM_SYMBOL (scm_unbound_variable_key, "unbound-variable");
|
||||
|
||||
#ifdef USE_THREADS
|
||||
static SCM *
|
||||
scm_lookupcar1 (SCM vloc, SCM genv, int check)
|
||||
#else
|
||||
SCM *
|
||||
scm_lookupcar (SCM vloc, SCM genv, int check)
|
||||
#endif
|
||||
{
|
||||
SCM env = genv;
|
||||
register SCM *al, fl, var = SCM_CAR (vloc);
|
||||
|
|
@ -268,10 +259,8 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
|
|||
{
|
||||
if (SCM_EQ_P (fl, var))
|
||||
{
|
||||
#ifdef USE_THREADS
|
||||
if (! SCM_EQ_P (SCM_CAR (vloc), var))
|
||||
goto race;
|
||||
#endif
|
||||
SCM_SET_CELL_WORD_0 (vloc, SCM_UNPACK (iloc) + SCM_ICDR);
|
||||
return SCM_CDRLOC (*al);
|
||||
}
|
||||
|
|
@ -286,10 +275,8 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
|
|||
env = SCM_EOL;
|
||||
goto errout;
|
||||
}
|
||||
#ifdef USE_THREADS
|
||||
if (!SCM_EQ_P (SCM_CAR (vloc), var))
|
||||
goto race;
|
||||
#endif
|
||||
SCM_SETCAR (vloc, iloc);
|
||||
return SCM_CARLOC (*al);
|
||||
}
|
||||
|
|
@ -333,7 +320,6 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
|
|||
}
|
||||
}
|
||||
|
||||
#ifdef USE_THREADS
|
||||
if (!SCM_EQ_P (SCM_CAR (vloc), var))
|
||||
{
|
||||
/* Some other thread has changed the very cell we are working
|
||||
|
|
@ -352,14 +338,12 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
|
|||
the dispatch on the car of the form. */
|
||||
return NULL;
|
||||
}
|
||||
#endif /* USE_THREADS */
|
||||
|
||||
SCM_SETCAR (vloc, real_var);
|
||||
return SCM_VARIABLE_LOC (real_var);
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef USE_THREADS
|
||||
SCM *
|
||||
scm_lookupcar (SCM vloc, SCM genv, int check)
|
||||
{
|
||||
|
|
@ -368,7 +352,6 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
|
|||
abort ();
|
||||
return loc;
|
||||
}
|
||||
#endif
|
||||
|
||||
#define unmemocar scm_unmemocar
|
||||
|
||||
|
|
@ -1238,7 +1221,6 @@ scm_macroexp (SCM x, SCM env)
|
|||
if (!SCM_SYMBOLP (orig_sym))
|
||||
return x;
|
||||
|
||||
#ifdef USE_THREADS
|
||||
{
|
||||
SCM *proc_ptr = scm_lookupcar1 (x, env, 0);
|
||||
if (proc_ptr == NULL)
|
||||
|
|
@ -1248,9 +1230,6 @@ scm_macroexp (SCM x, SCM env)
|
|||
}
|
||||
proc = *proc_ptr;
|
||||
}
|
||||
#else
|
||||
proc = *scm_lookupcar (x, env, 0);
|
||||
#endif
|
||||
|
||||
/* Only handle memoizing macros. `Acros' and `macros' are really
|
||||
special forms and should not be evaluated here. */
|
||||
|
|
@ -1692,10 +1671,6 @@ SCM (*scm_ceval_ptr) (SCM x, SCM env);
|
|||
* any stack swaps.
|
||||
*/
|
||||
|
||||
#ifndef USE_THREADS
|
||||
scm_t_debug_frame *scm_last_debug_frame;
|
||||
#endif
|
||||
|
||||
/* scm_debug_eframe_size is the number of slots available for pseudo
|
||||
* stack frames at each real stack frame.
|
||||
*/
|
||||
|
|
@ -1950,9 +1925,7 @@ start:
|
|||
}
|
||||
}
|
||||
#endif
|
||||
#if defined (USE_THREADS) || defined (DEVAL)
|
||||
dispatch:
|
||||
#endif
|
||||
SCM_TICK;
|
||||
switch (SCM_TYP7 (x))
|
||||
{
|
||||
|
|
@ -2692,7 +2665,6 @@ dispatch:
|
|||
if (SCM_SYMBOLP (SCM_CAR (x)))
|
||||
{
|
||||
SCM orig_sym = SCM_CAR (x);
|
||||
#ifdef USE_THREADS
|
||||
{
|
||||
SCM *location = scm_lookupcar1 (x, env, 1);
|
||||
if (location == NULL)
|
||||
|
|
@ -2702,9 +2674,6 @@ dispatch:
|
|||
}
|
||||
proc = *location;
|
||||
}
|
||||
#else
|
||||
proc = *scm_lookupcar (x, env, 1);
|
||||
#endif
|
||||
|
||||
if (SCM_IMP (proc))
|
||||
{
|
||||
|
|
|
|||
|
|
@ -117,10 +117,8 @@ scm_init_feature()
|
|||
#ifndef CHEAP_CONTINUATIONS
|
||||
scm_add_feature ("full-continuation");
|
||||
#endif
|
||||
#ifdef USE_THREADS
|
||||
#ifndef USE_NULL_THREADS
|
||||
scm_add_feature ("threads");
|
||||
#endif
|
||||
#endif
|
||||
|
||||
scm_c_define ("char-code-limit", SCM_MAKINUM (SCM_CHAR_CODE_LIMIT));
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1996,1997,1998,1999,2000,2001, 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
|
||||
|
|
@ -1230,14 +1230,9 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
|
|||
}
|
||||
|
||||
{
|
||||
#ifdef GUILE_ISELECT
|
||||
int rv = scm_internal_select (max_fd + 1,
|
||||
&read_set, &write_set, &except_set,
|
||||
time_ptr);
|
||||
#else
|
||||
int rv = select (max_fd + 1,
|
||||
&read_set, &write_set, &except_set, time_ptr);
|
||||
#endif
|
||||
if (rv < 0)
|
||||
SCM_SYSERROR;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 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
|
||||
|
|
@ -530,7 +530,6 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
|
|||
return 1;
|
||||
}
|
||||
|
||||
#ifdef GUILE_ISELECT
|
||||
/* thread-local block for input on fport's fdes. */
|
||||
static void
|
||||
fport_wait_for_input (SCM port)
|
||||
|
|
@ -555,7 +554,6 @@ fport_wait_for_input (SCM port)
|
|||
while (n == -1 && errno == EINTR);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
static void fport_flush (SCM port);
|
||||
|
||||
|
|
@ -568,9 +566,7 @@ fport_fill_input (SCM port)
|
|||
scm_t_port *pt = SCM_PTAB_ENTRY (port);
|
||||
scm_t_fport *fp = SCM_FSTREAM (port);
|
||||
|
||||
#ifdef GUILE_ISELECT
|
||||
fport_wait_for_input (port);
|
||||
#endif
|
||||
SCM_SYSCALL (count = read (fp->fdes, pt->read_buf, pt->read_buf_size));
|
||||
if (count == -1)
|
||||
scm_syserror ("fport_fill_input");
|
||||
|
|
|
|||
|
|
@ -110,34 +110,9 @@ scm_mark_all (void)
|
|||
|
||||
scm_i_clear_mark_space ();
|
||||
|
||||
#ifndef USE_THREADS
|
||||
|
||||
/* 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);
|
||||
#ifdef 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();
|
||||
|
||||
#else /* USE_THREADS */
|
||||
|
||||
/* Mark every thread's stack and registers */
|
||||
scm_threads_mark_stacks ();
|
||||
|
||||
#endif /* USE_THREADS */
|
||||
|
||||
j = SCM_NUM_PROTECTS;
|
||||
while (j--)
|
||||
scm_gc_mark (scm_sys_protects[j]);
|
||||
|
|
@ -161,11 +136,6 @@ scm_mark_all (void)
|
|||
* in different phases of GC
|
||||
*/
|
||||
scm_mark_subr_table ();
|
||||
|
||||
|
||||
#ifndef USE_THREADS
|
||||
scm_gc_mark (scm_root->handle);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* {Mark/Sweep}
|
||||
|
|
|
|||
|
|
@ -1477,9 +1477,7 @@ SCM_DEFINE (scm_sys_invalidate_class, "%invalidate-class", 1, 0, 0,
|
|||
static scm_t_bits **hell;
|
||||
static long n_hell = 1; /* one place for the evil one himself */
|
||||
static long hell_size = 4;
|
||||
#ifdef USE_THREADS
|
||||
static SCM hell_mutex;
|
||||
#endif
|
||||
|
||||
static long
|
||||
burnin (SCM o)
|
||||
|
|
@ -1495,9 +1493,7 @@ static void
|
|||
go_to_hell (void *o)
|
||||
{
|
||||
SCM obj = SCM_PACK ((scm_t_bits) o);
|
||||
#ifdef USE_THREADS
|
||||
scm_lock_mutex (hell_mutex);
|
||||
#endif
|
||||
if (n_hell == hell_size)
|
||||
{
|
||||
long new_size = 2 * hell_size;
|
||||
|
|
@ -1505,21 +1501,15 @@ go_to_hell (void *o)
|
|||
hell_size = new_size;
|
||||
}
|
||||
hell[n_hell++] = SCM_STRUCT_DATA (obj);
|
||||
#ifdef USE_THREADS
|
||||
scm_unlock_mutex (hell_mutex);
|
||||
#endif
|
||||
}
|
||||
|
||||
static void
|
||||
go_to_heaven (void *o)
|
||||
{
|
||||
#ifdef USE_THREADS
|
||||
scm_lock_mutex (hell_mutex);
|
||||
#endif
|
||||
hell[burnin (SCM_PACK ((scm_t_bits) o))] = hell[--n_hell];
|
||||
#ifdef USE_THREADS
|
||||
scm_unlock_mutex (hell_mutex);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -1955,7 +1945,6 @@ scm_m_atdispatch (SCM xorig, SCM env)
|
|||
#undef FUNC_NAME
|
||||
|
||||
|
||||
#ifdef USE_THREADS
|
||||
static void
|
||||
lock_cache_mutex (void *m)
|
||||
{
|
||||
|
|
@ -1969,7 +1958,6 @@ unlock_cache_mutex (void *m)
|
|||
SCM mutex = SCM_PACK ((scm_t_bits) m);
|
||||
scm_unlock_mutex (mutex);
|
||||
}
|
||||
#endif
|
||||
|
||||
static SCM
|
||||
call_memoize_method (void *a)
|
||||
|
|
@ -1991,16 +1979,12 @@ SCM
|
|||
scm_memoize_method (SCM x, SCM args)
|
||||
{
|
||||
SCM gf = SCM_CAR (scm_last_pair (x));
|
||||
#ifdef USE_THREADS
|
||||
return scm_internal_dynamic_wind (
|
||||
lock_cache_mutex,
|
||||
call_memoize_method,
|
||||
unlock_cache_mutex,
|
||||
(void *) SCM_UNPACK (scm_cons2 (gf, x, args)),
|
||||
(void *) SCM_UNPACK (SCM_SLOT (gf, scm_si_cache_mutex)));
|
||||
#else
|
||||
return call_memoize_method ((void *) SCM_UNPACK (scm_cons2 (gf, x, args)));
|
||||
#endif
|
||||
}
|
||||
|
||||
/******************************************************************************
|
||||
|
|
@ -2037,16 +2021,11 @@ SCM_DEFINE (scm_make, "make", 0, 0, 1,
|
|||
|
||||
if (class == scm_class_generic || class == scm_class_generic_with_setter)
|
||||
{
|
||||
#ifdef USE_THREADS
|
||||
z = scm_make_struct (class, SCM_INUM0,
|
||||
scm_list_4 (SCM_EOL,
|
||||
SCM_INUM0,
|
||||
SCM_BOOL_F,
|
||||
scm_make_mutex ()));
|
||||
#else
|
||||
z = scm_make_struct (class, SCM_INUM0,
|
||||
scm_list_3 (SCM_EOL, SCM_INUM0, SCM_BOOL_F));
|
||||
#endif
|
||||
scm_set_procedure_property_x (z, scm_sym_name,
|
||||
scm_get_keyword (k_name,
|
||||
args,
|
||||
|
|
@ -2194,11 +2173,7 @@ create_standard_classes (void)
|
|||
SCM amethod_slots = scm_list_1 (scm_list_3 (scm_str2symbol ("slot-definition"),
|
||||
k_init_keyword,
|
||||
k_slot_definition));
|
||||
#ifdef USE_THREADS
|
||||
SCM mutex_slot = scm_list_1 (scm_str2symbol ("make-mutex"));
|
||||
#else
|
||||
SCM mutex_slot = SCM_BOOL_F;
|
||||
#endif
|
||||
SCM gf_slots = scm_list_4 (scm_str2symbol ("methods"),
|
||||
scm_list_3 (scm_str2symbol ("n-specialized"),
|
||||
k_init_value,
|
||||
|
|
@ -2695,9 +2670,7 @@ scm_init_goops_builtins (void)
|
|||
list_of_no_method = scm_permanent_object (scm_list_1 (sym_no_method));
|
||||
|
||||
hell = scm_malloc (hell_size);
|
||||
#ifdef USE_THREADS
|
||||
hell_mutex = scm_permanent_object (scm_make_mutex ());
|
||||
#endif
|
||||
|
||||
create_basic_classes ();
|
||||
create_standard_classes ();
|
||||
|
|
|
|||
|
|
@ -83,9 +83,7 @@
|
|||
#include "libguile/hash.h"
|
||||
#include "libguile/hashtab.h"
|
||||
#include "libguile/hooks.h"
|
||||
#ifdef GUILE_ISELECT
|
||||
#include "libguile/iselect.h"
|
||||
#endif
|
||||
#include "libguile/ioext.h"
|
||||
#include "libguile/keywords.h"
|
||||
#include "libguile/lang.h"
|
||||
|
|
@ -465,12 +463,10 @@ scm_init_guile_1 (SCM_STACKITEM *base)
|
|||
scm_init_variable (); /* all bindings need variables */
|
||||
scm_init_continuations ();
|
||||
scm_init_root (); /* requires continuations */
|
||||
#ifdef USE_THREADS
|
||||
scm_init_threads (base);
|
||||
#endif
|
||||
start_stack (base);
|
||||
scm_init_gsubr ();
|
||||
scm_init_thread_procs (); /* Requires gsubrs */
|
||||
scm_init_thread_procs (); /* requires gsubrs */
|
||||
scm_init_procprop ();
|
||||
scm_init_environments ();
|
||||
scm_init_feature ();
|
||||
|
|
@ -497,9 +493,7 @@ scm_init_guile_1 (SCM_STACKITEM *base)
|
|||
scm_init_properties ();
|
||||
scm_init_hooks (); /* Requires smob_prehistory */
|
||||
scm_init_gc (); /* Requires hooks, async */
|
||||
#ifdef GUILE_ISELECT
|
||||
scm_init_iselect ();
|
||||
#endif
|
||||
scm_init_ioext ();
|
||||
scm_init_keywords ();
|
||||
scm_init_list ();
|
||||
|
|
|
|||
|
|
@ -136,7 +136,6 @@ scm_cell (scm_t_bits car, scm_t_bits cdr)
|
|||
SCM_GC_SET_CELL_WORD (z, 1, cdr);
|
||||
SCM_GC_SET_CELL_WORD (z, 0, car);
|
||||
|
||||
#ifdef USE_THREADS
|
||||
#if !defined(USE_COOP_THREADS) && !defined(USE_NULL_THREADS) && !defined(USE_COPT_THREADS)
|
||||
/* When we are using preemtive threads, we might need to make
|
||||
sure that the initial values for the slots are protected until
|
||||
|
|
@ -145,7 +144,6 @@ scm_cell (scm_t_bits car, scm_t_bits cdr)
|
|||
#error review me
|
||||
scm_remember_upto_here_1 (SCM_PACK (cdr));
|
||||
#endif
|
||||
#endif
|
||||
|
||||
|
||||
#if (SCM_DEBUG_CELL_ACCESSES == 1)
|
||||
|
|
@ -187,7 +185,6 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr,
|
|||
SCM_GC_SET_CELL_WORD (z, 3, cdr);
|
||||
SCM_GC_SET_CELL_WORD (z, 0, car);
|
||||
|
||||
#ifdef USE_THREADS
|
||||
#if !defined(USE_COOP_THREADS) && !defined(USE_NULL_THREADS) && !defined(USE_COPT_THREADS)
|
||||
/* When we are using non-cooperating threads, we might need to make
|
||||
sure that the initial values for the slots are protected until
|
||||
|
|
@ -196,7 +193,6 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr,
|
|||
#error review me
|
||||
scm_remember_upto_here_3 (SCM_PACK (cbr), SCM_PACK (ccr), SCM_PACK (cdr));
|
||||
#endif
|
||||
#endif
|
||||
|
||||
|
||||
#if (SCM_DEBUG_CELL_ACCESSES == 1)
|
||||
|
|
|
|||
|
|
@ -60,10 +60,6 @@ SCM scm_sys_protects[SCM_NUM_PROTECTS];
|
|||
|
||||
scm_t_bits scm_tc16_root;
|
||||
|
||||
#ifndef USE_THREADS
|
||||
struct scm_root_state *scm_root;
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
static SCM
|
||||
|
|
|
|||
|
|
@ -124,22 +124,15 @@ typedef struct scm_root_state
|
|||
#define scm_rootcont (scm_root->rootcont)
|
||||
#define scm_dynwinds (scm_root->dynwinds)
|
||||
#define scm_progargs (scm_root->progargs)
|
||||
#ifdef USE_THREADS
|
||||
#define scm_last_debug_frame (scm_root->last_debug_frame)
|
||||
#endif
|
||||
#define scm_exitval (scm_root->exitval)
|
||||
#define scm_cur_inp (scm_root->cur_inp)
|
||||
#define scm_cur_outp (scm_root->cur_outp)
|
||||
#define scm_cur_errp (scm_root->cur_errp)
|
||||
#define scm_cur_loadp (scm_root->cur_loadp)
|
||||
|
||||
#ifdef USE_THREADS
|
||||
#define scm_root ((scm_root_state *) SCM_THREAD_LOCAL_DATA)
|
||||
#define scm_set_root(new_root) SCM_SET_THREAD_LOCAL_DATA (new_root)
|
||||
#else /* USE_THREADS */
|
||||
SCM_API struct scm_root_state *scm_root;
|
||||
#define scm_set_root(new_root) (scm_root = (new_root))
|
||||
#endif /* USE_THREADS */
|
||||
#define scm_root ((scm_root_state *) SCM_THREAD_LOCAL_DATA)
|
||||
#define scm_set_root(new_root) SCM_SET_THREAD_LOCAL_DATA (new_root)
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -63,19 +63,6 @@
|
|||
#include <sys/time.h>
|
||||
#endif
|
||||
|
||||
/* The thread system has its own sleep and usleep functions. */
|
||||
#ifndef USE_THREADS
|
||||
|
||||
#if defined(MISSING_SLEEP_DECL)
|
||||
int sleep ();
|
||||
#endif
|
||||
|
||||
#if defined(HAVE_USLEEP) && defined(MISSING_USLEEP_DECL)
|
||||
int usleep ();
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
#ifdef __MINGW32__
|
||||
#include <windows.h>
|
||||
#define alarm(sec) (0)
|
||||
|
|
@ -351,7 +338,6 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
|
|||
sigemptyset (&action.sa_mask);
|
||||
#endif
|
||||
|
||||
#ifdef USE_THREADS
|
||||
if (SCM_UNBNDP (thread))
|
||||
thread = scm_current_thread ();
|
||||
else
|
||||
|
|
@ -360,9 +346,6 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
|
|||
if (scm_c_thread_exited_p (thread))
|
||||
SCM_MISC_ERROR ("thread has already exited", SCM_EOL);
|
||||
}
|
||||
#else
|
||||
thread = SCM_BOOL_F;
|
||||
#endif
|
||||
|
||||
SCM_DEFER_INTS;
|
||||
old_handler = SCM_VECTOR_REF(*signal_handlers, csig);
|
||||
|
|
@ -647,44 +630,23 @@ SCM_DEFINE (scm_sleep, "sleep", 1, 0, 0,
|
|||
{
|
||||
unsigned long j;
|
||||
SCM_VALIDATE_INUM_MIN (1, i,0);
|
||||
#ifdef USE_THREADS
|
||||
j = scm_thread_sleep (SCM_INUM(i));
|
||||
#else
|
||||
j = sleep (SCM_INUM(i));
|
||||
#endif
|
||||
return scm_ulong2num (j);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
#if defined(USE_THREADS) || defined(HAVE_USLEEP) || defined(__MINGW32__)
|
||||
SCM_DEFINE (scm_usleep, "usleep", 1, 0, 0,
|
||||
(SCM i),
|
||||
"Sleep for I microseconds. @code{usleep} is not available on\n"
|
||||
"all platforms.")
|
||||
#define FUNC_NAME s_scm_usleep
|
||||
{
|
||||
unsigned long j;
|
||||
SCM_VALIDATE_INUM_MIN (1, i,0);
|
||||
|
||||
#ifdef USE_THREADS
|
||||
/* If we have threads, we use the thread system's sleep function. */
|
||||
{
|
||||
unsigned long j = scm_thread_usleep (SCM_INUM (i));
|
||||
return scm_ulong2num (j);
|
||||
}
|
||||
#else
|
||||
#ifdef USLEEP_RETURNS_VOID
|
||||
usleep (SCM_INUM (i));
|
||||
return SCM_INUM0;
|
||||
#else
|
||||
{
|
||||
int j = usleep (SCM_INUM (i));
|
||||
return SCM_MAKINUM (j);
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
j = scm_thread_usleep (SCM_INUM (i));
|
||||
return scm_ulong2num (j);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
#endif /* USE_THREADS || HAVE_USLEEP || __MINGW32__ */
|
||||
|
||||
SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
|
||||
(SCM sig),
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue