1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

merge strictness branch from 2.0

This commit is contained in:
Andy Wingo 2011-05-13 15:45:43 +02:00
commit 86fb1eb631
52 changed files with 402 additions and 340 deletions

View file

@ -325,16 +325,37 @@ SCM_DEFINE (scm_noop, "noop", 0, 0, 1,
static void
increase_block (void *data)
{
((scm_i_thread *)data)->block_asyncs++;
scm_i_thread *t = data;
t->block_asyncs++;
}
static void
decrease_block (void *data)
{
if (--((scm_i_thread *)data)->block_asyncs == 0)
scm_i_thread *t = data;
if (--t->block_asyncs == 0)
scm_async_click ();
}
void
scm_dynwind_block_asyncs (void)
{
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);
}
void
scm_dynwind_unblock_asyncs (void)
{
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,
(SCM proc),
"Call @var{proc} with no arguments and block the execution\n"
@ -342,22 +363,28 @@ 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;
}
@ -368,46 +395,35 @@ SCM_DEFINE (scm_call_with_unblocked_asyncs, "call-with-unblocked-asyncs", 1, 0,
"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;
}