Re: Replacement for SCM_SETJMPBUF?

[Gary Houston]

> From: Rob Browning <address@hidden>
> Date: Fri, 14 Sep 2001 10:53:41 -0500
> 
> At Trow's request, I'm trying to port guppi to our guile beta, and it
> has some code (borrowed from scwm apparently), that calls
> SCM_SETJMPBUF.  Since that macro's been eliminated, is there a
> replacement?
> 
> If someone can explain a bit, I'll add the relevant verbage to NEWS.
> 
> I'm not yet completely sure what the code in question is doing, but in
> case it helps (in particular, in case there's a better way to handle
> this altogether) here's the relevant function:
> 
> static SCM
> scm_internal_cwdr_no_unwind (scm_catch_body_t body, void *body_data,
>                            scm_catch_handler_t handler, void *handler_data,
>                            SCM_STACKITEM * stack_start)

It's just a slightly modified version of scm_internal_cwdr from root.c
in guile-1.3.4 and earlier.  scm_internal_cwdr implements
call-with-dynamic-root.  The change that's been made is to avoid
unwinding/rewinding the caller's wind list around the callee
procedure.

So a quick fix would be to take a new cut-and-paste from guile 1.5 and
apply the change again (see below for some untested code).

If guppi and scwm both needed this ability then maybe it's a flaw in
Guile that it's not provided.

I doubt that SCM_SETJMPBUF itself is of any great interest to the wider
public.

static long guppi_seq = 100000;
SCM 
scm_internal_cwdr (scm_t_catch_body body, void *body_data,
                   scm_t_catch_handler handler, void *handler_data,
                   SCM_STACKITEM *stack_start)
{
  int old_ints_disabled = scm_ints_disabled;
  SCM old_rootcont;
  struct cwdr_handler_data my_handler_data;
  SCM answer;

  /* Create a fresh root continuation.  */
  {
    SCM new_rootcont;

    SCM_REDEFER_INTS;
    {
      scm_t_contregs *contregs = scm_must_malloc (sizeof (scm_t_contregs),
                                                "inferior root continuation");

      contregs->num_stack_items = 0;
      contregs->dynenv = SCM_EOL;
      contregs->base = stack_start;
      contregs->seq = ++guppi_seq;
      contregs->throw_value = SCM_BOOL_F;
#ifdef DEBUG_EXTENSIONS
      contregs->dframe = 0;
#endif
      SCM_NEWSMOB (new_rootcont, scm_tc16_continuation, contregs);
    }
    old_rootcont = scm_rootcont;
    scm_rootcont = new_rootcont;
    SCM_REALLOW_INTS;
  }

#ifdef DEBUG_EXTENSIONS
  SCM_DFRAME (old_rootcont) = scm_last_debug_frame;
  scm_last_debug_frame = 0;
#endif

  {
    my_handler_data.run_handler = 0;
    answer = scm_internal_catch (SCM_BOOL_T,
                                 body, body_data,
                                 cwdr_handler, &my_handler_data);
  }

  SCM_REDEFER_INTS;
#ifdef DEBUG_EXTENSIONS
  scm_last_debug_frame = SCM_DFRAME (old_rootcont);
#endif
  scm_rootcont = old_rootcont;
  SCM_REALLOW_INTS;
  scm_ints_disabled = old_ints_disabled;

  /* Now run the real handler iff the body did a throw. */
  if (my_handler_data.run_handler)
    return handler (handler_data, my_handler_data.tag, my_handler_data.args);
  else
    return answer;
}