guile/workbook/extension/dynamic-root.text

[Gary Houston]

This file expands (excessively, perhaps) on the call-with-dynamic-root
problem that has been mentioned on the mailing lists a few times.  I
hope somebody can review the conclusions some time in the next
few months.

Overview
========

This proposal is for the introduction of three new procedures to
replace the existing call-with-dynamic-root procedure and the
corresponding C interfaces.  The new procedures are supposed to be
more useful for programs embedding Guile and would also move the
concept of "dynamic roots" from the external API to become a thread
implementation detail.

The proposed new procedures are:

with-continuation-barrier, implemented by
scm_with_continuation_barrier in C. Takes 2 SCM arguments: a body
thunk and an exception handler procedure.  The body is executed inside
a "continuation barrier" that prevents calling continuations that were
created on the other side of the barrier, in either direction.
Uncaught throws inside the body are caught by the handler, in the
style of scm_internal_catch.

Two additional interfaces are created for use from C to give more
convenient access to the exception handler:

scm_c_c_continuation_barrier (scm_t_catch_body body, void *body_data,
                              scm_t_catch_handler handler,
                              void *handler_data)

SCM
scm_c_continuation_barrier (SCM body,
                            scm_t_catch_handler handler,
                            void *handler_data)


The new procedures would ideally exist in a module, perhaps shared
with other continuation or exception handling facilities.

Procedures proposed for deprecation:

scm_call_with_dynamic_root implements call-with-dynamic-root
scm_apply_with_dynamic_root (undocumented, unused by Guile).
scm_internal_cwdr (undocumented)

The Problem
===========

Certain applications embedding Guile (Scwm, Guppi) have found it
necessary to include hacked versions of scm_call_with_dynamic_root
and/or its related procedures.

They want to run user callbacks, but don't want the callback to be
able to longjmp (via exceptions or continuations) randomly in and out,
since the C code hasn't been written to dynamically wind/unwind local
state.  This is likely to be a common problem for users of Guile as an
extension language.

libguile/root.c:scm_call_with_dynamic_root seems to almost do this,
but it has the apparently undesirable behaviour of unwinding the
dynamic state when the protected procedure is called.  In addition
the implementation looks a bit heavy for use in every callback.

scm_call_with_dynamic_root was implemented to support threading, so
the needs of guile-core itself should be considered.  Other
considerations are how any new interface interacts with error handling
and reporting; whether a new interface is convenient to use from C;
whether a new interface should also be available to Scheme code.

Another thing to consider is whether the implementation of this feature
is always going to be tied to the dynamic-root concept, or whether
it could be implemented in some other way.

Finally, there is the consideration of whether all this is just more
trouble than it's worth: perhaps the applications that want this
feature should either a) protect their code properly against Scheme
flow-control b) forbid use of call/cc in callbacks c) forbid accessing
the top-level environment in callbacks.

Example
=======

We have some code that executes a procedure supplied by a user.
It's essential that the code before and after the user-proc is
executed in the right order: maybe it's C code that opens and
closes files or allocates/frees memory:

(define break-me (lambda (user-proc)
                   (display "executing user ...\n")
                   (user-proc)
                   (display "... done\n")))

Now the user types:

