-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006 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
*
* 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
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#<winder>
(enter-proc . leave-proc) dynamic-wind
(tag . jmpbuf) catch
- (tag . lazy-catch) lazy-catch
+ (tag . pre-unwind-data) throw-handler / lazy-catch
tag is either a symbol or a boolean
*/
"@end lisp")
#define FUNC_NAME s_scm_dynamic_wind
{
- SCM ans;
- SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (out_guard)),
+ SCM ans, old_winds;
+ SCM_ASSERT (scm_is_true (scm_thunk_p (out_guard)),
out_guard,
SCM_ARG3, FUNC_NAME);
scm_call_0 (in_guard);
- scm_dynwinds = scm_acons (in_guard, out_guard, scm_dynwinds);
+ old_winds = scm_i_dynwinds ();
+ scm_i_set_dynwinds (scm_acons (in_guard, out_guard, old_winds));
ans = scm_call_0 (thunk);
- scm_dynwinds = SCM_CDR (scm_dynwinds);
+ scm_i_set_dynwinds (old_winds);
scm_call_0 (out_guard);
return ans;
}
{
SCM ans;
- scm_frame_begin (SCM_F_FRAME_REWINDABLE);
- scm_frame_rewind_handler (before, guard_data, SCM_F_WIND_EXPLICITLY);
- scm_frame_unwind_handler (after, guard_data, SCM_F_WIND_EXPLICITLY);
+ scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
+ scm_dynwind_rewind_handler (before, guard_data, SCM_F_WIND_EXPLICITLY);
+ scm_dynwind_unwind_handler (after, guard_data, SCM_F_WIND_EXPLICITLY);
ans = inner (inner_data);
- scm_frame_end ();
+ scm_dynwind_end ();
return ans;
}
static scm_t_bits tc16_frame;
#define FRAME_P(f) SCM_SMOB_PREDICATE (tc16_frame, (f))
-#define FRAME_F_REWINDABLE (1 << 16)
-#define FRAME_REWINDABLE_P(f) (SCM_CELL_WORD_0(f) & FRAME_F_REWINDABLE)
+#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_CELL_WORD_1 (w))
-#define WINDER_DATA(w) ((void *)SCM_CELL_WORD_2 (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 << 16)
-#define WINDER_F_REWIND (1 << 17)
-#define WINDER_F_MARK (1 << 18)
-#define WINDER_EXPLICIT_P(w) (SCM_CELL_WORD_0(w) & WINDER_F_EXPLICIT)
-#define WINDER_REWIND_P(w) (SCM_CELL_WORD_0(w) & WINDER_F_REWIND)
-#define WINDER_MARK_P(w) (SCM_CELL_WORD_0(w) & WINDER_F_MARK)
+#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_frame_begin (scm_t_frame_flags flags)
+scm_dynwind_begin (scm_t_dynwind_flags flags)
{
SCM f;
- scm_t_bits fl = ((flags&SCM_F_FRAME_REWINDABLE)? FRAME_F_REWINDABLE : 0);
- SCM_NEWSMOB (f, tc16_frame | fl, 0);
- scm_dynwinds = scm_cons (f, scm_dynwinds);
+ 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 ()));
}
void
-scm_frame_end (void)
+scm_dynwind_end (void)
{
+ SCM winds;
+
/* Unwind upto and including the next frame entry. We can only
encounter #<winder> entries on the way.
*/
- while (SCM_CONSP (scm_dynwinds))
+ winds = scm_i_dynwinds ();
+ while (scm_is_pair (winds))
{
- SCM entry = SCM_CAR (scm_dynwinds);
- scm_dynwinds = SCM_CDR (scm_dynwinds);
+ SCM entry = SCM_CAR (winds);
+ winds = SCM_CDR (winds);
+
+ scm_i_set_dynwinds (winds);
if (FRAME_P (entry))
return;
winder_mark (SCM w)
{
if (WINDER_MARK_P (w))
- return WINDER_DATA (w);
+ return SCM_PACK (WINDER_DATA (w));
return SCM_BOOL_F;
}
void
-scm_frame_unwind_handler (void (*proc) (void *), void *data,
- scm_t_wind_flags flags)
+scm_dynwind_unwind_handler (void (*proc) (void *), void *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 | fl,
- (scm_t_bits) proc, (scm_t_bits) data);
- scm_dynwinds = scm_cons (w, scm_dynwinds);
+ 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 ()));
}
void
-scm_frame_rewind_handler (void (*proc) (void *), void *data,
- scm_t_wind_flags flags)
+scm_dynwind_rewind_handler (void (*proc) (void *), void *data,
+ scm_t_wind_flags flags)
{
SCM w;
- SCM_NEWSMOB2 (w, tc16_winder | WINDER_F_REWIND,
- (scm_t_bits) proc, (scm_t_bits) data);
- scm_dynwinds = scm_cons (w, scm_dynwinds);
+ 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 ()));
if (flags & SCM_F_WIND_EXPLICITLY)
proc (data);
}
void
-scm_frame_unwind_handler_with_scm (void (*proc) (SCM), SCM data,
- scm_t_wind_flags flags)
+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 | fl | WINDER_F_MARK,
- (scm_t_bits) proc, SCM_UNPACK (data));
- scm_dynwinds = scm_cons (w, scm_dynwinds);
+ 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 ()));
}
void
-scm_frame_rewind_handler_with_scm (void (*proc) (SCM), SCM data,
- scm_t_wind_flags flags)
+scm_dynwind_rewind_handler_with_scm (void (*proc) (SCM), SCM data,
+ scm_t_wind_flags flags)
{
SCM w;
- SCM_NEWSMOB2 (w, tc16_winder | WINDER_F_REWIND | WINDER_F_MARK,
- (scm_t_bits) proc, SCM_UNPACK (data));
- scm_dynwinds = scm_cons (w, scm_dynwinds);
+ 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);
}
+void
+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,
(),
"argument thunks when entering/exiting its scope.")
#define FUNC_NAME s_scm_wind_chain
{
- return scm_dynwinds;
+ return scm_i_dynwinds ();
}
#undef FUNC_NAME
#endif
scm_i_dowinds (SCM to, long delta, void (*turn_func) (void *), void *data)
{
tail:
- if (SCM_EQ_P (to, scm_dynwinds))
+ if (scm_is_eq (to, scm_i_dynwinds ()))
{
if (turn_func)
turn_func (data);
scm_i_dowinds (SCM_CDR (to), 1 + delta, turn_func, data);
wind_elt = SCM_CAR (to);
-#if 0
- if (SCM_INUMP (wind_elt))
+ 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))
{
- scm_cross_dynwind_binding_scope (wind_elt, 0);
+ if (WINDER_REWIND_P (wind_elt))
+ WINDER_PROC (wind_elt) (WINDER_DATA (wind_elt));
}
else
-#endif
{
- if (FRAME_P (wind_elt))
+ wind_key = SCM_CAR (wind_elt);
+ /* key = #t | symbol | thunk | list of variables */
+ if (SCM_NIMP (wind_key))
{
- 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
- {
- wind_key = SCM_CAR (wind_elt);
- /* key = #t | symbol | thunk | list of variables */
- if (SCM_NIMP (wind_key))
+ if (scm_is_pair (wind_key))
{
- if (SCM_CONSP (wind_key))
- {
- if (SCM_VARIABLEP (SCM_CAR (wind_key)))
- scm_swap_bindings (wind_key, SCM_CDR (wind_elt));
- }
- else if (SCM_TYP3 (wind_key) == scm_tc3_closure)
- scm_call_0 (wind_key);
+ if (SCM_VARIABLEP (SCM_CAR (wind_key)))
+ scm_swap_bindings (wind_key, SCM_CDR (wind_elt));
}
+ else if (SCM_TYP3 (wind_key) == scm_tc3_closure)
+ scm_call_0 (wind_key);
}
}
- scm_dynwinds = to;
+
+ scm_i_set_dynwinds (to);
}
else
{
+ SCM wind;
SCM wind_elt;
SCM wind_key;
- wind_elt = SCM_CAR (scm_dynwinds);
- scm_dynwinds = SCM_CDR (scm_dynwinds);
+ wind = scm_i_dynwinds ();
+ wind_elt = SCM_CAR (wind);
+ scm_i_set_dynwinds (SCM_CDR (wind));
-#if 0
- if (SCM_INUMP (wind_elt))
+ if (FRAME_P (wind_elt))
+ {
+ /* Nothing to do. */
+ }
+ else if (WINDER_P (wind_elt))
{
- scm_cross_dynwind_binding_scope (wind_elt, 0);
+ if (!WINDER_REWIND_P (wind_elt))
+ WINDER_PROC (wind_elt) (WINDER_DATA (wind_elt));
}
else
-#endif
{
- if (FRAME_P (wind_elt))
- {
- /* Nothing to do. */
- }
- else if (WINDER_P (wind_elt))
+ wind_key = SCM_CAR (wind_elt);
+ if (SCM_NIMP (wind_key))
{
- if (!WINDER_REWIND_P (wind_elt))
- WINDER_PROC (wind_elt) (WINDER_DATA (wind_elt));
- }
- else
- {
- wind_key = SCM_CAR (wind_elt);
- if (SCM_NIMP (wind_key))
+ if (scm_is_pair (wind_key))
{
- if (SCM_CONSP (wind_key))
- {
- if (SCM_VARIABLEP (SCM_CAR (wind_key)))
- scm_swap_bindings (wind_key, SCM_CDR (wind_elt));
- }
- else if (SCM_TYP3 (wind_key) == scm_tc3_closure)
- scm_call_0 (SCM_CDR (wind_elt));
+ if (SCM_VARIABLEP (SCM_CAR (wind_key)))
+ scm_swap_bindings (wind_key, SCM_CDR (wind_elt));
}
+ else if (SCM_TYP3 (wind_key) == scm_tc3_closure)
+ scm_call_0 (SCM_CDR (wind_elt));
}
}
+
delta--;
goto tail; /* scm_dowinds(to, delta-1); */
}
HCoop / bpt / guile.git / blobdiff