diff --git a/NEWS b/NEWS index 05acbf125..941f411f0 100644 --- a/NEWS +++ b/NEWS @@ -109,6 +109,12 @@ scm_dynwind_block_asyncs. Use `scm_make_mutex_with_kind' instead. See "Mutexes and Condition Variables" in the manual, for more. +** Dynamic roots deprecated + +This was a facility that predated threads, was unused as far as we can +tell, and was never documented. Still, a grep of your code for +dynamic-root or dynamic_root would not be amiss. + * Bug fixes ** cancel-thread uses asynchronous interrupts, not pthread_cancel diff --git a/libguile.h b/libguile.h index 0a1f0dcd6..3f7f0b791 100644 --- a/libguile.h +++ b/libguile.h @@ -88,7 +88,6 @@ extern "C" { #include "libguile/r6rs-ports.h" #include "libguile/random.h" #include "libguile/read.h" -#include "libguile/root.h" #include "libguile/scmsigs.h" #include "libguile/script.h" #include "libguile/simpos.h" diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 31cff7587..8bf9ddf59 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -192,7 +192,6 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \ random.c \ rdelim.c \ read.c \ - root.c \ rw.c \ scmsigs.c \ script.c \ @@ -297,7 +296,6 @@ DOT_X_FILES = \ random.x \ rdelim.x \ read.x \ - root.x \ rw.x \ scmsigs.x \ script.x \ @@ -400,7 +398,6 @@ DOT_DOC_FILES = \ random.doc \ rdelim.doc \ read.doc \ - root.doc \ rw.doc \ scmsigs.doc \ script.doc \ @@ -644,7 +641,6 @@ modinclude_HEADERS = \ rdelim.h \ read.h \ regex-posix.h \ - root.h \ rw.h \ scmsigs.h \ script.h \ diff --git a/libguile/array-map.c b/libguile/array-map.c index 938f0a7b9..c028795a5 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -34,7 +34,6 @@ #include "libguile/eq.h" #include "libguile/eval.h" #include "libguile/feature.h" -#include "libguile/root.h" #include "libguile/vectors.h" #include "libguile/bitvectors.h" #include "libguile/srfi-4.h" diff --git a/libguile/arrays.c b/libguile/arrays.c index 52fe90a19..ea090d646 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -39,7 +39,6 @@ #include "libguile/eval.h" #include "libguile/fports.h" #include "libguile/feature.h" -#include "libguile/root.h" #include "libguile/strings.h" #include "libguile/srfi-13.h" #include "libguile/srfi-4.h" diff --git a/libguile/async.c b/libguile/async.c index b9dc78442..df8064107 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -27,7 +27,6 @@ #include "libguile/atomics-internal.h" #include "libguile/eval.h" #include "libguile/throw.h" -#include "libguile/root.h" #include "libguile/smob.h" #include "libguile/dynwind.h" #include "libguile/deprecation.h" diff --git a/libguile/async.h b/libguile/async.h index 1a40a83bd..c6d7202aa 100644 --- a/libguile/async.h +++ b/libguile/async.h @@ -25,7 +25,6 @@ #include "libguile/__scm.h" -#include "libguile/root.h" #include "libguile/threads.h" diff --git a/libguile/continuations.c b/libguile/continuations.c index 3e32749dc..5d146f4a1 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -30,7 +30,6 @@ #include "libguile/async.h" #include "libguile/debug.h" -#include "libguile/root.h" #include "libguile/stackchk.h" #include "libguile/smob.h" #include "libguile/ports.h" diff --git a/libguile/debug.c b/libguile/debug.c index dfc9bda30..c653cdf85 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -51,7 +51,6 @@ #include "libguile/dynwind.h" #include "libguile/modules.h" #include "libguile/ports.h" -#include "libguile/root.h" #include "libguile/fluids.h" #include "libguile/programs.h" #include "libguile/memoize.h" diff --git a/libguile/deprecated.c b/libguile/deprecated.c index 6da604e42..e94733806 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -730,6 +730,162 @@ scm_unlock_mutex_timed (SCM mx, SCM cond, SCM timeout) } + + +/* {call-with-dynamic-root} + * + * Suspending the current thread to evaluate a thunk on the + * same C stack but under a new root. + * + * Calls to call-with-dynamic-root return exactly once (unless + * the process is somehow exitted). */ + +/* cwdr fills out both of these structures, and then passes a pointer + to them through scm_internal_catch to the cwdr_body and + cwdr_handler functions, to tell them how to behave and to get + information back from them. + + A cwdr is a lot like a catch, except there is no tag (all + exceptions are caught), and the body procedure takes the arguments + passed to cwdr as A1 and ARGS. The handler is also special since + it is not directly run from scm_internal_catch. It is executed + outside the new dynamic root. */ + +struct cwdr_body_data { + /* Arguments to pass to the cwdr body function. */ + SCM a1, args; + + /* Scheme procedure to use as body of cwdr. */ + SCM body_proc; +}; + +struct cwdr_handler_data { + /* Do we need to run the handler? */ + int run_handler; + + /* The tag and args to pass it. */ + SCM tag, args; +}; + + +/* Invoke the body of a cwdr, assuming that the throw handler has + already been set up. DATA points to a struct set up by cwdr that + says what proc to call, and what args to apply it to. + + With a little thought, we could replace this with scm_body_thunk, + but I don't want to mess with that at the moment. */ +static SCM +cwdr_body (void *data) +{ + struct cwdr_body_data *c = (struct cwdr_body_data *) data; + + return scm_apply (c->body_proc, c->a1, c->args); +} + +/* Record the fact that the body of the cwdr has thrown. Record + enough information to invoke the handler later when the dynamic + root has been deestablished. */ + +static SCM +cwdr_handler (void *data, SCM tag, SCM args) +{ + struct cwdr_handler_data *c = (struct cwdr_handler_data *) data; + + c->run_handler = 1; + c->tag = tag; + c->args = args; + return SCM_UNSPECIFIED; +} + +SCM +scm_internal_cwdr (scm_t_catch_body body, void *body_data, + scm_t_catch_handler handler, void *handler_data, + SCM_STACKITEM *stack_start) +{ + struct cwdr_handler_data my_handler_data; + scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack; + SCM answer; + scm_t_dynstack *old_dynstack; + + /* Exit caller's dynamic state. + */ + old_dynstack = scm_dynstack_capture_all (dynstack); + scm_dynstack_unwind (dynstack, SCM_DYNSTACK_FIRST (dynstack)); + + scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE); + scm_dynwind_current_dynamic_state (scm_make_dynamic_state (SCM_UNDEFINED)); + + my_handler_data.run_handler = 0; + answer = scm_i_with_continuation_barrier (body, body_data, + cwdr_handler, &my_handler_data, + NULL, NULL); + + scm_dynwind_end (); + + /* Enter caller's dynamic state. + */ + scm_dynstack_wind (dynstack, SCM_DYNSTACK_FIRST (old_dynstack)); + + /* Now run the real handler iff the body did a throw. */ + if (my_handler_data.run_handler) + return handler (handler_data, my_handler_data.tag, my_handler_data.args); + else + return answer; +} + +/* The original CWDR for invoking Scheme code with a Scheme handler. */ + +static SCM +cwdr (SCM proc, SCM a1, SCM args, SCM handler, SCM_STACKITEM *stack_start) +{ + struct cwdr_body_data c; + + c.a1 = a1; + c.args = args; + c.body_proc = proc; + + return scm_internal_cwdr (cwdr_body, &c, + scm_handle_by_proc, &handler, + stack_start); +} + +SCM_DEFINE (scm_call_with_dynamic_root, "call-with-dynamic-root", 2, 0, 0, + (SCM thunk, SCM handler), + "Call @var{thunk} with a new dynamic state and within\n" + "a continuation barrier. The @var{handler} catches all\n" + "otherwise uncaught throws and executes within the same\n" + "dynamic context as @var{thunk}.") +#define FUNC_NAME s_scm_call_with_dynamic_root +{ + SCM_STACKITEM stack_place; + scm_c_issue_deprecation_warning + ("call-with-dynamic-root is deprecated. There is no replacement."); + return cwdr (thunk, SCM_EOL, SCM_EOL, handler, &stack_place); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_dynamic_root, "dynamic-root", 0, 0, 0, + (), + "Return an object representing the current dynamic root.\n\n" + "These objects are only useful for comparison using @code{eq?}.\n") +#define FUNC_NAME s_scm_dynamic_root +{ + scm_c_issue_deprecation_warning + ("dynamic-root is deprecated. There is no replacement."); + return SCM_I_CURRENT_THREAD->continuation_root; +} +#undef FUNC_NAME + +SCM +scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args, SCM handler) +{ + SCM_STACKITEM stack_place; + scm_c_issue_deprecation_warning + ("scm_apply_with_dynamic_root is deprecated. There is no replacement."); + return cwdr (proc, a1, args, handler, &stack_place); +} + + void diff --git a/libguile/deprecated.h b/libguile/deprecated.h index 211266f6d..782e84564 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -244,6 +244,18 @@ SCM_DEPRECATED SCM scm_lock_mutex_timed (SCM m, SCM timeout, SCM owner); +SCM_DEPRECATED SCM scm_internal_cwdr (scm_t_catch_body body, + void *body_data, + scm_t_catch_handler handler, + void *handler_data, + SCM_STACKITEM *stack_start); +SCM_DEPRECATED SCM scm_call_with_dynamic_root (SCM thunk, SCM handler); +SCM_DEPRECATED SCM scm_dynamic_root (void); +SCM_DEPRECATED SCM scm_apply_with_dynamic_root (SCM proc, SCM a1, + SCM args, SCM handler); + + + void scm_i_init_deprecated (void); #endif diff --git a/libguile/eq.c b/libguile/eq.c index 5a6f574d2..bbb061655 100644 --- a/libguile/eq.c +++ b/libguile/eq.c @@ -28,7 +28,6 @@ #include "libguile/stackchk.h" #include "libguile/strorder.h" #include "libguile/async.h" -#include "libguile/root.h" #include "libguile/smob.h" #include "libguile/arrays.h" #include "libguile/vectors.h" diff --git a/libguile/eval.c b/libguile/eval.c index a20572f01..87e6eacbf 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -51,7 +51,6 @@ #include "libguile/print.h" #include "libguile/procprop.h" #include "libguile/programs.h" -#include "libguile/root.h" #include "libguile/smob.h" #include "libguile/srcprop.h" #include "libguile/stackchk.h" diff --git a/libguile/feature.c b/libguile/feature.c index 9eb82ee7d..114d875a9 100644 --- a/libguile/feature.c +++ b/libguile/feature.c @@ -28,7 +28,6 @@ #endif #include "libguile/_scm.h" -#include "libguile/root.h" #include "libguile/strings.h" #include "libguile/validate.h" #include "libguile/fluids.h" diff --git a/libguile/fluids.h b/libguile/fluids.h index a550d9a34..2292e40e2 100644 --- a/libguile/fluids.h +++ b/libguile/fluids.h @@ -24,7 +24,6 @@ #include "libguile/__scm.h" -#include "libguile/root.h" #include "libguile/vectors.h" diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 894ca0668..586bf173d 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -43,7 +43,6 @@ extern unsigned long * __libc_ia64_register_backing_store_base; #include "libguile/arrays.h" #include "libguile/async.h" #include "libguile/ports.h" -#include "libguile/root.h" #include "libguile/strings.h" #include "libguile/vectors.h" #include "libguile/hashtab.h" diff --git a/libguile/gc.c b/libguile/gc.c index 4ef858c84..2b3bd36b0 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -45,7 +45,6 @@ extern unsigned long * __libc_ia64_register_backing_store_base; #include "libguile/arrays.h" #include "libguile/async.h" #include "libguile/ports.h" -#include "libguile/root.h" #include "libguile/simpos.h" #include "libguile/strings.h" #include "libguile/vectors.h" diff --git a/libguile/guardians.c b/libguile/guardians.c index 63b8ec0d5..cd4d9f3e2 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -54,7 +54,6 @@ #include "libguile/print.h" #include "libguile/smob.h" #include "libguile/validate.h" -#include "libguile/root.h" #include "libguile/hashtab.h" #include "libguile/deprecation.h" #include "libguile/eval.h" diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 4b9874488..8920e08a6 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -31,7 +31,6 @@ #include "libguile/alist.h" #include "libguile/hash.h" #include "libguile/eval.h" -#include "libguile/root.h" #include "libguile/vectors.h" #include "libguile/ports.h" #include "libguile/bdw-gc.h" diff --git a/libguile/hooks.c b/libguile/hooks.c index 14335f879..2a953a9b7 100644 --- a/libguile/hooks.c +++ b/libguile/hooks.c @@ -28,7 +28,6 @@ #include "libguile/eval.h" #include "libguile/ports.h" #include "libguile/procprop.h" -#include "libguile/root.h" #include "libguile/smob.h" #include "libguile/strings.h" diff --git a/libguile/init.c b/libguile/init.c index 8b0813a1b..a8f690b62 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -412,7 +412,6 @@ scm_i_init_guile (void *base) scm_smob_prehistory (); scm_init_variable (); scm_init_continuations (); /* requires smob_prehistory */ - scm_init_root (); /* requires continuations */ scm_init_threads (); /* requires smob_prehistory */ scm_init_gsubr (); scm_init_procprop (); diff --git a/libguile/keywords.c b/libguile/keywords.c index cd9c9d8a8..2c6078942 100644 --- a/libguile/keywords.c +++ b/libguile/keywords.c @@ -29,7 +29,6 @@ #include "libguile/_scm.h" #include "libguile/async.h" #include "libguile/ports.h" -#include "libguile/root.h" #include "libguile/smob.h" #include "libguile/hashtab.h" diff --git a/libguile/load.c b/libguile/load.c index 7ad9a754d..7b8136af8 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -37,7 +37,6 @@ #include "libguile/loader.h" #include "libguile/modules.h" #include "libguile/read.h" -#include "libguile/root.h" #include "libguile/srfi-13.h" #include "libguile/strings.h" #include "libguile/throw.h" diff --git a/libguile/numbers.c b/libguile/numbers.c index d0f6e628d..bc930af3b 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -62,7 +62,6 @@ #include "libguile/_scm.h" #include "libguile/feature.h" #include "libguile/ports.h" -#include "libguile/root.h" #include "libguile/smob.h" #include "libguile/strings.h" #include "libguile/bdw-gc.h" diff --git a/libguile/objprop.c b/libguile/objprop.c index b45c9aa26..e9ddbe4d9 100644 --- a/libguile/objprop.c +++ b/libguile/objprop.c @@ -26,7 +26,6 @@ #include "libguile/async.h" #include "libguile/hashtab.h" #include "libguile/alist.h" -#include "libguile/root.h" #include "libguile/objprop.h" diff --git a/libguile/ports.c b/libguile/ports.c index 1209b439a..20319bc0b 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -51,7 +51,6 @@ #include "libguile/keywords.h" #include "libguile/hashtab.h" -#include "libguile/root.h" #include "libguile/strings.h" #include "libguile/mallocs.h" #include "libguile/validate.h" diff --git a/libguile/print.c b/libguile/print.c index 8161d6581..9669dcf06 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -44,7 +44,6 @@ #include "libguile/struct.h" #include "libguile/ports.h" #include "libguile/ports-internal.h" -#include "libguile/root.h" #include "libguile/strings.h" #include "libguile/strports.h" #include "libguile/vectors.h" diff --git a/libguile/procprop.c b/libguile/procprop.c index d45536062..ad56bd5ba 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -29,7 +29,6 @@ #include "libguile/procs.h" #include "libguile/gsubr.h" #include "libguile/smob.h" -#include "libguile/root.h" #include "libguile/vectors.h" #include "libguile/weak-table.h" #include "libguile/programs.h" diff --git a/libguile/promises.c b/libguile/promises.c index 3bbb489d2..3ed229443 100644 --- a/libguile/promises.c +++ b/libguile/promises.c @@ -49,7 +49,6 @@ #include "libguile/print.h" #include "libguile/procprop.h" #include "libguile/programs.h" -#include "libguile/root.h" #include "libguile/smob.h" #include "libguile/srcprop.h" #include "libguile/stackchk.h" diff --git a/libguile/rdelim.c b/libguile/rdelim.c index 9d1496795..80962bc5e 100644 --- a/libguile/rdelim.c +++ b/libguile/rdelim.c @@ -33,7 +33,6 @@ #include "libguile/modules.h" #include "libguile/ports.h" #include "libguile/rdelim.h" -#include "libguile/root.h" #include "libguile/strings.h" #include "libguile/strports.h" #include "libguile/validate.h" diff --git a/libguile/read.c b/libguile/read.c index f8205fbeb..c7da054b0 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -47,7 +47,6 @@ #include "libguile/ports.h" #include "libguile/ports-internal.h" #include "libguile/fports.h" -#include "libguile/root.h" #include "libguile/strings.h" #include "libguile/strports.h" #include "libguile/vectors.h" diff --git a/libguile/root.c b/libguile/root.c deleted file mode 100644 index c83da1c3c..000000000 --- a/libguile/root.c +++ /dev/null @@ -1,200 +0,0 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000, 2001, 2002, 2006, 2008, 2009, 2012 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 3 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., 51 Franklin Street, Fifth Floor, Boston, MA - * 02110-1301 USA - */ - - - -#ifdef HAVE_CONFIG_H -# include -#endif - -#include -#include - -#include "libguile/_scm.h" -#include "libguile/stackchk.h" -#include "libguile/dynwind.h" -#include "libguile/eval.h" -#include "libguile/smob.h" -#include "libguile/pairs.h" -#include "libguile/throw.h" -#include "libguile/fluids.h" -#include "libguile/ports.h" - -#include "libguile/root.h" - - -/* {call-with-dynamic-root} - * - * Suspending the current thread to evaluate a thunk on the - * same C stack but under a new root. - * - * Calls to call-with-dynamic-root return exactly once (unless - * the process is somehow exitted). */ - -/* cwdr fills out both of these structures, and then passes a pointer - to them through scm_internal_catch to the cwdr_body and - cwdr_handler functions, to tell them how to behave and to get - information back from them. - - A cwdr is a lot like a catch, except there is no tag (all - exceptions are caught), and the body procedure takes the arguments - passed to cwdr as A1 and ARGS. The handler is also special since - it is not directly run from scm_internal_catch. It is executed - outside the new dynamic root. */ - -struct cwdr_body_data { - /* Arguments to pass to the cwdr body function. */ - SCM a1, args; - - /* Scheme procedure to use as body of cwdr. */ - SCM body_proc; -}; - -struct cwdr_handler_data { - /* Do we need to run the handler? */ - int run_handler; - - /* The tag and args to pass it. */ - SCM tag, args; -}; - - -/* Invoke the body of a cwdr, assuming that the throw handler has - already been set up. DATA points to a struct set up by cwdr that - says what proc to call, and what args to apply it to. - - With a little thought, we could replace this with scm_body_thunk, - but I don't want to mess with that at the moment. */ -static SCM -cwdr_body (void *data) -{ - struct cwdr_body_data *c = (struct cwdr_body_data *) data; - - return scm_apply (c->body_proc, c->a1, c->args); -} - -/* Record the fact that the body of the cwdr has thrown. Record - enough information to invoke the handler later when the dynamic - root has been deestablished. */ - -static SCM -cwdr_handler (void *data, SCM tag, SCM args) -{ - struct cwdr_handler_data *c = (struct cwdr_handler_data *) data; - - c->run_handler = 1; - c->tag = tag; - c->args = args; - return SCM_UNSPECIFIED; -} - -SCM -scm_internal_cwdr (scm_t_catch_body body, void *body_data, - scm_t_catch_handler handler, void *handler_data, - SCM_STACKITEM *stack_start) -{ - struct cwdr_handler_data my_handler_data; - scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack; - SCM answer; - scm_t_dynstack *old_dynstack; - - /* Exit caller's dynamic state. - */ - old_dynstack = scm_dynstack_capture_all (dynstack); - scm_dynstack_unwind (dynstack, SCM_DYNSTACK_FIRST (dynstack)); - - scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE); - scm_dynwind_current_dynamic_state (scm_make_dynamic_state (SCM_UNDEFINED)); - - my_handler_data.run_handler = 0; - answer = scm_i_with_continuation_barrier (body, body_data, - cwdr_handler, &my_handler_data, - NULL, NULL); - - scm_dynwind_end (); - - /* Enter caller's dynamic state. - */ - scm_dynstack_wind (dynstack, SCM_DYNSTACK_FIRST (old_dynstack)); - - /* Now run the real handler iff the body did a throw. */ - if (my_handler_data.run_handler) - return handler (handler_data, my_handler_data.tag, my_handler_data.args); - else - return answer; -} - -/* The original CWDR for invoking Scheme code with a Scheme handler. */ - -static SCM -cwdr (SCM proc, SCM a1, SCM args, SCM handler, SCM_STACKITEM *stack_start) -{ - struct cwdr_body_data c; - - c.a1 = a1; - c.args = args; - c.body_proc = proc; - - return scm_internal_cwdr (cwdr_body, &c, - scm_handle_by_proc, &handler, - stack_start); -} - -SCM_DEFINE (scm_call_with_dynamic_root, "call-with-dynamic-root", 2, 0, 0, - (SCM thunk, SCM handler), - "Call @var{thunk} with a new dynamic state and within\n" - "a continuation barrier. The @var{handler} catches all\n" - "otherwise uncaught throws and executes within the same\n" - "dynamic context as @var{thunk}.") -#define FUNC_NAME s_scm_call_with_dynamic_root -{ - SCM_STACKITEM stack_place; - return cwdr (thunk, SCM_EOL, SCM_EOL, handler, &stack_place); -} -#undef FUNC_NAME - -SCM_DEFINE (scm_dynamic_root, "dynamic-root", 0, 0, 0, - (), - "Return an object representing the current dynamic root.\n\n" - "These objects are only useful for comparison using @code{eq?}.\n") -#define FUNC_NAME s_scm_dynamic_root -{ - return SCM_I_CURRENT_THREAD->continuation_root; -} -#undef FUNC_NAME - -SCM -scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args, SCM handler) -{ - SCM_STACKITEM stack_place; - return cwdr (proc, a1, args, handler, &stack_place); -} - - - -void -scm_init_root () -{ -#include "libguile/root.x" -} - -/* - Local Variables: - c-file-style: "gnu" - End: -*/ diff --git a/libguile/root.h b/libguile/root.h deleted file mode 100644 index 68ab5c7ce..000000000 --- a/libguile/root.h +++ /dev/null @@ -1,48 +0,0 @@ -/* classes: h_files */ - -#ifndef SCM_ROOT_H -#define SCM_ROOT_H - -/* Copyright (C) 1996,1998,2000,2001, 2002, 2006, 2008, 2009 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 3 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., 51 Franklin Street, Fifth Floor, Boston, MA - * 02110-1301 USA - */ - - - -#include "libguile/__scm.h" -#include "libguile/debug.h" -#include "libguile/throw.h" - - - -SCM_API SCM scm_internal_cwdr (scm_t_catch_body body, - void *body_data, - scm_t_catch_handler handler, - void *handler_data, - SCM_STACKITEM *stack_start); -SCM_API SCM scm_call_with_dynamic_root (SCM thunk, SCM handler); -SCM_API SCM scm_dynamic_root (void); -SCM_API SCM scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args, SCM handler); -SCM_INTERNAL void scm_init_root (void); - -#endif /* SCM_ROOT_H */ - -/* - Local Variables: - c-file-style: "gnu" - End: -*/ diff --git a/libguile/rw.c b/libguile/rw.c index 91941a4fb..16dee5802 100644 --- a/libguile/rw.c +++ b/libguile/rw.c @@ -30,7 +30,6 @@ #include "libguile/_scm.h" #include "libguile/fports.h" #include "libguile/ports.h" -#include "libguile/root.h" #include "libguile/rw.h" #include "libguile/strings.h" #include "libguile/validate.h" diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index d852e7101..da2c3d195 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -45,7 +45,6 @@ #include "libguile/async.h" #include "libguile/eval.h" -#include "libguile/root.h" #include "libguile/vectors.h" #include "libguile/threads.h" diff --git a/libguile/srcprop.c b/libguile/srcprop.c index 963b2f881..9544f6857 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -33,7 +33,6 @@ #include "libguile/hashtab.h" #include "libguile/hash.h" #include "libguile/ports.h" -#include "libguile/root.h" #include "libguile/gc.h" #include "libguile/validate.h" diff --git a/libguile/stackchk.c b/libguile/stackchk.c index 146dac50f..96f72408d 100644 --- a/libguile/stackchk.c +++ b/libguile/stackchk.c @@ -24,7 +24,6 @@ #include "libguile/_scm.h" #include "libguile/ports.h" -#include "libguile/root.h" #include "libguile/threads.h" #include "libguile/dynwind.h" diff --git a/libguile/stacks.c b/libguile/stacks.c index 958103ad6..3d02d81f6 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -32,7 +32,6 @@ #include "libguile/macros.h" #include "libguile/procprop.h" #include "libguile/modules.h" -#include "libguile/root.h" #include "libguile/strings.h" #include "libguile/vm.h" /* to capture vm stacks */ #include "libguile/frames.h" /* vm frames */ diff --git a/libguile/strings.c b/libguile/strings.c index 232ddf90e..cdbc3587f 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -36,7 +36,6 @@ #include "libguile/_scm.h" #include "libguile/chars.h" -#include "libguile/root.h" #include "libguile/strings.h" #include "libguile/ports.h" #include "libguile/ports-internal.h" diff --git a/libguile/strports.c b/libguile/strports.c index e2bbe53ca..b12d6694a 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -33,7 +33,6 @@ #include "libguile/eval.h" #include "libguile/ports.h" #include "libguile/read.h" -#include "libguile/root.h" #include "libguile/strings.h" #include "libguile/modules.h" #include "libguile/validate.h" diff --git a/libguile/threads.c b/libguile/threads.c index 4b6d43c69..31a8cd48e 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -52,7 +52,6 @@ #include #include "libguile/validate.h" -#include "libguile/root.h" #include "libguile/eval.h" #include "libguile/async.h" #include "libguile/ports.h" diff --git a/libguile/threads.h b/libguile/threads.h index 986049c66..e8e56e71f 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -27,7 +27,6 @@ #include "libguile/__scm.h" #include "libguile/procs.h" #include "libguile/throw.h" -#include "libguile/root.h" #include "libguile/dynstack.h" #include "libguile/iselect.h" #include "libguile/continuations.h" diff --git a/libguile/values.c b/libguile/values.c index ef27cadd1..2b2ec3f51 100644 --- a/libguile/values.c +++ b/libguile/values.c @@ -26,7 +26,6 @@ #include "libguile/gc.h" #include "libguile/numbers.h" #include "libguile/ports.h" -#include "libguile/root.h" #include "libguile/strings.h" #include "libguile/struct.h" #include "libguile/validate.h" diff --git a/libguile/variable.c b/libguile/variable.c index b377b4140..c329bca1a 100644 --- a/libguile/variable.c +++ b/libguile/variable.c @@ -25,7 +25,6 @@ #include "libguile/_scm.h" #include "libguile/eq.h" #include "libguile/ports.h" -#include "libguile/root.h" #include "libguile/smob.h" #include "libguile/deprecation.h" diff --git a/libguile/vectors.c b/libguile/vectors.c index 5dab5454a..7ee7898c5 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -25,7 +25,6 @@ #include "libguile/_scm.h" #include "libguile/eq.h" -#include "libguile/root.h" #include "libguile/strings.h" #include "libguile/validate.h" diff --git a/libguile/vports.c b/libguile/vports.c index 0f3823bc2..29531cfb6 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -32,7 +32,6 @@ #include "libguile/ports.h" #include "libguile/ports-internal.h" #include "libguile/fports.h" -#include "libguile/root.h" #include "libguile/strings.h" #include "libguile/vectors.h" diff --git a/module/ice-9/serialize.scm b/module/ice-9/serialize.scm index 008a70a9e..340e56442 100644 --- a/module/ice-9/serialize.scm +++ b/module/ice-9/serialize.scm @@ -71,16 +71,16 @@ (lambda () (lock-mutex admin-mutex) (set! outer-owner owner) - (if (not (eqv? outer-owner (dynamic-root))) + (if (not (eqv? outer-owner (current-thread))) (begin (unlock-mutex admin-mutex) (lock-mutex serialization-mutex) - (set! owner (dynamic-root))) + (set! owner (current-thread))) (unlock-mutex admin-mutex))) thunk (lambda () (lock-mutex admin-mutex) - (if (not (eqv? outer-owner (dynamic-root))) + (if (not (eqv? outer-owner (current-thread))) (begin (set! owner #f) (unlock-mutex serialization-mutex))) @@ -95,7 +95,7 @@ (lambda () (lock-mutex admin-mutex) (set! outer-owner owner) - (if (eqv? outer-owner (dynamic-root)) + (if (eqv? outer-owner (current-thread)) (begin (set! owner #f) (unlock-mutex serialization-mutex))) @@ -103,7 +103,7 @@ thunk (lambda () (lock-mutex admin-mutex) - (if (eqv? outer-owner (dynamic-root)) + (if (eqv? outer-owner (current-thread)) (begin (unlock-mutex admin-mutex) (lock-mutex serialization-mutex)