* use an applicable SMOB to represent continuations, instead of a

custom tc7 type.  This will make it easier to support R5RS
	multiple value continuations, without the use of a Scheme-level
	wrapper.

	* continuations.c (scm_tc16_continuation, continuation_mark,
	continuation_free, continuation_print, continuation_apply):
	new SMOB support.
	(scm_make_continuation): new procedure, replaces scm_make_cont
	with a different interface.
	(copy_stack_and_call, scm_dynthrow, scm_init_continuations): rewritten.
	(CHEAP_CONTINUATIONS): removed non-working code completely.
	(scm_call_continuation): removed.
	* continuations.h (struct scm_contregs): add num_stack_items and
	stack fields.  previously stack was stored following this struct:
	use a tail array instead.
	(SCM_CONTINUATIONP): new macro.
	(SCM_CONTINUATION_LENGTH, SCM_SET_CONTINUATION_LENGTH):
	rewritten.
	(SCM_SET_CONTREGS): removed.
	* tags.h: removed scm_tc7_contin (was tag 61).
	* debug.c, gc.c, hash.c, print.c, procprop.c, procs.c:
	removed scm_tc7_contin support.
	* eval.c: use scm_make_continuation instead of scm_make_cont.
	don't set jump buffers here.  remove scm_tc7_contin support.
	* init.c, root.c: create SMOB continuation for rootcont instead
	of scm_tc7_contin.  call scm_init_continuations before
	scm_init_root.
	* root.c: remove support for static jmpbuf.  It's not used by
	default and I broke it.  create SMOB continuation for rootcont.
	* stacks.c: use SCM_CONTINUATIONP.

libguile/ChangeLog

@@ -1,3 +1,37 @@
+2000-11-25  Gary Houston  <ghouston@arglist.com>
+
+	* use an applicable SMOB to represent continuations, instead of a
+	custom tc7 type.  This will make it easier to support R5RS
+	multiple value continuations, without the use of a Scheme-level
+	wrapper.
+
+	* continuations.c (scm_tc16_continuation, continuation_mark,
+	continuation_free, continuation_print, continuation_apply):
+	new SMOB support.
+	(scm_make_continuation): new procedure, replaces scm_make_cont
+	with a different interface.
+	(copy_stack_and_call, scm_dynthrow, scm_init_continuations): rewritten.
+	(CHEAP_CONTINUATIONS): removed non-working code completely.
+	(scm_call_continuation): removed.
+	* continuations.h (struct scm_contregs): add num_stack_items and
+	stack fields.  previously stack was stored following this struct:
+	use a tail array instead.
+	(SCM_CONTINUATIONP): new macro.
+	(SCM_CONTINUATION_LENGTH, SCM_SET_CONTINUATION_LENGTH):
+	rewritten.
+	(SCM_SET_CONTREGS): removed.
+	* tags.h: removed scm_tc7_contin (was tag 61).
+	* debug.c, gc.c, hash.c, print.c, procprop.c, procs.c:
+	removed scm_tc7_contin support.
+	* eval.c: use scm_make_continuation instead of scm_make_cont.
+	don't set jump buffers here.  remove scm_tc7_contin support.
+	* init.c, root.c: create SMOB continuation for rootcont instead
+	of scm_tc7_contin.  call scm_init_continuations before 
+	scm_init_root.
+	* root.c: remove support for static jmpbuf.  It's not used by
+	default and I broke it.  create SMOB continuation for rootcont.
+	* stacks.c: use SCM_CONTINUATIONP.
+
 2000-11-24  Matthias Koeppe  <mkoeppe@mail.math.uni-magdeburg.de>
 
         * goops.c (filter_cpl, remove_duplicate_slots), goops.h

libguile/continuations.c

@@ -48,10 +48,13 @@
 #include "libguile/_scm.h"
 #include "libguile/root.h"
 #include "libguile/stackchk.h"
+#include "libguile/smob.h"
+#include "libguile/ports.h"
+#include "libguile/dynwind.h"
+
 #ifdef DEBUG_EXTENSIONS
 #include "libguile/debug.h"
 #endif
-#include "libguile/dynwind.h"
 
 #include "libguile/continuations.h"
 
@@ -60,52 +63,92 @@
 /* {Continuations}
  */
 
