/[guile]/guile/workbook/extension/dynamic-root.text
ViewVC logotype

Diff of /guile/workbook/extension/dynamic-root.text

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by ghouston, Wed Apr 10 22:16:43 2002 UTC revision 1.6 by ghouston, Sun Apr 21 11:45:14 2002 UTC
# Line 141  implemented by storing the current threa Line 141  implemented by storing the current threa
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
# Line 211  propose more fundamental changes to the Line 215  propose more fundamental changes to the
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

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26