diff options
Diffstat (limited to 'libguile/dynwind.c')
-rw-r--r-- | libguile/dynwind.c | 227 |
1 files changed, 32 insertions, 195 deletions
diff --git a/libguile/dynwind.c b/libguile/dynwind.c index 14dd861dc..4a0b0dd2b 100644 --- a/libguile/dynwind.c +++ b/libguile/dynwind.c @@ -1,5 +1,5 @@ -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2008, 2010, 2011 Free Software Foundation, Inc. - * +/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2008, 2010, 2011, 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 @@ -26,125 +26,71 @@ #include <assert.h> #include "libguile/_scm.h" -#include "libguile/control.h" +#include "libguile/dynstack.h" #include "libguile/eval.h" -#include "libguile/alist.h" -#include "libguile/fluids.h" #include "libguile/ports.h" -#include "libguile/smob.h" #include "libguile/dynwind.h" - - -/* {Dynamic wind} - - Things that can be on the wind list: - - #<frame> - #<winder> - #<with-fluids> - #<prompt> - (enter-proc . leave-proc) dynamic-wind - -*/ + SCM scm_dynamic_wind (SCM in_guard, SCM thunk, SCM out_guard) #define FUNC_NAME "dynamic-wind" { - SCM ans, old_winds; - SCM_ASSERT (scm_is_true (scm_thunk_p (out_guard)), - out_guard, + SCM ans; + scm_i_thread *thread = SCM_I_CURRENT_THREAD; + + SCM_ASSERT (scm_is_true (scm_thunk_p (out_guard)), out_guard, SCM_ARG3, FUNC_NAME); + scm_call_0 (in_guard); - old_winds = scm_i_dynwinds (); - scm_i_set_dynwinds (scm_acons (in_guard, out_guard, old_winds)); + scm_dynstack_push_dynwind (&thread->dynstack, in_guard, out_guard); + ans = scm_call_0 (thunk); - scm_i_set_dynwinds (old_winds); + + scm_dynstack_pop (&thread->dynstack); scm_call_0 (out_guard); + return ans; } #undef FUNC_NAME -/* Frames and winders. */ - -static scm_t_bits tc16_frame; -#define FRAME_P(f) SCM_SMOB_PREDICATE (tc16_frame, (f)) - -#define FRAME_F_REWINDABLE (1 << 0) -#define FRAME_REWINDABLE_P(f) (SCM_SMOB_FLAGS(f) & FRAME_F_REWINDABLE) - -static scm_t_bits tc16_winder; -#define WINDER_P(w) SCM_SMOB_PREDICATE (tc16_winder, (w)) -#define WINDER_PROC(w) ((void (*)(void *))SCM_SMOB_DATA (w)) -#define WINDER_DATA(w) ((void *)SCM_SMOB_DATA_2 (w)) - -#define WINDER_F_EXPLICIT (1 << 0) -#define WINDER_F_REWIND (1 << 1) -#define WINDER_F_MARK (1 << 2) -#define WINDER_EXPLICIT_P(w) (SCM_SMOB_FLAGS(w) & WINDER_F_EXPLICIT) -#define WINDER_REWIND_P(w) (SCM_SMOB_FLAGS(w) & WINDER_F_REWIND) -#define WINDER_MARK_P(w) (SCM_SMOB_FLAGS(w) & WINDER_F_MARK) void scm_dynwind_begin (scm_t_dynwind_flags flags) { - SCM f; - SCM_NEWSMOB (f, tc16_frame, 0); - if (flags & SCM_F_DYNWIND_REWINDABLE) - SCM_SET_SMOB_FLAGS (f, FRAME_F_REWINDABLE); - scm_i_set_dynwinds (scm_cons (f, scm_i_dynwinds ())); + scm_i_thread *thread = SCM_I_CURRENT_THREAD; + + scm_dynstack_push_frame (&thread->dynstack, flags); } void scm_dynwind_end (void) { - SCM winds; - - /* Unwind upto and including the next frame entry. We can only - encounter #<winder> entries on the way. - */ - - winds = scm_i_dynwinds (); - while (scm_is_pair (winds)) - { - SCM entry = SCM_CAR (winds); - winds = SCM_CDR (winds); - - scm_i_set_dynwinds (winds); - - if (FRAME_P (entry)) - return; - - assert (WINDER_P (entry)); - if (!WINDER_REWIND_P (entry) && WINDER_EXPLICIT_P (entry)) - WINDER_PROC(entry) (WINDER_DATA (entry)); - } - - assert (0); + scm_dynstack_unwind_frame (&SCM_I_CURRENT_THREAD->dynstack); } void scm_dynwind_unwind_handler (void (*proc) (void *), void *data, scm_t_wind_flags flags) { - SCM w; - SCM_NEWSMOB2 (w, tc16_winder, (scm_t_bits) proc, (scm_t_bits) data); - if (flags & SCM_F_WIND_EXPLICITLY) - SCM_SET_SMOB_FLAGS (w, WINDER_F_EXPLICIT); - scm_i_set_dynwinds (scm_cons (w, scm_i_dynwinds ())); + scm_i_thread *thread = SCM_I_CURRENT_THREAD; + scm_t_dynstack *dynstack = &thread->dynstack; + + scm_dynstack_push_unwinder (dynstack, flags, proc, data); } void scm_dynwind_rewind_handler (void (*proc) (void *), void *data, scm_t_wind_flags flags) { - SCM w; - SCM_NEWSMOB2 (w, tc16_winder, (scm_t_bits) proc, (scm_t_bits) data); - SCM_SET_SMOB_FLAGS (w, WINDER_F_REWIND); - scm_i_set_dynwinds (scm_cons (w, scm_i_dynwinds ())); + scm_i_thread *thread = SCM_I_CURRENT_THREAD; + scm_t_dynstack *dynstack = &thread->dynstack; + + scm_dynstack_push_rewinder (dynstack, 0, proc, data); + if (flags & SCM_F_WIND_EXPLICITLY) proc (data); } @@ -153,23 +99,16 @@ void scm_dynwind_unwind_handler_with_scm (void (*proc) (SCM), SCM data, scm_t_wind_flags flags) { - SCM w; - scm_t_bits fl = ((flags&SCM_F_WIND_EXPLICITLY)? WINDER_F_EXPLICIT : 0); - SCM_NEWSMOB2 (w, tc16_winder, (scm_t_bits) proc, SCM_UNPACK (data)); - SCM_SET_SMOB_FLAGS (w, fl | WINDER_F_MARK); - scm_i_set_dynwinds (scm_cons (w, scm_i_dynwinds ())); + /* FIXME: This is not a safe cast. */ + scm_dynwind_unwind_handler ((scm_t_guard) proc, SCM2PTR (data), flags); } void scm_dynwind_rewind_handler_with_scm (void (*proc) (SCM), SCM data, scm_t_wind_flags flags) { - SCM w; - SCM_NEWSMOB2 (w, tc16_winder, (scm_t_bits) proc, SCM_UNPACK (data)); - SCM_SET_SMOB_FLAGS (w, WINDER_F_REWIND | WINDER_F_MARK); - scm_i_set_dynwinds (scm_cons (w, scm_i_dynwinds ())); - if (flags & SCM_F_WIND_EXPLICITLY) - proc (data); + /* FIXME: This is not a safe cast. */ + scm_dynwind_rewind_handler ((scm_t_guard) proc, SCM2PTR (data), flags); } void @@ -178,24 +117,11 @@ scm_dynwind_free (void *mem) scm_dynwind_unwind_handler (free, mem, SCM_F_WIND_EXPLICITLY); } -#ifdef GUILE_DEBUG -SCM_DEFINE (scm_wind_chain, "wind-chain", 0, 0, 0, - (), - "Return the current wind chain. The wind chain contains all\n" - "information required by @code{dynamic-wind} to call its\n" - "argument thunks when entering/exiting its scope.") -#define FUNC_NAME s_scm_wind_chain -{ - return scm_i_dynwinds (); -} -#undef FUNC_NAME -#endif - void scm_swap_bindings (SCM vars, SCM vals) { SCM tmp; - while (SCM_NIMP (vals)) + while (scm_is_pair (vals)) { tmp = SCM_VARIABLE_REF (SCM_CAR (vars)); SCM_VARIABLE_SET (SCM_CAR (vars), SCM_CAR (vals)); @@ -206,97 +132,8 @@ scm_swap_bindings (SCM vars, SCM vals) } void -scm_dowinds (SCM to, long delta) -{ - scm_i_dowinds (to, delta, NULL, NULL); -} - -void -scm_i_dowinds (SCM to, long delta, void (*turn_func) (void *), void *data) -{ - tail: - if (scm_is_eq (to, scm_i_dynwinds ())) - { - if (turn_func) - turn_func (data); - } - else if (delta < 0) - { - SCM wind_elt; - - scm_i_dowinds (SCM_CDR (to), 1 + delta, turn_func, data); - wind_elt = SCM_CAR (to); - - if (FRAME_P (wind_elt)) - { - if (!FRAME_REWINDABLE_P (wind_elt)) - scm_misc_error ("dowinds", - "cannot invoke continuation from this context", - SCM_EOL); - } - else if (WINDER_P (wind_elt)) - { - if (WINDER_REWIND_P (wind_elt)) - WINDER_PROC (wind_elt) (WINDER_DATA (wind_elt)); - } - else if (SCM_WITH_FLUIDS_P (wind_elt)) - { - scm_i_swap_with_fluids (wind_elt, - SCM_I_CURRENT_THREAD->dynamic_state); - } - else if (SCM_PROMPT_P (wind_elt)) - ; /* pass -- see vm_reinstate_partial_continuation */ - else if (scm_is_pair (wind_elt)) - scm_call_0 (SCM_CAR (wind_elt)); - else - /* trash on the wind list */ - abort (); - - scm_i_set_dynwinds (to); - } - else - { - SCM wind; - SCM wind_elt; - - wind = scm_i_dynwinds (); - wind_elt = SCM_CAR (wind); - scm_i_set_dynwinds (SCM_CDR (wind)); - - if (FRAME_P (wind_elt)) - { - /* Nothing to do. */ - } - else if (WINDER_P (wind_elt)) - { - if (!WINDER_REWIND_P (wind_elt)) - WINDER_PROC (wind_elt) (WINDER_DATA (wind_elt)); - } - else if (SCM_WITH_FLUIDS_P (wind_elt)) - { - scm_i_swap_with_fluids (wind_elt, - SCM_I_CURRENT_THREAD->dynamic_state); - } - else if (SCM_PROMPT_P (wind_elt)) - ; /* pass -- though we could invalidate the prompt */ - else if (scm_is_pair (wind_elt)) - scm_call_0 (SCM_CDR (wind_elt)); - else - /* trash on the wind list */ - abort (); - - delta--; - goto tail; /* scm_dowinds(to, delta-1); */ - } -} - -void scm_init_dynwind () { - tc16_frame = scm_make_smob_type ("frame", 0); - - tc16_winder = scm_make_smob_type ("winder", 0); - #include "libguile/dynwind.x" } |