-static char s_cont[] = "continuation";
+scm_bits_t scm_tc16_continuation;
 
-static void scm_dynthrow (SCM, SCM);
+static SCM continuation_mark (SCM obj)
-
-
-#ifndef CHEAP_CONTINUATIONS
-
-
-SCM 
-scm_make_cont (SCM *answer)
 {
-  long j;
+  scm_contregs *continuation = SCM_CONTREGS (obj);
-  SCM cont;
-  SCM_STACKITEM * src;
-  SCM_STACKITEM * dst;
 
-  SCM_NEWCELL (cont);
+  scm_gc_mark (continuation->throw_value);
-  *answer = cont;
+  scm_mark_locations (continuation->stack, continuation->num_stack_items);
-  SCM_ENTER_A_SECTION;
+  return continuation->dynenv;
-  SCM_FLUSH_REGISTER_WINDOWS;
-  j = scm_stack_size (SCM_BASE (scm_rootcont));
-  SCM_SET_CONTREGS (cont,
-		    scm_must_malloc (sizeof (scm_contregs)
-				     + j * sizeof (SCM_STACKITEM),
-				     s_cont));
-  SCM_DYNENV (cont) = scm_dynwinds;
-  SCM_THROW_VALUE (cont) = SCM_EOL;
-  src = SCM_BASE (cont) = SCM_BASE (scm_rootcont);
-  SCM_SEQ (cont) = SCM_SEQ (scm_rootcont);
-  SCM_SET_CONTINUATION_LENGTH (cont, j);
-  SCM_EXIT_A_SECTION;
-#ifndef SCM_STACK_GROWS_UP
-  src -= SCM_CONTINUATION_LENGTH (cont);
-#endif /* ndef SCM_STACK_GROWS_UP */
-  dst = (SCM_STACKITEM *) ((char *) SCM_CONTREGS (cont) + sizeof (scm_contregs));
-
-  /* memcpy should be safe:  src and dst will never overlap */
-  memcpy (dst, src, sizeof (SCM_STACKITEM) * SCM_CONTINUATION_LENGTH (cont));
-
-#ifdef DEBUG_EXTENSIONS
-  SCM_DFRAME (cont) = scm_last_debug_frame;
-#endif
-
-  return cont;
 }
 
+static scm_sizet continuation_free (SCM obj)
+{
+  scm_contregs *continuation = SCM_CONTREGS (obj);
+  /* stack array size is 1 if num_stack_items is 0 (rootcont).  */
+  scm_sizet extra_items = (continuation->num_stack_items > 0)
+    ? (continuation->num_stack_items - 1)
+    : 0;
+  scm_sizet bytes_free = sizeof (scm_contregs)
+    + extra_items * sizeof (SCM_STACKITEM);
+  
+  scm_must_free (continuation);
+  return bytes_free;
+}
+
+static int continuation_print (SCM obj, SCM port, scm_print_state *state)
+{
+  scm_contregs *continuation = SCM_CONTREGS (obj);
+
+  scm_puts ("#<continuation ", port);
+  scm_intprint (continuation->num_stack_items, 10, port);
+  scm_puts (" @ ", port);
+  scm_intprint (SCM_CELL_WORD_1 (obj), 16, port);
+  scm_putc ('>', port);
+  return 1;
+}
+
+/* this may return more than once: the first time with the escape
+   procedure, then subsequently with the value to be passed to the
+   continuation.  */
+#define FUNC_NAME "scm_make_continuation"
+SCM 
+scm_make_continuation (int *first)
+{
+  SCM cont;
+  scm_contregs *continuation;
+  scm_contregs *rootcont = SCM_CONTREGS (scm_rootcont);
+  long stack_size;
+  SCM_STACKITEM * src;
+
+  SCM_ENTER_A_SECTION;
+  SCM_FLUSH_REGISTER_WINDOWS;
+  stack_size = scm_stack_size (rootcont->base);
+  continuation = scm_must_malloc (sizeof (scm_contregs)
+				  + (stack_size - 1) * sizeof (SCM_STACKITEM),
+				  FUNC_NAME);
+  continuation->num_stack_items = stack_size;
+  continuation->dynenv = scm_dynwinds;
+  continuation->throw_value = SCM_EOL;
+  continuation->base = src = rootcont->base;
+  continuation->seq = rootcont->seq;
+#ifdef DEBUG_EXTENSIONS
+  continuation->dframe = scm_last_debug_frame;
+#endif
+  SCM_NEWSMOB (cont, scm_tc16_continuation, continuation);
+  SCM_EXIT_A_SECTION;
+
+#ifndef SCM_STACK_GROWS_UP
+  src -= stack_size;
+#endif
+  memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size);
+
+  if (setjmp (continuation->jmpbuf))
+    {
+      *first = 0;
+      return continuation->throw_value;
+    }
+  else
+    {
+      *first = 1;
+      return cont;
+    }
+}
+#undef FUNC_NAME
+
+static void scm_dynthrow (SCM, SCM);
 
 /* Grow the stack by a fixed amount to provide space to copy in the
  * continuation.  Possibly this function has to be called several times
@@ -131,18 +174,18 @@ grow_stack (SCM cont, SCM val)
  * own frame are overwritten.  Thus, memcpy can be used for best performance.
  */
 static void
