49 |
#include "libguile/root.h" |
#include "libguile/root.h" |
50 |
#include "libguile/smob.h" |
#include "libguile/smob.h" |
51 |
#include "libguile/lang.h" |
#include "libguile/lang.h" |
52 |
|
#include "libguile/dynwind.h" |
53 |
#include "libguile/deprecation.h" |
#include "libguile/deprecation.h" |
54 |
|
|
55 |
#include "libguile/validate.h" |
#include "libguile/validate.h" |
62 |
#include <unistd.h> |
#include <unistd.h> |
63 |
#endif |
#endif |
64 |
|
|
65 |
|
/* This is not used for anything except checking that DEFER_INTS and |
66 |
|
ALLOW_INTS are used properly. |
67 |
|
*/ |
68 |
|
int scm_ints_disabled = 1; |
69 |
|
|
70 |
|
|
71 |
/* {Asynchronous Events} |
/* {Asynchronous Events} |
96 |
* implement yourself. |
* implement yourself. |
97 |
*/ |
*/ |
98 |
|
|
|
/* True between SCM_DEFER_INTS and SCM_ALLOW_INTS, and |
|
|
* when the interpreter is not running at all. |
|
|
*/ |
|
|
int scm_ints_disabled = 1; |
|
|
unsigned int scm_mask_ints = 1; |
|
99 |
|
|
100 |
|
|
101 |
|
|
149 |
SCM_VALIDATE_CONS (1, list_of_a); |
SCM_VALIDATE_CONS (1, list_of_a); |
150 |
a = SCM_CAR (list_of_a); |
a = SCM_CAR (list_of_a); |
151 |
VALIDATE_ASYNC (SCM_ARG1, a); |
VALIDATE_ASYNC (SCM_ARG1, a); |
|
scm_mask_ints = 1; |
|
152 |
if (ASYNC_GOT_IT (a)) |
if (ASYNC_GOT_IT (a)) |
153 |
{ |
{ |
154 |
SET_ASYNC_GOT_IT (a, 0); |
SET_ASYNC_GOT_IT (a, 0); |
155 |
scm_call_0 (ASYNC_THUNK (a)); |
scm_call_0 (ASYNC_THUNK (a)); |
156 |
} |
} |
|
scm_mask_ints = 0; |
|
157 |
list_of_a = SCM_CDR (list_of_a); |
list_of_a = SCM_CDR (list_of_a); |
158 |
} |
} |
159 |
return SCM_BOOL_T; |
return SCM_BOOL_T; |
169 |
{ |
{ |
170 |
SCM asyncs; |
SCM asyncs; |
171 |
|
|
172 |
if (!scm_mask_ints) |
if (scm_root->block_asyncs == 0) |
173 |
{ |
{ |
174 |
while (!SCM_NULLP(asyncs = scm_active_asyncs)) |
while (!SCM_NULLP(asyncs = scm_root->active_asyncs)) |
175 |
{ |
{ |
176 |
scm_active_asyncs = SCM_EOL; |
scm_root->active_asyncs = SCM_EOL; |
177 |
do |
do |
178 |
{ |
{ |
179 |
SCM c = SCM_CDR (asyncs); |
SCM c = SCM_CDR (asyncs); |
262 |
|
|
263 |
|
|
264 |
|
|
265 |
|
#if (SCM_DEBUG_DEPRECATED == 0) |
266 |
|
|
267 |
SCM_DEFINE (scm_unmask_signals, "unmask-signals", 0, 0, 0, |
SCM_DEFINE (scm_unmask_signals, "unmask-signals", 0, 0, 0, |
268 |
(), |
(), |
269 |
"Unmask signals. The returned value is not specified.") |
"Unmask signals. The returned value is not specified.") |
270 |
#define FUNC_NAME s_scm_unmask_signals |
#define FUNC_NAME s_scm_unmask_signals |
271 |
{ |
{ |
272 |
scm_mask_ints = 0; |
scm_c_issue_deprecation_warning |
273 |
|
("'unmask-signals' is deprecated. " |
274 |
|
"Use 'call-with-blocked-asyncs' instead."); |
275 |
|
|
276 |
|
if (scm_root->block_asyncs == 0) |
277 |
|
SCM_MISC_ERROR ("signals already unmasked", SCM_EOL); |
278 |
|
scm_root->block_asyncs = 0; |
279 |
return SCM_UNSPECIFIED; |
return SCM_UNSPECIFIED; |
280 |
} |
} |
281 |
#undef FUNC_NAME |
#undef FUNC_NAME |
286 |
"Mask signals. The returned value is not specified.") |
"Mask signals. The returned value is not specified.") |
287 |
#define FUNC_NAME s_scm_mask_signals |
#define FUNC_NAME s_scm_mask_signals |
288 |
{ |
{ |
289 |
scm_mask_ints = 1; |
scm_c_issue_deprecation_warning |
290 |
|
("'mask-signals' is deprecated. Use 'call-with-blocked-asyncs' instead."); |
291 |
|
|
292 |
|
if (scm_root->block_asyncs > 0) |
293 |
|
SCM_MISC_ERROR ("signals already masked", SCM_EOL); |
294 |
|
scm_root->block_asyncs = 1; |
295 |
return SCM_UNSPECIFIED; |
return SCM_UNSPECIFIED; |
296 |
} |
} |
297 |
#undef FUNC_NAME |
#undef FUNC_NAME |
298 |
|
|
299 |
|
#endif /* SCM_DEBUG_DEPRECATED == 0 */ |
300 |
|
|
301 |
|
static void |
302 |
|
increase_block (void *unused) |
303 |
|
{ |
304 |
|
scm_root->block_asyncs++; |
305 |
|
} |
306 |
|
|
307 |
|
static void |
308 |
|
decrease_block (void *unused) |
309 |
|
{ |
310 |
|
scm_root->block_asyncs--; |
311 |
|
} |
312 |
|
|
313 |
|
SCM_DEFINE (scm_call_with_blocked_asyncs, "call-with-blocked-asyncs", 1, 0, 0, |
314 |
|
(SCM proc), |
315 |
|
"Call @var{proc} with no arguments and block the execution\n" |
316 |
|
"of system asyncs by one level for the current thread while\n" |
317 |
|
"it is running. Return the value returned by @var{proc}.\n") |
318 |
|
#define FUNC_NAME s_scm_call_with_blocked_asyncs |
319 |
|
{ |
320 |
|
return scm_internal_dynamic_wind (increase_block, |
321 |
|
(scm_t_inner) scm_call_0, |
322 |
|
decrease_block, |
323 |
|
proc, NULL); |
324 |
|
} |
325 |
|
#undef FUNC_NAME |
326 |
|
|
327 |
|
void * |
328 |
|
scm_c_call_with_blocked_asyncs (void *(*proc) (void *data), void *data) |
329 |
|
{ |
330 |
|
return scm_internal_dynamic_wind (increase_block, |
331 |
|
(scm_t_inner) proc, |
332 |
|
decrease_block, |
333 |
|
data, NULL); |
334 |
|
} |
335 |
|
|
336 |
|
|
337 |
|
SCM_DEFINE (scm_call_with_unblocked_asyncs, "call-with-unblocked-asyncs", 1, 0, 0, |
338 |
|
(SCM proc), |
339 |
|
"Call @var{proc} with no arguments and unblock the execution\n" |
340 |
|
"of system asyncs by one level for the current thread while\n" |
341 |
|
"it is running. Return the value returned by @var{proc}.\n") |
342 |
|
#define FUNC_NAME s_scm_call_with_unblocked_asyncs |
343 |
|
{ |
344 |
|
if (scm_root->block_asyncs == 0) |
345 |
|
SCM_MISC_ERROR ("asyncs already unblocked", SCM_EOL); |
346 |
|
return scm_internal_dynamic_wind (decrease_block, |
347 |
|
(scm_t_inner) scm_call_0, |
348 |
|
increase_block, |
349 |
|
proc, NULL); |
350 |
|
} |
351 |
|
#undef FUNC_NAME |
352 |
|
|
353 |
|
void * |
354 |
|
scm_c_call_with_unblocked_asyncs (void *(*proc) (void *data), void *data) |
355 |
|
{ |
356 |
|
if (scm_root->block_asyncs == 0) |
357 |
|
scm_misc_error ("scm_c_call_with_unblocked_asyncs", |
358 |
|
"asyncs already unblocked", SCM_EOL); |
359 |
|
return scm_internal_dynamic_wind (decrease_block, |
360 |
|
(scm_t_inner) proc, |
361 |
|
increase_block, |
362 |
|
data, NULL); |
363 |
|
} |
364 |
|
|
365 |
|
|
366 |
|
|
367 |
void |
void |