(define cont #f)
(break-me (lambda ()
            (call-with-current-continuation (lambda (c)
                                              (set! cont c)))))

giving:

"executing user ...
... done"

but then:

(cont #f) gives:

"... done"

i.e., the user has jumped back into the callback via a continuation.

Alternatively, the user can jump out of the callback:

(define cont #f)
(call-with-current-continuation (lambda (c) (set! cont c)))
(break-me (lambda ()
            (cont)))

Discussion
==========

Why bother providing this kind of facility?  Because otherwise most C
applications that link Guile will need to find some other way to
prevent the use of continuations across callbacks if they are to avoid
a source of bugs.  It makes sense to provide this in guile-core, where
the ability to modify the internals of the continuation implementation
is a significant advantage, as discussed further below.

There are two ways that longjmp may be invoked from a Scheme callback:
raising an exception or invoking a continuation.  Exceptions can be
caught using scm_internal_catch, but a primitive "continuation
barrier" is lacking. A reentry barrier can be easily created
using dynamic-wind, assuming that an error can be signalled within the
before- thunk:

(define with-reentry-barrier
  (lambda (thunk)
    (let ((entered #f))
      (dynamic-wind
          (lambda ()
            (if entered
                (error "Attempt to break reentry barrier")
                (set! entered #t)))
          thunk
          (lambda () #f)))))

The jump-back-in example above may now be fixed:

(define break-me (lambda (user-proc)
                   (display "executing user ...\n")
                   (with-reentry-barrier user-proc)
                   (display "... done\n")))

However the jump-out example is resistant to this technique.  In any
case the interaction of dynamic-wind and continuations and exceptions
is likely to cause strange and unstable behaviour:

guile> (define (break-me user-proc)
  (catch #t
         (lambda ()
           (display "executing user ...\n")
           (with-reentry-barrier user-proc)
           (display "... done\n"))
         (lambda args
           (display "outer catch!\n")
           (write args))))

guile> (define cont #f)
(break-me (lambda ()
            (call-with-current-continuation (lambda (c)
                                              (set! cont c)))))

guile> executing user ...
... done
guile> (cont #f)
Segmentation fault

The existing dynamic-root method avoids such difficulties by
preventing the execution of continuations that would cross the
continuation barrier, instead of trying to clean things up after the
continuation has been executed.

Hence, one approach is to use a method similar to dynamic-root, but
without using dynamic root.

Removing the interface for creating dynamic roots from the external
API would allow dynamic roots to be limited to their use in the thread
system: initially with exactly one dynamic root for each thread.  The
implementation could then be changed without affect on the external
API.

Proposed implementation
=======================

In the current system it's not possible to invoke a continuation that
was captured by a different thread.  It's not proposed to change this
convention.  A possible implementation technique would be to store the
current thread id in the continuation when it's captured and compare
with the current id when the continuation is invoked.

To implement the continuation barrier, for each thread we can have a
simple list representing the barrier (let's call it
with-continuation-barrier, w-c-b) dynamic state.  The head of the list
would be stored in a thread-local location.  Whenever the scope of a
w-c-b expression is entered, a new cons cell could be inserted at the
head of the list.  When the scope is exited, the cell would be removed
(this implies a need for an integrated exception handler, to catch
non-local exit.  Non-local exit or entry by continuation will not be
possible).  A pointer to the cell at the head of the list would be
stored in a continuation when it is captured.  When a continuation is
invoked, the stored cell pointer can be compared with the address of
the cell currently at the head of the list.

This w-c-b list comparison would also prevent cross-thread invokation,
so the comparison of thread-ids suggested above can actually be
dropped.

An example implementation to play with is attached below.

Convenience
===========

For ease of use, we would like to have a single facility to set up
both continuation and exception handlers.  An exception handler is
needed in any case in the implementation described above.  Such an
interface in C should take at least a) the callback to be protected b)
and exception handler and associated handler data to be passed to
scm_internal_catch.

How should the callback procedure be passed to the interface and
invoked?  Should it be like scm_internal_catch where it's passed as a
C procedure (scm_t_catch_body) which is applied to user data (void *)?
For a procedure designed to be used from C, this is the most
convenient, since constructing closures in C is difficult.  It also
gives symmetry with scm_internal_catch.

On the other hand, the body procedure is expected to be a Scheme
closure in most cases.  This suggests implementing two C procedures,
the first taking four arguments.  In the example implementation it's:

SCM
scm_c_c_continuation_barrier (scm_t_catch_body body, void *body_data,
                              scm_t_catch_handler handler,
                              void *handler_data)

The second procedure takes three arguments:

SCM
scm_c_continuation_barrier (SCM body,
                            scm_t_catch_handler handler,
                            void *handler_data)

Should the facility be provided at the Scheme level too, or just in C?
There's no obvious reason to restrict the use of callbacks to C, hence
there is a third variant that takes two SCM arguments:

SCM_DEFINE (scm_with_continuation_barrier, "with-continuation-barrier",
            2, 0, 0,
            (SCM body, SCM handler),
            "")
#define FUNC_NAME s_scm_with_continuation_barrier

The second and third variants are implemented by calling the first,
similar to the old scm_internal_cwdr and its wrappers.

The return value from all variants should be the result of calling
the body, unless an exception occurred in which case it's the result
of calling the handler.  So the return type is SCM, as for
scm_internal_catch.

Guile's current (version 1.6) usage of call-with-dynamic-root
=============================================================

There are three relevant functions exported from root.c:

scm_internal_cwdr is not documented.  It implements
scm_call_with_dynamic_root and scm_apply_with_dynamic_root and is
also called from coop-threads.c.

scm_call_with_dynamic_root implements call-with-dynamic-root and is
documented in the reference manual.  It is not used by Guile.

scm_apply_with_dynamic_root is not documented.  It is not used by
Guile.

The usage of scm_internal_cwdr during spawning of coop threads is for
two reasons: firstly to complete the initialisation of the new
dynamic-root, secondly to install the exception handler.  It would be
easy to reimplement these using some other method, particularly since
some of the dynamic-root initialisation will no longer be required if
these functions are removed.

Hence there should be no problem in deprecating all three exported
functions.  To remove them completely will require minor changes to
coop thread spawning, which will benefit by simplification of the
scm_root struct.

Module system
=============

New interfaces should probably be in a separate module, to allow later
modifications to the interface without breaking old code -- e.g., by
adding a new module with a new name, if versioning isn't available.
However to make this work in C too, the module needs to be a separate
dynamic library, which reduces the convenience of use.  Perhaps it
could be combined into a module with related non-R5RS continuation or
catch/throw facilities.

Unknowns
========

Does anything need to be done for error handling and reporting (e.g.,
stack trace?)  This may be a topic for a separate discussion.

References
==========

Thread on guile mailing list discussing dynamic roots, March 2000
    -- http://sources.redhat.com/ml/guile/2000-03/msg00461.html
Jim Blandy suggested looking at a few articles, but these appear to
propose more fundamental changes to the concept of call/cc.

Thread on guile-devel mailing list discussing the use of
call-with-dynamic-root by applications, Sept 2001.
    -- http://mail.gnu.org/pipermail/guile-devel/2001-September/003684.html

Example implementation
======================

This is a diff against CVS HEAD 2002-04-21.  Note: it disables the
checking of the existing continuation->seq in continuation_apply
to simplify testing: in practice the seq test would remain until
call-with-dynamic-root was removed (since it's independent, it
can be deprecated as normal).

Index: continuations.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/continuations.c,v
retrieving revision 1.44
diff -u -r1.44 continuations.c
--- continuations.c     14 Mar 2002 03:47:41 -0000      1.44
+++ continuations.c     21 Apr 2002 11:37:12 -0000
@@ -51,6 +51,10 @@
 #include "libguile/ports.h"
 #include "libguile/dynwind.h"
 #include "libguile/values.h"
+#include "libguile/eval.h"
+#include "libguile/fluids.h"
+#include "libguile/pairs.h"
+
 
 #ifdef DEBUG_EXTENSIONS
 #include "libguile/debug.h"
@@ -72,6 +76,7 @@
   scm_t_contregs *continuation = SCM_CONTREGS (obj);
 
   scm_gc_mark (continuation->throw_value);
+  scm_gc_mark (continuation->barrier);
   scm_mark_locations (continuation->stack, continuation->num_stack_items);
 #ifdef __ia64__
   if (continuation->backing_store)
@@ -127,6 +132,8 @@
 extern int setcontext (ucontext_t *);
 #endif /* __ia64__ */
 
+static SCM barrier;  /* fluid */
+
 /* this may return more than once: the first time with the escape
    procedure, then subsequently with the value to be passed to the
    continuation.  */
@@ -154,6 +161,7 @@
   continuation->throw_value = SCM_EOL;
   continuation->base = src = rootcont->base;
   continuation->seq = rootcont->seq;
+  continuation->barrier = scm_fluid_ref (barrier);
 #ifdef DEBUG_EXTENSIONS
   continuation->dframe = scm_last_debug_frame;
 #endif
@@ -278,21 +286,27 @@
   copy_stack_and_call (continuation, val, dst);
 }
 
-
 static SCM
 continuation_apply (SCM cont, SCM args)
 #define FUNC_NAME "continuation_apply"
 {
   scm_t_contregs *continuation = SCM_CONTREGS (cont);
-  scm_t_contregs *rootcont = SCM_CONTREGS (scm_rootcont);
+  /* scm_t_contregs *rootcont = SCM_CONTREGS (scm_rootcont); */
 
+  if (continuation->barrier != scm_fluid_ref (barrier))
+    {
+      SCM_MISC_ERROR ("attempt to break continuation barrier", SCM_EOL);
+    }
+#if 0
   if (continuation->seq != rootcont->seq
       /* this base comparison isn't needed */
       || continuation->base != rootcont->base)
     {
       SCM_MISC_ERROR ("continuation from wrong top level: ~S", 
                      scm_list_1 (cont));
+    
     }
+#endif
   
   scm_dowinds (continuation->dynenv,
               scm_ilength (scm_dynwinds)
@@ -303,9 +317,93 @@
 }
 #undef FUNC_NAME
 
+/* Continuation barriers: these prevent the use of continuations that
+   were captured on the other side of the boundary.  See the
+   dynamic-root discussion in the workbook.  */
+
+typedef struct
+{
+  scm_t_catch_handler handler;
+  void *handler_data;
+  int caught;
+} c_c_data;
+
+static SCM
+c_c_handler (void *v_data, SCM throw_tag, SCM throw_args)
+{
+  c_c_data *data = (c_c_data *) v_data;
+
+  scm_fluid_set_x (barrier, SCM_CDR (scm_fluid_ref (barrier)));
+  data->caught = 1;
+  return data->handler (data->handler_data, throw_tag, throw_args);
+}
+
+/* not tail recursive -- probably not important.  */
+SCM
+scm_c_c_continuation_barrier (scm_t_catch_body body, void *body_data,
+                             scm_t_catch_handler handler,
+                             void *handler_data)
+{
+  c_c_data data;
+  SCM result;
+
+  data.handler = handler;
+  data.handler_data = handler_data;
+  data.caught = 0;
+  scm_fluid_set_x (barrier, scm_cons (SCM_BOOL_F, scm_fluid_ref (barrier)));
+  result = scm_internal_catch (SCM_BOOL_T, body, body_data, c_c_handler,
+                              &data);
+  if (!data.caught)
+    scm_fluid_set_x (barrier, SCM_CDR (scm_fluid_ref (barrier)));
+  return result;
+}
+
+static SCM
+do_body (void *v_body)
+{
+  SCM body = *(SCM *) v_body;
+
+  return scm_call_0 (body);
+}
+
+SCM
+scm_c_continuation_barrier (SCM body,
+                           scm_t_catch_handler handler,
+                           void *handler_data)
+{
+  return scm_c_c_continuation_barrier (do_body, body, handler, handler_data);
+}
+
+static SCM
+do_handler (void *v_handler, SCM tag, SCM throw_args)
+{
+  SCM handler = *(SCM *) v_handler;
+
+  return scm_apply_1 (handler, tag, throw_args);
+}
+
+SCM_DEFINE (scm_with_continuation_barrier, "with-continuation-barrier",
+           2, 0, 0,
+           (SCM body, SCM handler),
+           "")
+#define FUNC_NAME s_scm_with_continuation_barrier
+{
+  SCM_VALIDATE_THUNK (1, body);
+  SCM_VALIDATE_THUNK (2, handler);
+  return scm_c_c_continuation_barrier (do_body, &body,
+                                      do_handler, &handler);
+}
+#undef FUNC_NAME
+
+/* must be called once per thread.  */
+void
+scm_init_continuation_barrier (void)
+{
+  scm_fluid_set_x (barrier, scm_cons (SCM_BOOL_F, SCM_EOL));  
+}
 
 void
-scm_init_continuations ()
+scm_init_continuations (void)
 {
   scm_tc16_continuation = scm_make_smob_type ("continuation", 0);
   scm_set_smob_mark (scm_tc16_continuation, continuation_mark);
@@ -313,6 +411,16 @@
   scm_set_smob_print (scm_tc16_continuation, continuation_print);
   scm_set_smob_apply (scm_tc16_continuation, continuation_apply, 0, 0, 1);
 #include "libguile/continuations.x"
+}
+
+/* this is separate because it needs other modules to be initialised,
+   which in turn require the initialisation above.  */
+void
+scm_init_continuations_II (void)
+{
+  barrier = scm_make_fluid ();
+  scm_init_continuation_barrier ();
+  scm_gc_protect_object (barrier);
 }
 
 /*
Index: continuations.h
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/continuations.h,v
retrieving revision 1.26
diff -u -r1.26 continuations.h
--- continuations.h     2 Nov 2001 00:08:41 -0000       1.26
+++ continuations.h     21 Apr 2002 11:37:12 -0000
@@ -47,6 +47,7 @@
 
 
 #include "libguile/__scm.h"
+#include "libguile/throw.h"
 
 #ifdef __ia64__
 #include <sys/ucontext.h>
@@ -77,6 +78,7 @@
   SCM_STACKITEM *base;      /* base of the live stack, before it was saved.  */
   size_t num_stack_items;   /* size of the saved stack.  */
   unsigned long seq;        /* dynamic root identifier.  */
+  SCM barrier;
 
 #ifdef DEBUG_EXTENSIONS
   /* the most recently created debug frame on the live stack, before
@@ -103,7 +105,16 @@
 
 
 SCM_API SCM scm_make_continuation (int *first);
+SCM_API SCM scm_c_c_continuation_barrier (scm_t_catch_body body,
+                                         void *body_data,
+                                         scm_t_catch_handler handler,
+                                         void *handler_data);
+SCM_API SCM scm_c_continuation_barrier (SCM body, scm_t_catch_handler handler,
+                                       void *handler_data);
+SCM_API SCM scm_with_continuation_barrier (SCM body, SCM handler);
+SCM_API void scm_init_continuation_barrier (void);
 SCM_API void scm_init_continuations (void);
+SCM_API void scm_init_continuations_II (void);
 
 #endif  /* SCM_CONTINUATIONS_H */
 
Index: coop-threads.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/coop-threads.c,v
retrieving revision 1.35
diff -u -r1.35 coop-threads.c
--- coop-threads.c      1 Mar 2002 00:19:20 -0000       1.35
+++ coop-threads.c      21 Apr 2002 11:37:12 -0000
@@ -44,6 +44,7 @@
 
 #include "libguile/validate.h"
 #include "libguile/coop-threads.h"
+#include "libguile/continuations.h"
 #include "libguile/root.h"
 
 /* A counter of the current number of threads */
@@ -183,6 +184,7 @@
 {
   /* First save the new root continuation */
   data->rootcont = scm_root->rootcont;
+  scm_init_continuation_barrier ();
   return scm_call_0 (data->body);
 }
 
@@ -299,6 +301,7 @@
 {
   /* First save the new root continuation */
   data->u.rootcont = scm_root->rootcont;
+  scm_init_continuation_barrier ();
   return (data->body) (data->body_data);
 }
 
Index: init.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/init.c,v
retrieving revision 1.134
diff -u -r1.134 init.c
--- init.c      20 Apr 2002 20:57:09 -0000      1.134
+++ init.c      21 Apr 2002 11:37:14 -0000
@@ -162,6 +162,7 @@
   SCM_DFRAME (scm_rootcont) = scm_last_debug_frame = 0;
 #endif
   SCM_BASE (scm_rootcont) = base;
+  SCM_CONTREGS (scm_rootcont)->barrier = SCM_BOOL_F;
 }
 
 static void
@@ -483,6 +484,7 @@
   scm_init_eq ();
   scm_init_error ();
   scm_init_fluids ();
+  scm_init_continuations_II ();  /* Requires fluids.  */
   scm_init_backtrace ();       /* Requires fluids */
   scm_init_fports ();
   scm_init_strports ();
Index: root.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/root.c,v
retrieving revision 1.61
diff -u -r1.61 root.c
--- root.c      20 Apr 2002 20:57:09 -0000      1.61
+++ root.c      21 Apr 2002 11:37:15 -0000
@@ -249,6 +249,7 @@
       contregs->base = stack_start;
       contregs->seq = ++n_dynamic_roots;
       contregs->throw_value = SCM_BOOL_F;
+      contregs->barrier = SCM_BOOL_F;
 #ifdef DEBUG_EXTENSIONS
       contregs->dframe = 0;
 #endif