-copy_stack_and_call (SCM cont, SCM val, 
+copy_stack_and_call (scm_contregs *continuation, SCM val, 
-		     SCM_STACKITEM * src, SCM_STACKITEM * dst)
+		     SCM_STACKITEM * dst)
 {
-  /* memcpy should be safe:  src and dst will never overlap */
+  memcpy (dst, continuation->stack,
-  memcpy (dst, src, sizeof (SCM_STACKITEM) * SCM_CONTINUATION_LENGTH (cont));
+	  sizeof (SCM_STACKITEM) * continuation->num_stack_items);
 
 #ifdef DEBUG_EXTENSIONS
-  scm_last_debug_frame = SCM_DFRAME (cont);
+  scm_last_debug_frame = continuation->dframe;
 #endif
 
-  SCM_THROW_VALUE (cont) = val;
+  continuation->throw_value = val;
-  longjmp (SCM_JMPBUF (cont), 1);
+  longjmp (continuation->jmpbuf, 1);
 }
 
 
@@ -153,94 +196,60 @@ copy_stack_and_call (SCM cont, SCM val,
 static void 
 scm_dynthrow (SCM cont, SCM val)
 {
-  SCM_STACKITEM * src;
+  scm_contregs *continuation = SCM_CONTREGS (cont);
   SCM_STACKITEM * dst = SCM_BASE (scm_rootcont);
   SCM_STACKITEM stack_top_element;
 
 #ifdef SCM_STACK_GROWS_UP
-  if (SCM_PTR_GE (dst + SCM_CONTINUATION_LENGTH (cont), & stack_top_element))
+  if (SCM_PTR_GE (dst + continuation->num_stack_items, &stack_top_element))
     grow_stack (cont, val);
 #else
-  dst -= SCM_CONTINUATION_LENGTH (cont);
+  dst -= continuation->num_stack_items;
-  if (SCM_PTR_LE (dst, & stack_top_element))
+  if (SCM_PTR_LE (dst, &stack_top_element))
     grow_stack (cont, val);
 #endif /* def SCM_STACK_GROWS_UP */
+
   SCM_FLUSH_REGISTER_WINDOWS;
-  src = (SCM_STACKITEM *) ((char *) SCM_CONTREGS (cont) + sizeof (scm_contregs));
+  copy_stack_and_call (continuation, val, dst);
-  copy_stack_and_call (cont, val, src, dst);
 }
 
-
+#define FUNC_NAME "continuation_apply"
-#else /* ifndef CHEAP_CONTINUATIONS */
+static SCM continuation_apply (SCM cont, SCM args)
-
-/* Dirk:FIXME:: It seems that nobody has ever tried to use this code, since it
- * contains syntactic errors and thus would not have compiled anyway.
- */
-
-
-SCM 
-scm_make_cont (SCM *answer)
 {
-  SCM cont;
+  /* FIXME: support R5RS multiple value continuations.  */
+  scm_contregs *continuation = SCM_CONTREGS (cont);
+  scm_contregs *rootcont = SCM_CONTREGS (scm_rootcont);
 
-  SCM_NEWCELL (cont);
+  SCM_ASSERT (scm_ilength (args) == 1, args, SCM_ARGn, FUNC_NAME);
-  *answer = cont;
+  if (continuation->seq != rootcont->seq
-  SCM_ENTER_A_SECTION;
+      /* this base comparison isn't needed */
-  SCM_SET_CONTREGS (cont, scm_must_malloc (sizeof (scm_contregs), s_cont));
+      || continuation->base != rootcont->base)
-  SCM_DYNENV (cont) = scm_dynwinds;
+    {
-  SCM_THROW_VALUE = SCM_EOL;
+      scm_wta (cont, "continuation from wrong top level", FUNC_NAME);
-  SCM_BASE (cont) = SCM_BASE (rootcont);
+    }
-  SCM_SEQ (cont) = SCM_SEQ (rootcont);
-  SCM_SETCAR (cont, scm_tc7_contin);
-  SCM_EXIT_A_SECTION;
   
-#ifdef DEBUG_EXTENSIONS
+  scm_dowinds (continuation->dynenv,
-  SCM_DFRAME (cont) = scm_last_debug_frame;
+	       scm_ilength (scm_dynwinds) - continuation->dynenv);
-#endif
   
-  return cont;
+  scm_dynthrow (cont, SCM_CAR (args));
-}
-
-
-static void
-scm_dynthrow (SCM cont, SCM val)
-{
-#ifdef DEBUG_EXTENSIONS
-  scm_last_debug_frame = SCM_DFRAME (cont);
-#endif
-  SCM_THROW_VALUE (cont) = val;
-  longjmp (SCM_JMPBUF (cont), 1);
-}
-
-
-#endif
-
-
-SCM
-scm_call_continuation (SCM cont, SCM val)
-{
-  if ((SCM_SEQ (cont) != SCM_SEQ (scm_rootcont))
-      || (SCM_BASE (cont) != SCM_BASE (scm_rootcont)))  
-    /* base compare not needed */
-    scm_wta (cont, "continuation from wrong top level", s_cont);
-  
-  scm_dowinds (SCM_DYNENV (cont),
-	       scm_ilength (scm_dynwinds) - scm_ilength (SCM_DYNENV (cont)));
-  
-  scm_dynthrow (cont, val);
   return SCM_UNSPECIFIED; /* not reached */
 }
-
+#undef FUNC_NAME
 
 void
 scm_init_continuations ()
 {
+  scm_tc16_continuation = scm_make_smob_type ("continuation", 0);
+  scm_set_smob_mark (scm_tc16_continuation, continuation_mark);
+  scm_set_smob_free (scm_tc16_continuation, continuation_free);
+  scm_set_smob_print (scm_tc16_continuation, continuation_print);
+  scm_set_smob_apply (scm_tc16_continuation, continuation_apply, 0, 0, 1);
+  
 #ifndef SCM_MAGIC_SNARFER
 #include "libguile/continuations.x"
 #endif
 }
 
-
 /*
   Local Variables:
   c-file-style: "gnu"

libguile/continuations.h

@@ -47,25 +47,41 @@
 
 
 
+/* a continuation SCM is a non-immediate pointing to a heap cell with:
+   word 0: bits 0-15: unused.
+           bits 16-31: smob type tag: scm_tc16_continuation.
+   word 1: malloc block containing an scm_contregs structure with a
+           tail array of SCM_STACKITEM.  the size of the array is stored
+	   in the num_stack_items field of the structure.
+*/
+
+extern scm_bits_t scm_tc16_continuation;
+
 typedef struct 
 {
   SCM throw_value;
   jmp_buf jmpbuf;
   SCM dynenv;
-  SCM_STACKITEM *base;
+  SCM_STACKITEM *base;      /* base of the live stack, before it was saved.  */
-  unsigned long seq;
+  scm_sizet num_stack_items; /* size of the saved stack.  */
+  unsigned long seq;         /* dynamic root identifier.  */
 
 #ifdef DEBUG_EXTENSIONS
+  /* the most recently created debug frame on the live stack, before
+     it was saved.  */
   struct scm_debug_frame *dframe;
 #endif
+  SCM_STACKITEM stack[1];    /* copied stack of size num_stack_items.  */ 
 } scm_contregs;
 
+#define SCM_CONTINUATIONP(x)\
+   (SCM_NIMP (x) && (SCM_TYP16 (x) == scm_tc16_continuation))
 
 #define SCM_CONTREGS(x)		((scm_contregs *) SCM_CELL_WORD_1 (x))
-#define SCM_SET_CONTREGS(x, r)	(SCM_SET_CELL_WORD_1 ((x), (scm_bits_t) (r))) 
-#define SCM_CONTINUATION_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
-#define SCM_SET_CONTINUATION_LENGTH(x, l) (SCM_SET_CELL_WORD_0 ((x), ((l) << 8) + scm_tc7_contin))
 
+#define SCM_CONTINUATION_LENGTH(x) (SCM_CONTREGS (x)->num_stack_items)
+#define SCM_SET_CONTINUATION_LENGTH(x,n)\
+   (SCM_CONTREGS (x)->num_stack_items = (n))
 #define SCM_JMPBUF(x)		((SCM_CONTREGS (x))->jmpbuf)
 #define SCM_DYNENV(x)		((SCM_CONTREGS (x))->dynenv)
 #define SCM_THROW_VALUE(x)	((SCM_CONTREGS (x))->throw_value)
@@ -75,8 +91,7 @@ typedef struct
 
 
 
-extern SCM scm_make_cont (SCM * answer);
+extern SCM scm_make_continuation (int *first);
-extern SCM scm_call_continuation (SCM cont, SCM val);
 extern void scm_init_continuations (void);
 
 

libguile/debug.c

@@ -431,7 +431,6 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0,
 							   SCM_EOL,
 							   SCM_ENV (proc))));
     }
