-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2006, 2008, 2009, 2010, 2011 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
# include <config.h>
#endif
-#define SCM_BUILDING_DEPRECATED_CODE
-
-#include <signal.h>
#include "libguile/_scm.h"
#include "libguile/eval.h"
#include "libguile/throw.h"
#include "libguile/root.h"
#include "libguile/smob.h"
-#include "libguile/lang.h"
#include "libguile/dynwind.h"
#include "libguile/deprecation.h"
#define SCM_ASYNCP(X) SCM_TYP16_PREDICATE (tc16_async, X)
#define VALIDATE_ASYNC(pos, a) SCM_MAKE_VALIDATE_MSG(pos, a, ASYNCP, "user async")
-#define ASYNC_GOT_IT(X) (SCM_CELL_WORD_0 (X) >> 16)
-#define SET_ASYNC_GOT_IT(X, V) (SCM_SET_CELL_WORD_0 ((X), SCM_TYP16 (X) | ((V) << 16)))
-#define ASYNC_THUNK(X) SCM_CELL_OBJECT_1 (X)
+#define ASYNC_GOT_IT(X) (SCM_SMOB_FLAGS (X))
+#define SET_ASYNC_GOT_IT(X, V) (SCM_SET_SMOB_FLAGS ((X), ((V))))
+#define ASYNC_THUNK(X) SCM_SMOB_OBJECT_1 (X)
SCM_DEFINE (scm_async, "async", 1, 0, 0,
/* System asyncs. */
void
-scm_async_click ()
+scm_async_tick (void)
{
scm_i_thread *t = SCM_I_CURRENT_THREAD;
SCM asyncs;
}
}
-#if (SCM_ENABLE_DEPRECATED == 1)
-
-SCM_DEFINE (scm_system_async, "system-async", 1, 0, 0,
- (SCM thunk),
- "This function is deprecated. You can use @var{thunk} directly\n"
- "instead of explicitly creating an async object.\n")
-#define FUNC_NAME s_scm_system_async
-{
- scm_c_issue_deprecation_warning
- ("'system-async' is deprecated. "
- "Use the procedure directly with 'system-async-mark'.");
- return thunk;
-}
-#undef FUNC_NAME
-
-#endif /* SCM_ENABLE_DEPRECATED == 1 */
-
void
scm_i_queue_async_cell (SCM c, scm_i_thread *t)
{
\f
-#if (SCM_ENABLE_DEPRECATED == 1)
-
-SCM_DEFINE (scm_unmask_signals, "unmask-signals", 0, 0, 0,
- (),
- "Unmask signals. The returned value is not specified.")
-#define FUNC_NAME s_scm_unmask_signals
+static void
+increase_block (void *data)
{
- scm_i_thread *t = SCM_I_CURRENT_THREAD;
-
- scm_c_issue_deprecation_warning
- ("'unmask-signals' is deprecated. "
- "Use 'call-with-blocked-asyncs' instead.");
-
- if (t->block_asyncs == 0)
- SCM_MISC_ERROR ("signals already unmasked", SCM_EOL);
- t->block_asyncs = 0;
- scm_async_click ();
- return SCM_UNSPECIFIED;
+ scm_i_thread *t = data;
+ t->block_asyncs++;
}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_mask_signals, "mask-signals", 0, 0, 0,
- (),
- "Mask signals. The returned value is not specified.")
-#define FUNC_NAME s_scm_mask_signals
+static void
+decrease_block (void *data)
{
- scm_i_thread *t = SCM_I_CURRENT_THREAD;
-
- scm_c_issue_deprecation_warning
- ("'mask-signals' is deprecated. Use 'call-with-blocked-asyncs' instead.");
-
- if (t->block_asyncs > 0)
- SCM_MISC_ERROR ("signals already masked", SCM_EOL);
- t->block_asyncs = 1;
- return SCM_UNSPECIFIED;
+ scm_i_thread *t = data;
+ if (--t->block_asyncs == 0)
+ scm_async_tick ();
}
-#undef FUNC_NAME
-#endif /* SCM_ENABLE_DEPRECATED == 1 */
-
-static void
-increase_block (void *data)
+void
+scm_dynwind_block_asyncs (void)
{
- ((scm_i_thread *)data)->block_asyncs++;
+ scm_i_thread *t = SCM_I_CURRENT_THREAD;
+ scm_dynwind_rewind_handler (increase_block, t, SCM_F_WIND_EXPLICITLY);
+ scm_dynwind_unwind_handler (decrease_block, t, SCM_F_WIND_EXPLICITLY);
}
-static void
-decrease_block (void *data)
+void
+scm_dynwind_unblock_asyncs (void)
{
- if (--((scm_i_thread *)data)->block_asyncs == 0)
- scm_async_click ();
+ scm_i_thread *t = SCM_I_CURRENT_THREAD;
+ if (t->block_asyncs == 0)
+ scm_misc_error ("scm_with_unblocked_asyncs",
+ "asyncs already unblocked", SCM_EOL);
+ scm_dynwind_rewind_handler (decrease_block, t, SCM_F_WIND_EXPLICITLY);
+ scm_dynwind_unwind_handler (increase_block, t, SCM_F_WIND_EXPLICITLY);
}
SCM_DEFINE (scm_call_with_blocked_asyncs, "call-with-blocked-asyncs", 1, 0, 0,
"it is running. Return the value returned by @var{proc}.\n")
#define FUNC_NAME s_scm_call_with_blocked_asyncs
{
- return scm_internal_dynamic_wind (increase_block,
- (scm_t_inner) scm_call_0,
- decrease_block,
- (void *)proc,
- SCM_I_CURRENT_THREAD);
+ SCM ans;
+
+ scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
+ scm_dynwind_block_asyncs ();
+ ans = scm_call_0 (proc);
+ scm_dynwind_end ();
+
+ return ans;
}
#undef FUNC_NAME
void *
scm_c_call_with_blocked_asyncs (void *(*proc) (void *data), void *data)
{
- return (void *)scm_internal_dynamic_wind (increase_block,
- (scm_t_inner) proc,
- decrease_block,
- data,
- SCM_I_CURRENT_THREAD);
+ void* ans;
+
+ scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
+ scm_dynwind_block_asyncs ();
+ ans = proc (data);
+ scm_dynwind_end ();
+
+ return ans;
}
"it is running. Return the value returned by @var{proc}.\n")
#define FUNC_NAME s_scm_call_with_unblocked_asyncs
{
+ SCM ans;
+
if (SCM_I_CURRENT_THREAD->block_asyncs == 0)
SCM_MISC_ERROR ("asyncs already unblocked", SCM_EOL);
- return scm_internal_dynamic_wind (decrease_block,
- (scm_t_inner) scm_call_0,
- increase_block,
- (void *)proc,
- SCM_I_CURRENT_THREAD);
+
+ scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
+ scm_dynwind_unblock_asyncs ();
+ ans = scm_call_0 (proc);
+ scm_dynwind_end ();
+
+ return ans;
}
#undef FUNC_NAME
void *
scm_c_call_with_unblocked_asyncs (void *(*proc) (void *data), void *data)
{
+ void* ans;
+
if (SCM_I_CURRENT_THREAD->block_asyncs == 0)
scm_misc_error ("scm_c_call_with_unblocked_asyncs",
"asyncs already unblocked", SCM_EOL);
- return (void *)scm_internal_dynamic_wind (decrease_block,
- (scm_t_inner) proc,
- increase_block,
- data,
- SCM_I_CURRENT_THREAD);
-}
-void
-scm_dynwind_block_asyncs ()
-{
- scm_i_thread *t = SCM_I_CURRENT_THREAD;
- scm_dynwind_rewind_handler (increase_block, t, SCM_F_WIND_EXPLICITLY);
- scm_dynwind_unwind_handler (decrease_block, t, SCM_F_WIND_EXPLICITLY);
-}
+ scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
+ scm_dynwind_unblock_asyncs ();
+ ans = proc (data);
+ scm_dynwind_end ();
-void
-scm_dynwind_unblock_asyncs ()
-{
- scm_i_thread *t = SCM_I_CURRENT_THREAD;
- if (t->block_asyncs == 0)
- scm_misc_error ("scm_with_unblocked_asyncs",
- "asyncs already unblocked", SCM_EOL);
- scm_dynwind_rewind_handler (decrease_block, t, SCM_F_WIND_EXPLICITLY);
- scm_dynwind_unwind_handler (increase_block, t, SCM_F_WIND_EXPLICITLY);
+ return ans;
}
\f
SCM_CRITICAL_SECTION_END;
}
-void
-scm_async_tick (void)
-{
- SCM_ASYNC_TICK;
-}
-
\f
void
scm_init_async ()
{
- scm_asyncs = SCM_EOL;
tc16_async = scm_make_smob_type ("async", 0);
#include "libguile/async.x"
HCoop / bpt / guile.git / blobdiff