141 |
it's captured and comparing with the current id when the continuation |
it's captured and comparing with the current id when the continuation |
142 |
is invoked. |
is invoked. |
143 |
|
|
144 |
To implemnent the continuation barrier, for each thread we can have a |
To implement the continuation barrier, for each thread we can have a |
145 |
simple list representing the barrier (let's call it |
simple list representing the barrier (let's call it |
146 |
call-with-continuation-barrier, cwcb) dynamic state. The head of the |
with-continuation-barrier, wcb) dynamic state. The head of the list |
147 |
list would be stored in a thread-local location. Whenever the scope |
would be stored in a thread-local location. Whenever the scope of a |
148 |
of a cwcb expression is entered, a new cons cell could be inserted at |
wcb expression is entered, a new cons cell could be inserted at the |
149 |
the head of the list. When the scope is exited, the cell would be |
head of the list. When the scope is exited, the cell would be removed |
150 |
removed (this implies a need for an integrated exception handler, to |
(this implies a need for an integrated exception handler, to catch |
151 |
catch non-local exit. Non-local exit or entry by continuation will |
non-local exit. Non-local exit or entry by continuation will not be |
152 |
not be possible). A pointer to the cell at the head of the list would |
possible). A pointer to the cell at the head of the list would be |
153 |
be stored in a continuation when it is captured. When a continuation |
stored in a continuation when it is captured. When a continuation is |
154 |
is invoked, the stored cell pointer can be compared with the address |
invoked, the stored cell pointer can be compared with the address of |
155 |
of the cell currently at the head of the list. |
the cell currently at the head of the list. |
156 |
|
|
157 |
This cwcb list comparison would also prevent cross-thread invokation, |
This wcb list comparison would also prevent cross-thread invokation, |
158 |
so comparison of thread-ids can be dropped. |
so comparison of thread-ids can be dropped. |
159 |
|
|
160 |
|
An example implementation to play with is attached below. |
161 |
|
|
162 |
Convenience |
Convenience |
163 |
=========== |
=========== |
164 |
|
|
165 |
For ease of use, we would like to have a single facility to set up |
For ease of use, we would like to have a single facility to set up |
166 |
both continuation and exception handlers. Such an interface should |
both continuation and exception handlers. An exception handler is |
167 |
take at least a) the callback to be protected b) and exception handler |
needed in any case in the implementation discussed above. Such an |
168 |
and associated handler data to be passed to scm_internal_catch. |
interface in C should take at least a) the callback to be protected b) |
169 |
|
and exception handler and associated handler data to be passed to |
170 |
|
scm_internal_catch. |
171 |
|
|
172 |
How should the callback procedure be passed to the interface and |
How should the callback procedure be passed to the interface and |
173 |
invoked? Should it be like scm_internal_catch where it's passed as a |
invoked? Should it be like scm_internal_catch where it's passed as a |
215 |
Thread on guile-devel mailing list discussing the use of |
Thread on guile-devel mailing list discussing the use of |
216 |
call-with-dynamic-root by applications, Sept 2001. |
call-with-dynamic-root by applications, Sept 2001. |
217 |
-- http://mail.gnu.org/pipermail/guile-devel/2001-September/003684.html |
-- http://mail.gnu.org/pipermail/guile-devel/2001-September/003684.html |
218 |
|
|
219 |
|
Example implementation |
220 |
|
====================== |
221 |
|
|
222 |
|
This is a diff against CVS HEAD 2002-04-21. Note: it disables the |
223 |
|
checking of the existing continuation->seq in continuation_apply |
224 |
|
to simplify testing: in practice the seq test would remain until |
225 |
|
call-with-dynamic-root was removed (since it's independent, it |
226 |
|
can be deprecated as normal). |
227 |
|
|
228 |
|
Index: continuations.c |
229 |
|
=================================================================== |
230 |
|
RCS file: /cvsroot/guile/guile/guile-core/libguile/continuations.c,v |
231 |
|
retrieving revision 1.44 |
232 |
|
diff -u -r1.44 continuations.c |
233 |
|
--- continuations.c 14 Mar 2002 03:47:41 -0000 1.44 |
234 |
|
+++ continuations.c 21 Apr 2002 11:37:12 -0000 |
235 |
|
@@ -51,6 +51,10 @@ |
236 |
|
#include "libguile/ports.h" |
237 |
|
#include "libguile/dynwind.h" |
238 |
|
#include "libguile/values.h" |
239 |
|
+#include "libguile/eval.h" |
240 |
|
+#include "libguile/fluids.h" |
241 |
|
+#include "libguile/pairs.h" |
242 |
|
+ |
243 |
|
|
244 |
|
#ifdef DEBUG_EXTENSIONS |
245 |
|
#include "libguile/debug.h" |
246 |
|
@@ -72,6 +76,7 @@ |
247 |
|
scm_t_contregs *continuation = SCM_CONTREGS (obj); |
248 |
|
|
249 |
|
scm_gc_mark (continuation->throw_value); |
250 |
|
+ scm_gc_mark (continuation->barrier); |
251 |
|
scm_mark_locations (continuation->stack, continuation->num_stack_items); |
252 |
|
#ifdef __ia64__ |
253 |
|
if (continuation->backing_store) |
254 |
|
@@ -127,6 +132,8 @@ |
255 |
|
extern int setcontext (ucontext_t *); |
256 |
|
#endif /* __ia64__ */ |
257 |
|
|
258 |
|
+static SCM barrier; /* fluid */ |
259 |
|
+ |
260 |
|
/* this may return more than once: the first time with the escape |
261 |
|
procedure, then subsequently with the value to be passed to the |
262 |
|
continuation. */ |
263 |
|
@@ -154,6 +161,7 @@ |
264 |
|
continuation->throw_value = SCM_EOL; |
265 |
|
continuation->base = src = rootcont->base; |
266 |
|
continuation->seq = rootcont->seq; |
267 |
|
+ continuation->barrier = scm_fluid_ref (barrier); |
268 |
|
#ifdef DEBUG_EXTENSIONS |
269 |
|
continuation->dframe = scm_last_debug_frame; |
270 |
|
#endif |
271 |
|
@@ -278,21 +286,27 @@ |
272 |
|
copy_stack_and_call (continuation, val, dst); |
273 |
|
} |
274 |
|
|
275 |
|
- |
276 |
|
static SCM |
277 |
|
continuation_apply (SCM cont, SCM args) |
278 |
|
#define FUNC_NAME "continuation_apply" |
279 |
|
{ |
280 |
|
scm_t_contregs *continuation = SCM_CONTREGS (cont); |
281 |
|
- scm_t_contregs *rootcont = SCM_CONTREGS (scm_rootcont); |
282 |
|
+ /* scm_t_contregs *rootcont = SCM_CONTREGS (scm_rootcont); */ |
283 |
|
|
284 |
|
+ if (continuation->barrier != scm_fluid_ref (barrier)) |
285 |
|
+ { |
286 |
|
+ SCM_MISC_ERROR ("attempt to break continuation barrier", SCM_EOL); |
287 |
|
+ } |
288 |
|
+#if 0 |
289 |
|
if (continuation->seq != rootcont->seq |
290 |
|
/* this base comparison isn't needed */ |
291 |
|
|| continuation->base != rootcont->base) |
292 |
|
{ |
293 |
|
SCM_MISC_ERROR ("continuation from wrong top level: ~S", |
294 |
|
scm_list_1 (cont)); |
295 |
|
+ |
296 |
|
} |
297 |
|
+#endif |
298 |
|
|
299 |
|
scm_dowinds (continuation->dynenv, |
300 |
|
scm_ilength (scm_dynwinds) |
301 |
|
@@ -303,9 +317,93 @@ |
302 |
|
} |
303 |
|
#undef FUNC_NAME |
304 |
|
|
305 |
|
+/* Continuation barriers: these prevent the use of continuations that |
306 |
|
+ were captured on the other side of the boundary. See the |
307 |
|
+ dynamic-root discussion in the workbook. */ |
308 |
|
+ |
309 |
|
+typedef struct |
310 |
|
+{ |
311 |
|
+ scm_t_catch_handler handler; |
312 |
|
+ void *handler_data; |
313 |
|
+ int caught; |
314 |
|
+} c_c_data; |
315 |
|
+ |
316 |
|
+static SCM |
317 |
|
+c_c_handler (void *v_data, SCM throw_tag, SCM throw_args) |
318 |
|
+{ |
319 |
|
+ c_c_data *data = (c_c_data *) v_data; |
320 |
|
+ |
321 |
|
+ scm_fluid_set_x (barrier, SCM_CDR (scm_fluid_ref (barrier))); |
322 |
|
+ data->caught = 1; |
323 |
|
+ return data->handler (data->handler_data, throw_tag, throw_args); |
324 |
|
+} |
325 |
|
+ |
326 |
|
+/* not tail recursive -- probably not important. */ |
327 |
|
+SCM |
328 |
|
+scm_c_c_continuation_barrier (scm_t_catch_body body, void *body_data, |
329 |
|
+ scm_t_catch_handler handler, |
330 |
|
+ void *handler_data) |
331 |
|
+{ |
332 |
|
+ c_c_data data; |
333 |
|
+ SCM result; |
334 |
|
+ |
335 |
|
+ data.handler = handler; |
336 |
|
+ data.handler_data = handler_data; |
337 |
|
+ data.caught = 0; |
338 |
|
+ scm_fluid_set_x (barrier, scm_cons (SCM_BOOL_F, scm_fluid_ref (barrier))); |
339 |
|
+ result = scm_internal_catch (SCM_BOOL_T, body, body_data, c_c_handler, |
340 |
|
+ &data); |
341 |
|
+ if (!data.caught) |
342 |
|
+ scm_fluid_set_x (barrier, SCM_CDR (scm_fluid_ref (barrier))); |
343 |
|
+ return result; |
344 |
|
+} |
345 |
|
+ |
346 |
|
+static SCM |
347 |
|
+do_body (void *v_body) |
348 |
|
+{ |
349 |
|
+ SCM body = *(SCM *) v_body; |
350 |
|
+ |
351 |
|
+ return scm_call_0 (body); |
352 |
|
+} |
353 |
|
+ |
354 |
|
+SCM |
355 |
|
+scm_c_continuation_barrier (SCM body, |
356 |
|
+ scm_t_catch_handler handler, |
357 |
|
+ void *handler_data) |
358 |
|
+{ |
359 |
|
+ return scm_c_c_continuation_barrier (do_body, body, handler, handler_data); |
360 |
|
+} |
361 |
|
+ |
362 |
|
+static SCM |
363 |
|
+do_handler (void *v_handler, SCM tag, SCM throw_args) |
364 |
|
+{ |
365 |
|
+ SCM handler = *(SCM *) v_handler; |
366 |
|
+ |
367 |
|
+ return scm_apply_1 (handler, tag, throw_args); |
368 |
|
+} |
369 |
|
+ |
370 |
|
+SCM_DEFINE (scm_with_continuation_barrier, "with-continuation-barrier", |
371 |
|
+ 2, 0, 0, |
372 |
|
+ (SCM body, SCM handler), |
373 |
|
+ "") |
374 |
|
+#define FUNC_NAME s_scm_with_continuation_barrier |
375 |
|
+{ |
376 |
|
+ SCM_VALIDATE_THUNK (1, body); |
377 |
|
+ SCM_VALIDATE_THUNK (2, handler); |
378 |
|
+ return scm_c_c_continuation_barrier (do_body, &body, |
379 |
|
+ do_handler, &handler); |
380 |
|
+} |
381 |
|
+#undef FUNC_NAME |
382 |
|
+ |
383 |
|
+/* must be called once per thread. */ |
384 |
|
+void |
385 |
|
+scm_init_continuation_barrier (void) |
386 |
|
+{ |
387 |
|
+ scm_fluid_set_x (barrier, scm_cons (SCM_BOOL_F, SCM_EOL)); |
388 |
|
+} |
389 |
|
|
390 |
|
void |
391 |
|
-scm_init_continuations () |
392 |
|
+scm_init_continuations (void) |
393 |
|
{ |
394 |
|
scm_tc16_continuation = scm_make_smob_type ("continuation", 0); |
395 |
|
scm_set_smob_mark (scm_tc16_continuation, continuation_mark); |
396 |
|
@@ -313,6 +411,16 @@ |
397 |
|
scm_set_smob_print (scm_tc16_continuation, continuation_print); |
398 |
|
scm_set_smob_apply (scm_tc16_continuation, continuation_apply, 0, 0, 1); |
399 |
|
#include "libguile/continuations.x" |
400 |
|
+} |
401 |
|
+ |
402 |
|
+/* this is separate because it needs other modules to be initialised, |
403 |
|
+ which in turn require the initialisation above. */ |
404 |
|
+void |
405 |
|
+scm_init_continuations_II (void) |
406 |
|
+{ |
407 |
|
+ barrier = scm_make_fluid (); |
408 |
|
+ scm_init_continuation_barrier (); |
409 |
|
+ scm_gc_protect_object (barrier); |
410 |
|
} |
411 |
|
|
412 |
|
/* |
413 |
|
Index: continuations.h |
414 |
|
=================================================================== |
415 |
|
RCS file: /cvsroot/guile/guile/guile-core/libguile/continuations.h,v |
416 |
|
retrieving revision 1.26 |
417 |
|
diff -u -r1.26 continuations.h |
418 |
|
--- continuations.h 2 Nov 2001 00:08:41 -0000 1.26 |
419 |
|
+++ continuations.h 21 Apr 2002 11:37:12 -0000 |
420 |
|
@@ -47,6 +47,7 @@ |
421 |
|
|
422 |
|
|
423 |
|
#include "libguile/__scm.h" |
424 |
|
+#include "libguile/throw.h" |
425 |
|
|
426 |
|
#ifdef __ia64__ |
427 |
|
#include <sys/ucontext.h> |
428 |
|
@@ -77,6 +78,7 @@ |
429 |
|
SCM_STACKITEM *base; /* base of the live stack, before it was saved. */ |
430 |
|
size_t num_stack_items; /* size of the saved stack. */ |
431 |
|
unsigned long seq; /* dynamic root identifier. */ |
432 |
|
+ SCM barrier; |
433 |
|
|
434 |
|
#ifdef DEBUG_EXTENSIONS |
435 |
|
/* the most recently created debug frame on the live stack, before |
436 |
|
@@ -103,7 +105,16 @@ |
437 |
|
|
438 |
|
|
439 |
|
SCM_API SCM scm_make_continuation (int *first); |
440 |
|
+SCM_API SCM scm_c_c_continuation_barrier (scm_t_catch_body body, |
441 |
|
+ void *body_data, |
442 |
|
+ scm_t_catch_handler handler, |
443 |
|
+ void *handler_data); |
444 |
|
+SCM_API SCM scm_c_continuation_barrier (SCM body, scm_t_catch_handler handler, |
445 |
|
+ void *handler_data); |
446 |
|
+SCM_API SCM scm_with_continuation_barrier (SCM body, SCM handler); |
447 |
|
+SCM_API void scm_init_continuation_barrier (void); |
448 |
|
SCM_API void scm_init_continuations (void); |
449 |
|
+SCM_API void scm_init_continuations_II (void); |
450 |
|
|
451 |
|
#endif /* SCM_CONTINUATIONS_H */ |
452 |
|
|
453 |
|
Index: coop-threads.c |
454 |
|
=================================================================== |
455 |
|
RCS file: /cvsroot/guile/guile/guile-core/libguile/coop-threads.c,v |
456 |
|
retrieving revision 1.35 |
457 |
|
diff -u -r1.35 coop-threads.c |
458 |
|
--- coop-threads.c 1 Mar 2002 00:19:20 -0000 1.35 |
459 |
|
+++ coop-threads.c 21 Apr 2002 11:37:12 -0000 |
460 |
|
@@ -44,6 +44,7 @@ |
461 |
|
|
462 |
|
#include "libguile/validate.h" |
463 |
|
#include "libguile/coop-threads.h" |
464 |
|
+#include "libguile/continuations.h" |
465 |
|
#include "libguile/root.h" |
466 |
|
|
467 |
|
/* A counter of the current number of threads */ |
468 |
|
@@ -183,6 +184,7 @@ |
469 |
|
{ |
470 |
|
/* First save the new root continuation */ |
471 |
|
data->rootcont = scm_root->rootcont; |
472 |
|
+ scm_init_continuation_barrier (); |
473 |
|
return scm_call_0 (data->body); |
474 |
|
} |
475 |
|
|
476 |
|
@@ -299,6 +301,7 @@ |
477 |
|
{ |
478 |
|
/* First save the new root continuation */ |
479 |
|
data->u.rootcont = scm_root->rootcont; |
480 |
|
+ scm_init_continuation_barrier (); |
481 |
|
return (data->body) (data->body_data); |
482 |
|
} |
483 |
|
|
484 |
|
Index: init.c |
485 |
|
=================================================================== |
486 |
|
RCS file: /cvsroot/guile/guile/guile-core/libguile/init.c,v |
487 |
|
retrieving revision 1.134 |
488 |
|
diff -u -r1.134 init.c |
489 |
|
--- init.c 20 Apr 2002 20:57:09 -0000 1.134 |
490 |
|
+++ init.c 21 Apr 2002 11:37:14 -0000 |
491 |
|
@@ -162,6 +162,7 @@ |
492 |
|
SCM_DFRAME (scm_rootcont) = scm_last_debug_frame = 0; |
493 |
|
#endif |
494 |
|
SCM_BASE (scm_rootcont) = base; |
495 |
|
+ SCM_CONTREGS (scm_rootcont)->barrier = SCM_BOOL_F; |
496 |
|
} |
497 |
|
|
498 |
|
static void |
499 |
|
@@ -483,6 +484,7 @@ |
500 |
|
scm_init_eq (); |
501 |
|
scm_init_error (); |
502 |
|
scm_init_fluids (); |
503 |
|
+ scm_init_continuations_II (); /* Requires fluids. */ |
504 |
|
scm_init_backtrace (); /* Requires fluids */ |
505 |
|
scm_init_fports (); |
506 |
|
scm_init_strports (); |
507 |
|
Index: root.c |
508 |
|
=================================================================== |
509 |
|
RCS file: /cvsroot/guile/guile/guile-core/libguile/root.c,v |
510 |
|
retrieving revision 1.61 |
511 |
|
diff -u -r1.61 root.c |
512 |
|
--- root.c 20 Apr 2002 20:57:09 -0000 1.61 |
513 |
|
+++ root.c 21 Apr 2002 11:37:15 -0000 |
514 |
|
@@ -249,6 +249,7 @@ |
515 |
|
contregs->base = stack_start; |
516 |
|
contregs->seq = ++n_dynamic_roots; |
517 |
|
contregs->throw_value = SCM_BOOL_F; |
518 |
|
+ contregs->barrier = SCM_BOOL_F; |
519 |
|
#ifdef DEBUG_EXTENSIONS |
520 |
|
contregs->dframe = 0; |
521 |
|
#endif |