-  case scm_tc7_contin:
   case scm_tcs_subrs:
 #ifdef CCLO
   case scm_tc7_cclo:
@@ -455,7 +454,6 @@ SCM_DEFINE (scm_procedure_environment, "procedure-environment", 1, 0, 0,
   switch (SCM_TYP7 (proc)) {
   case scm_tcs_closures:
     return SCM_ENV (proc);
-  case scm_tc7_contin:
   case scm_tcs_subrs:
 #ifdef CCLO
   case scm_tc7_cclo:

libguile/eval.c

@@ -1621,8 +1621,9 @@ do { \
  	  }\
 	else\
 	  {\
-	    scm_make_cont (&tmp);\
+            int first;\
-	    if (!setjmp (SCM_JMPBUF (tmp)))\
+	    tmp = scm_make_continuation (&first);\
+	    if (first)\
 	      scm_ithrow (scm_sym_apply_frame, scm_cons2 (tmp, tail, SCM_EOL), 0);\
 	  }\
       }\
@@ -1875,10 +1876,14 @@ start:
 	  t.arg1 = scm_make_debugobj (&debug);
 	else
 	  {
-	    scm_make_cont (&t.arg1);
+	    int first;
-	    if (setjmp (SCM_JMPBUF (t.arg1)))
+	    SCM val = scm_make_continuation (&first);
+	    
+	    if (first)
+	      t.arg1 = val;
+	    else
 	      {
-		x = SCM_THROW_VALUE (t.arg1);
+		x = val;
 		if (SCM_IMP (x))
 		  {
 		    RETURN (x);
@@ -2218,12 +2223,14 @@ dispatch:
 	  goto evapply;
 
 	case (SCM_ISYMNUM (SCM_IM_CONT)):
-	  scm_make_cont (&t.arg1);
-	  if (setjmp (SCM_JMPBUF (t.arg1)))
 	  {
-	      SCM val;
+	    int first;
-	      val = SCM_THROW_VALUE (t.arg1);
+	    SCM val = scm_make_continuation (&first);
-	      RETURN (val)
+
+	    if (first)
+	      t.arg1 = val;
+	    else
+	      RETURN (val);
 	  }
 	  proc = SCM_CDR (x);
 	  proc = evalcar (proc, env);
@@ -2681,7 +2688,6 @@ evapply:
 	    else
 	      goto badfun;
 	  }
-      case scm_tc7_contin:
       case scm_tc7_subr_1:
       case scm_tc7_subr_2:
       case scm_tc7_subr_2o:
@@ -2815,8 +2821,6 @@ evapply:
 	  env = EXTEND_ENV (SCM_CAR (x), scm_cons (t.arg1, SCM_EOL), SCM_ENV (proc));
 #endif
 	  goto cdrxbegin;
-	case scm_tc7_contin:
-	  scm_call_continuation (proc, t.arg1);
 	case scm_tcs_cons_gloc:
 	  if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
 	    {
@@ -2970,7 +2974,6 @@ evapply:
 	case scm_tc7_subr_1o:
 	case scm_tc7_subr_1:
 	case scm_tc7_subr_3:
-	case scm_tc7_contin:
 	  goto wrongnumargs;
 	default:
 	  goto badfun;
@@ -3171,7 +3174,6 @@ evapply:
       case scm_tc7_subr_0:
       case scm_tc7_cxr:
       case scm_tc7_subr_1:
-      case scm_tc7_contin:
 	goto wrongnumargs;
       default:
 	goto badfun;
@@ -3187,10 +3189,14 @@ exit:
 	  t.arg1 = scm_make_debugobj (&debug);
 	else
 	  {
-	    scm_make_cont (&t.arg1);
+	    int first;
-	    if (setjmp (SCM_JMPBUF (t.arg1)))
+	    SCM val = scm_make_continuation (&first);
+	    
+	    if (first)
+	      t.arg1 = val;
+	    else
 	      {
-		proc = SCM_THROW_VALUE (t.arg1);
+		proc = val;
 		goto ret;
 	      }
 	  }
@@ -3342,8 +3348,10 @@ SCM_APPLY (SCM proc, SCM arg1, SCM args)
 	tmp = scm_make_debugobj (&debug);
       else
 	{
-	  scm_make_cont (&tmp);
+	  int first;
-	  if (setjmp (SCM_JMPBUF (tmp)))
+
+	  tmp = scm_make_continuation (&first);
+	  if (!first)
 	    goto entap;
 	}
       scm_ithrow (scm_sym_enter_frame, scm_cons (tmp, SCM_EOL), 0);
@@ -3492,9 +3500,6 @@ tail:
 	RETURN (scm_smob_apply_2 (proc, arg1, SCM_CAR (args)))
       else
 	RETURN (scm_smob_apply_3 (proc, arg1, SCM_CAR (args), SCM_CDR (args)));
-    case scm_tc7_contin:
-      SCM_ASRTGO (SCM_NULLP (args), wrongnumargs);
-      scm_call_continuation (proc, arg1);
 #ifdef CCLO
     case scm_tc7_cclo:
 #ifdef DEVAL
@@ -3565,10 +3570,14 @@ exit:
 	  arg1 = scm_make_debugobj (&debug);
 	else
 	  {
-	    scm_make_cont (&arg1);
+	    int first;
-	    if (setjmp (SCM_JMPBUF (arg1)))
+	    SCM val = scm_make_continuation (&first);
+
+	    if (first)
+	      arg1 = val;
+	    else
 	      {
-		proc = SCM_THROW_VALUE (arg1);
+		proc = val;
 		goto ret;
 	      }
 	  }

libguile/gc.c

@@ -1221,15 +1221,6 @@ gc_mark_nimp:
       ptr = SCM_VELTS (ptr)[0];
       goto gc_mark_loop;
 #endif
-    case scm_tc7_contin:
-      if (SCM_VELTS (ptr))
-	scm_mark_locations (SCM_VELTS_AS_STACKITEMS (ptr),
-			    (scm_sizet)
-			    (SCM_CONTINUATION_LENGTH (ptr) +
-			     (sizeof (SCM_STACKITEM) + -1 +
-			      sizeof (scm_contregs)) /
-			     sizeof (SCM_STACKITEM)));
-      break;
 #ifdef HAVE_ARRAYS
     case scm_tc7_bvect:
     case scm_tc7_byvect:
@@ -1654,11 +1645,6 @@ scm_gc_sweep ()
 	      m += SCM_SYMBOL_LENGTH (scmptr) + 1;
 	      scm_must_free (SCM_SYMBOL_CHARS (scmptr));
 	      break;
-	    case scm_tc7_contin:
-	      m += SCM_CONTINUATION_LENGTH (scmptr) * sizeof (SCM_STACKITEM)
-		   + sizeof (scm_contregs);
-	      scm_must_free (SCM_CONTREGS (scmptr));
-	      break;
 	    case scm_tcs_subrs:
               /* the various "subrs" (primitives) are never freed */
 	      continue;

libguile/hash.c

@@ -150,7 +150,6 @@ scm_hasher(SCM obj, unsigned long n, scm_sizet d)
     case scm_tc7_port:
       return ((SCM_RDNG & SCM_CELL_WORD_0 (obj)) ? 260 : 261) % n;
     case scm_tcs_closures: 
-    case scm_tc7_contin: 
     case scm_tcs_subrs:
       return 262 % n;
     }

libguile/init.c

@@ -183,11 +183,13 @@ start_stack (void *base)
 
   /* Create an object to hold the root continuation.
    */
-  SCM_NEWCELL (scm_rootcont);
+  {
-  SCM_SET_CONTREGS (scm_rootcont, scm_must_malloc (sizeof (scm_contregs),
+    scm_contregs *contregs = scm_must_malloc (sizeof (scm_contregs),
-						   "continuation"));
+					      "continuation");
-  SCM_SET_CELL_TYPE (scm_rootcont, scm_tc7_contin);
+    contregs->num_stack_items = 0;
-  SCM_SEQ (scm_rootcont) = 0;
+    contregs->seq = 0;
+    SCM_NEWSMOB (scm_rootcont, scm_tc16_continuation, contregs);
+  }
   /* The root continuation is further initialized by restart_stack. */
 
   /* Create the look-aside stack for variables that are shared between
@@ -488,6 +490,7 @@ scm_init_guile_1 (SCM_STACKITEM *base)
   scm_weaks_prehistory ();	/* Must come after scm_init_storage */
   scm_init_subr_table ();
   scm_environments_prehistory (); /* create the root environment */
+  scm_init_continuations ();
   scm_init_root ();
 #ifdef USE_THREADS
   scm_init_threads (base);
@@ -501,7 +504,6 @@ scm_init_guile_1 (SCM_STACKITEM *base)
   scm_init_async ();
   scm_init_boolean ();
   scm_init_chars ();
-  scm_init_continuations ();
 #ifdef GUILE_DEBUG_MALLOC
   scm_init_debug_malloc ();
 #endif

libguile/print.c

@@ -673,13 +673,6 @@ taloop:
 	  }
 	  scm_putc ('>', port);
 	  break;
-	case scm_tc7_contin:
-	  scm_puts ("#<continuation ", port);
-	  scm_intprint (SCM_CONTINUATION_LENGTH (exp), 10, port);
-	  scm_puts (" @ ", port);
-	  scm_intprint ((long) SCM_CONTREGS (exp), 16, port);
-	  scm_putc ('>', port);
-	  break;
 	case scm_tc7_port:
 	  {
 	    register long i = SCM_PTOBNUM (exp);

libguile/procprop.c

@@ -80,7 +80,6 @@ scm_i_procedure_arity (SCM proc)
       o = 1;
     case scm_tc7_subr_1:
     case scm_tc7_cxr:
-    case scm_tc7_contin:
       a += 1;
       break;
     case scm_tc7_subr_2:

libguile/procs.c

@@ -196,7 +196,6 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
 	if (!SCM_I_OPERATORP (obj))
 	  break;
       case scm_tcs_closures:
-      case scm_tc7_contin:
       case scm_tcs_subrs:
 #ifdef CCLO
       case scm_tc7_cclo:
@@ -278,8 +277,7 @@ SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0,
 #define FUNC_NAME s_scm_procedure_documentation
 {
   SCM code;
-  SCM_ASSERT (SCM_EQ_P (scm_procedure_p (proc), SCM_BOOL_T)
+  SCM_ASSERT (SCM_EQ_P (scm_procedure_p (proc), SCM_BOOL_T) && SCM_NIMP (proc),
-	      && SCM_NIMP (proc) && SCM_TYP7 (proc) != scm_tc7_contin,
 	      proc, SCM_ARG1, FUNC_NAME);
   switch (SCM_TYP7 (proc))
     {

libguile/root.c

@@ -58,12 +58,6 @@
 #include "libguile/root.h"
 
 
-/* Define this if you want to try out the stack allocation of cwdr's
-   jumpbuf.  It works for me but I'm still worried that the dynwinds
-   might be able to make a mess. */
-
-#undef USE_STACKJMPBUF
-
 SCM scm_sys_protects[SCM_NUM_PROTECTS];
 
 long scm_tc16_root;
@@ -248,9 +242,6 @@ scm_internal_cwdr (scm_catch_body_t body, void *body_data,
 		   scm_catch_handler_t handler, void *handler_data,
 		   SCM_STACKITEM *stack_start)
 {
-#ifdef USE_STACKJMPBUF
-  scm_contregs static_contregs;
-#endif
   int old_ints_disabled = scm_ints_disabled;
   SCM old_rootcont, old_winds;
   struct cwdr_handler_data my_handler_data;
@@ -259,22 +250,22 @@ scm_internal_cwdr (scm_catch_body_t body, void *body_data,
   /* Create a fresh root continuation.  */
   {
     SCM new_rootcont;
-    SCM_NEWCELL (new_rootcont);
+
     SCM_REDEFER_INTS;
-#ifdef USE_STACKJMPBUF
+    {
-    SCM_SET_CONTREGS (new_rootcont, &static_contregs);
+      scm_contregs *contregs = scm_must_malloc (sizeof (scm_contregs),
-#else
+						"inferior root continuation");
-    SCM_SET_CONTREGS (new_rootcont,
+
-		      scm_must_malloc (sizeof (scm_contregs),
+      contregs->num_stack_items = 0;
-				       "inferior root continuation"));
+      contregs->dynenv = SCM_EOL;
-#endif
+      contregs->base = stack_start;
-    SCM_SET_CELL_TYPE (new_rootcont, scm_tc7_contin);
+      contregs->seq = ++n_dynamic_roots;
-    SCM_DYNENV (new_rootcont) = SCM_EOL;
+      contregs->throw_value = SCM_BOOL_F;
-    SCM_BASE (new_rootcont) = stack_start;
-    SCM_SEQ (new_rootcont) = ++n_dynamic_roots;
 #ifdef DEBUG_EXTENSIONS
-    SCM_DFRAME (new_rootcont) = 0;
+      contregs->dframe = 0;
 #endif
+      SCM_NEWSMOB (new_rootcont, scm_tc16_continuation, contregs);
+    }
     old_rootcont = scm_rootcont;
     scm_rootcont = new_rootcont;
     SCM_REALLOW_INTS;
@@ -298,9 +289,6 @@ scm_internal_cwdr (scm_catch_body_t body, void *body_data,
 
   scm_dowinds (old_winds, - scm_ilength (old_winds));
   SCM_REDEFER_INTS;
-#ifdef USE_STACKCJMPBUF
-  SCM_SET_CONTREGS (scm_rootcont, NULL);
-#endif
 #ifdef DEBUG_EXTENSIONS
   scm_last_debug_frame = SCM_DFRAME (old_rootcont);
 #endif

libguile/stacks.c

@@ -433,7 +433,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
       SCM_ASSERT (SCM_NIMP (obj), obj, SCM_ARG1, FUNC_NAME);
       if (SCM_DEBUGOBJP (obj))
 	dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (obj);
-      else if (scm_tc7_contin == SCM_TYP7 (obj))
+      else if (SCM_CONTINUATIONP (obj))
 	{
 	  offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof (scm_contregs))
 		    - SCM_BASE (obj));
@@ -517,7 +517,7 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
       SCM_VALIDATE_NIM (1,stack);
       if (SCM_DEBUGOBJP (stack))
 	dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (stack);
-      else if (scm_tc7_contin == SCM_TYP7 (stack))
+      else if (SCM_CONTINUATIONP (stack))
 	{
 	  offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (stack) + sizeof (scm_contregs))
 		    - SCM_BASE (stack));
@@ -587,7 +587,7 @@ SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0,
   SCM_VALIDATE_NIM (1,obj);
   if (SCM_DEBUGOBJP (obj))
     dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (obj);
-  else if (scm_tc7_contin == SCM_TYP7 (obj))
+  else if (SCM_CONTINUATIONP (obj))
     {
       offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof (scm_contregs))
 		- SCM_BASE (obj));

libguile/tags.h

@@ -356,7 +356,7 @@ typedef long scm_bits_t;
 #define scm_tc7_ivect		79
 #endif
 
-#define scm_tc7_contin		61
+/* free         		61 */
 #define scm_tc7_cclo		63
 #define scm_tc7_rpsubr		69
 #define scm_tc7_subr_0		85