the dynamic stack is really a stack now, instead of a list

* libguile/dynstack.h: * libguile/dynstack.c: New files, implementing the dynamic stack as a true stack instead of a linked list. This lowers the cost of dynwinds: frames, winders, prompts, with-fluids, and dynamic-wind. For the most part, we allocate these items directly on the stack. * libguile/dynwinds.h: * libguile/dynwinds.c: Adapt all manipulators of the wind stack to use interfaces from dynstack.c. Remove heap-allocated winder and frame object types. (scm_dowinds, scm_i_dowinds): Remove these. The first was exported, but it was not a public interface. * libguile/continuations.c: * libguile/continuations.h (scm_t_contregs): Continuation objects reference scm_t_dynstack* values now. Adapt to the new interfaces. * libguile/control.c: * libguile/control.h: There is no longer a scm_tc7_prompt kind of object that can be allocated on the heap. Instead, the prompt flags, key, and registers are pushed on the dynwind stack. (The registers are still on the heap.) Also, since the vm_cont will reference the dynwinds, make the partial continuation stub take just one extra arg, instead of storing the intwinds separately in the object table. * libguile/fluids.c: * libguile/fluids.h: No more with-fluids objects; instead, the fluids go on the dynstack. The values still have to be on the heap, though. (scm_prepare_fluids, scm_swap_fluids): New internal functions, replacing scm_i_make_with_fluids and scm_i_swap_with_fluids. * libguile/print.c: Remove prompt and with-fluids printers. * libguile/tags.h: Revert prompt and with-fluids tc7 values to what they were before they were allocated. * libguile/vm-i-system.c (partial_cont_call): Just pop the vmcont, the intwinds will not be passed as a second arg. Rewind the dynamic stack from within the VM, so that any rewinder sees valid prompt entries. (call_cc, tail_call_cc): Adapt to pass the dynstack to scm_i_vm_capture_stack. (prompt, wind, unwind, wind_fluids, unwind_fluids): Adapt to the new interfaces. * libguile/vm.h (scm_i_capture_current_stack): Rename from scm_i_vm_capture_continuation. (scm_i_vm_capture_stack): Take a dynstack as an argument. * libguile/vm.c (vm_reinstate_partial_continuation): Don't wind here, as that could result in winders seeing invalid prompts. * libguile/eval.c: * libguile/root.c: * libguile/stacks.c: * libguile/threads.c: * libguile/threads.h: * libguile/throw.c: Adapt other users of dynwinds to use the dynstack.
author: Andy Wingo <wingo@pobox.com> 2012-03-03 17:01:16 +0100
committer: Andy Wingo <wingo@pobox.com> 2012-03-03 17:06:02 +0100
commit: 9ede013f68361df731cadc62844be11d1bfea7e5 (patch)
tree: 5f507a75e7aa6f932a44f1ddf98045137cd6913d
parent: 05b4d9106d301af055d675cd0ffdd3699642a0ee (diff)
22 files changed, 1079 insertions, 534 deletions
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index df3e9d0e4..6d2da6620 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -133,6 +133,7 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES =				\
 	debug.c					\
 	deprecated.c				\
 	deprecation.c				\
+	dynstack.c				\
 	dynwind.c				\
 	eq.c					\
 	error.c					\
@@ -529,6 +530,7 @@ modinclude_HEADERS =				\
 	deprecated.h				\
 	deprecation.h				\
 	dynl.h					\
+	dynstack.h				\
 	dynwind.h				\
 	eq.h					\
 	error.h					\
diff --git a/libguile/continuations.c b/libguile/continuations.c
index 058e21e88..fe7618f5e 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -24,6 +24,7 @@
 
 #include "libguile/_scm.h"
 
+#include <assert.h>
 #include <string.h>
 #include <stdio.h>
 
@@ -33,7 +34,7 @@
 #include "libguile/stackchk.h"
 #include "libguile/smob.h"
 #include "libguile/ports.h"
-#include "libguile/dynwind.h"
+#include "libguile/dynstack.h"
 #include "libguile/eval.h"
 #include "libguile/vm.h"
 #include "libguile/instructions.h"
@@ -52,7 +53,6 @@ static scm_t_bits tc16_continuation;
 #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_CONTINUATION_ROOT(x) ((SCM_CONTREGS (x))->root)   
 #define SCM_DFRAME(x)		 ((SCM_CONTREGS (x))->dframe)
 
@@ -211,7 +211,6 @@ scm_i_make_continuation (int *first, SCM vm, SCM vm_cont)
 				+ (stack_size - 1) * sizeof (SCM_STACKITEM),
 				"continuation");
   continuation->num_stack_items = stack_size;
-  continuation->dynenv = scm_i_dynwinds ();
   continuation->root = thread->continuation_root;
   src = thread->continuation_base;
 #if ! SCM_STACK_GROWS_UP
@@ -334,33 +333,25 @@ grow_stack (SCM cont)
  * own frame are overwritten.  Thus, memcpy can be used for best performance.
  */
 
-typedef struct {
-  scm_t_contregs *continuation;
-  SCM_STACKITEM *dst;
-} copy_stack_data;
-
-static void
-copy_stack (void *data)
-{
-  copy_stack_data *d = (copy_stack_data *)data;
-  memcpy (d->dst, d->continuation->stack,
-	  sizeof (SCM_STACKITEM) * d->continuation->num_stack_items);
-#ifdef __ia64__
-  SCM_I_CURRENT_THREAD->pending_rbs_continuation = d->continuation;
-#endif
-}
-
 static void
 copy_stack_and_call (scm_t_contregs *continuation,
 		     SCM_STACKITEM * dst)
 {
-  long delta;
-  copy_stack_data data;
+  scm_t_dynstack *dynstack;
+  scm_t_bits *joint;
+  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+
+  dynstack = SCM_VM_CONT_DATA (continuation->vm_cont)->dynstack;
+
+  joint = scm_dynstack_unwind_fork (&thread->dynstack, dynstack);
+
+  memcpy (dst, continuation->stack,
+	  sizeof (SCM_STACKITEM) * continuation->num_stack_items);
+#ifdef __ia64__
+  thread->pending_rbs_continuation = continuation;
+#endif
 
-  delta = scm_ilength (scm_i_dynwinds ()) - scm_ilength (continuation->dynenv);
-  data.continuation = continuation;
-  data.dst = dst;
-  scm_i_dowinds (continuation->dynenv, delta, copy_stack, &data);
+  scm_dynstack_wind (&thread->dynstack, joint);
 
   SCM_I_LONGJMP (continuation->jmpbuf, 1);
 }
diff --git a/libguile/continuations.h b/libguile/continuations.h
index e0a455632..29ea1c1a1 100644
--- a/libguile/continuations.h
+++ b/libguile/continuations.h
@@ -3,7 +3,7 @@
 #ifndef SCM_CONTINUATIONS_H
 #define SCM_CONTINUATIONS_H
 
-/* Copyright (C) 1995,1996,2000,2001, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001, 2006, 2008, 2009, 2010, 2012 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -45,7 +45,6 @@
 typedef struct 
 {
   scm_i_jmp_buf jmpbuf;
-  SCM dynenv;
 #ifdef __ia64__
   void *backing_store;
   unsigned long backing_store_size;
diff --git a/libguile/control.c b/libguile/control.c
index ff6bfd89a..613ffbe4c 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -30,18 +30,18 @@
 
 
 
+#define PROMPT_ESCAPE_P(p)                              \
+  (SCM_DYNSTACK_TAG_FLAGS (SCM_DYNSTACK_TAG (p))        \
+   & SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY)
 
-SCM
-scm_c_make_prompt (SCM k, SCM *fp, SCM *sp, scm_t_uint8 *abort_ip,
-                   scm_t_uint8 escape_only_p, scm_t_int64 vm_cookie,
-                   SCM winds)
-{
-  scm_t_bits tag;
-  struct scm_prompt_registers *regs;
+
 
-  tag = scm_tc7_prompt;
-  if (escape_only_p)
-    tag |= (SCM_F_PROMPT_ESCAPE<<8);
+
+scm_t_prompt_registers*
+scm_c_make_prompt_registers (SCM *fp, SCM *sp, scm_t_uint8 *abort_ip,
+                             scm_t_int64 vm_cookie)
+{
+  scm_t_prompt_registers *regs;
 
   regs = scm_gc_malloc_pointerless (sizeof (*regs), "prompt registers");
   regs->fp = fp;
@@ -49,11 +49,10 @@ scm_c_make_prompt (SCM k, SCM *fp, SCM *sp, scm_t_uint8 *abort_ip,
   regs->ip = abort_ip;
   regs->cookie = vm_cookie;
 
-  return scm_double_cell (tag, SCM_UNPACK (k), (scm_t_bits)regs, 
-                          SCM_UNPACK (winds));
+  return regs;
 }
 
-/* Only to be called if the SCM_PROMPT_SETJMP returns 1 */
+/* Only to be called if the SCM_I_SETJMP returns 1 */
 SCM
 scm_i_prompt_pop_abort_args_x (SCM vm)
 {
@@ -115,9 +114,9 @@ SCM_STATIC_OBJCODE (cont_objcode) = {
   OBJCODE_HEADER (8, 19),
   /* leave args on the stack */
   /* 0 */ scm_op_object_ref, 0, /* push scm_vm_cont object */
-  /* 2 */ scm_op_object_ref, 1, /* push internal winds */
-  /* 4 */ scm_op_partial_cont_call, /* and go! */
-  /* 5 */ scm_op_nop, scm_op_nop, scm_op_nop, /* pad to 8 bytes */
+  /* 2 */ scm_op_partial_cont_call, /* and go! */
+  /* 3 */ scm_op_nop,
+  /* 4 */ scm_op_nop, scm_op_nop, scm_op_nop, scm_op_nop, /* pad to 8 bytes */
   /* 8 */
 
   /* We could put some meta-info to say that this proc is a continuation. Not sure
@@ -125,7 +124,7 @@ SCM_STATIC_OBJCODE (cont_objcode) = {
   META_HEADER (19),
   /* 0 */ scm_op_make_eol, /* bindings */
   /* 1 */ scm_op_make_eol, /* sources */
-  /* 2 */ scm_op_make_int8, 0, scm_op_make_int8, 5, /* arity: from ip 0 to ip 7 */
+  /* 2 */ scm_op_make_int8, 0, scm_op_make_int8, 3, /* arity: from ip 0 to ip 3 */
   /* 6 */ scm_op_make_int8_0, /* the arity is 0 required args */
   /* 7 */ scm_op_make_int8_0, /* 0 optionals */
   /* 8 */ scm_op_make_true, /* and a rest arg */
@@ -138,45 +137,35 @@ SCM_STATIC_OBJCODE (cont_objcode) = {
 
 
 static SCM
-reify_partial_continuation (SCM vm, SCM prompt, SCM extwinds,
+reify_partial_continuation (SCM vm, scm_t_prompt_registers *regs,
+                            scm_t_dynstack *dynstack,
                             scm_t_int64 cookie)
 {
-  SCM vm_cont, dynwinds, intwinds = SCM_EOL, ret;
+  SCM vm_cont, ret;
   scm_t_uint32 flags;
 
-  /* No need to reify if the continuation is never referenced in the handler. */
-  if (SCM_PROMPT_ESCAPE_P (prompt))
-    return SCM_BOOL_F;
-
-  dynwinds = scm_i_dynwinds ();
-  while (!scm_is_eq (dynwinds, extwinds))
-    {
-      intwinds = scm_cons (scm_car (dynwinds), intwinds);
-      dynwinds = scm_cdr (dynwinds);
-    }
-
   flags = SCM_F_VM_CONT_PARTIAL;
-  if (cookie >= 0 && SCM_PROMPT_REGISTERS (prompt)->cookie == cookie)
+  if (cookie >= 0 && regs->cookie == cookie)
     flags |= SCM_F_VM_CONT_REWINDABLE;
 
   /* Since non-escape continuations should begin with a thunk application, the
      first bit of the stack should be a frame, with the saved fp equal to the fp
      that was current when the prompt was made. */
-  if ((SCM*)SCM_UNPACK (SCM_PROMPT_REGISTERS (prompt)->sp[1])
-      != SCM_PROMPT_REGISTERS (prompt)->fp)
+  if ((SCM*)SCM_UNPACK (regs->sp[1]) != regs->fp)
     abort ();
 
   /* Capture from the top of the thunk application frame up to the end. Set an
      MVRA only, as the post-abort code is in an MV context. */
-  vm_cont = scm_i_vm_capture_stack (SCM_PROMPT_REGISTERS (prompt)->sp + 4,
+  vm_cont = scm_i_vm_capture_stack (regs->sp + 4,
                                     SCM_VM_DATA (vm)->fp,
                                     SCM_VM_DATA (vm)->sp,
                                     NULL,
                                     SCM_VM_DATA (vm)->ip,
+                                    dynstack,
                                     flags);
 
   ret = scm_make_program (cont_objcode,
-                          scm_vector (scm_list_2 (vm_cont, intwinds)),
+                          scm_c_make_vector (1, vm_cont),
                           SCM_BOOL_F);
   SCM_SET_CELL_WORD_0 (ret,
                        SCM_CELL_WORD_0 (ret) | SCM_F_PROGRAM_IS_PARTIAL_CONTINUATION);
@@ -186,46 +175,42 @@ reify_partial_continuation (SCM vm, SCM prompt, SCM extwinds,
 void
 scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv, scm_t_int64 cookie)
 {
-  SCM cont, winds, prompt = SCM_BOOL_F;
-  long delta;
+  SCM cont;
+  scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
+  scm_t_bits *prompt;
+  scm_t_prompt_registers *regs;
+  scm_t_dynstack_prompt_flags flags;
   size_t i;
 
-  /* Search the wind list for an appropriate prompt.
-     "Waiter, please bring us the wind list." */
-  for (winds = scm_i_dynwinds (), delta = 0;
-       scm_is_pair (winds);
-       winds = SCM_CDR (winds), delta++)
-    {
-      SCM elt = SCM_CAR (winds);
-      if (SCM_PROMPT_P (elt) && scm_is_eq (SCM_PROMPT_TAG (elt), tag))
-        {
-          prompt = elt;
-          break;
-        }
-    }
-  
-  /* If we didn't find anything, raise an error. */
-  if (scm_is_false (prompt))
+  prompt = scm_dynstack_find_prompt (dynstack, tag, &regs, &flags);
+
+  if (!prompt)
     scm_misc_error ("abort", "Abort to unknown prompt", scm_list_1 (tag));
 
-  cont = reify_partial_continuation (vm, prompt, winds, cookie);
+  /* Only reify if the continuation referenced in the handler. */
+  if (flags & SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY)
+    cont = SCM_BOOL_F;
+  else
+    {
+      scm_t_dynstack *captured;
 
-  /* Unwind once more, beyond the prompt. */
-  winds = SCM_CDR (winds), delta++;
+      captured = scm_dynstack_capture (dynstack, SCM_DYNSTACK_NEXT (prompt));
+      cont = reify_partial_continuation (vm, regs, captured, cookie);
+    }
 
-  /* Unwind */
-  scm_dowinds (winds, delta);
+  /* Unwind.  */
+  scm_dynstack_unwind (dynstack, prompt);
 
   /* Unwinding may have changed the current thread's VM, so use the
      new one.  */
   vm = scm_the_vm ();
 
   /* Restore VM regs */
-  SCM_VM_DATA (vm)->fp = SCM_PROMPT_REGISTERS (prompt)->fp;
-  SCM_VM_DATA (vm)->sp = SCM_PROMPT_REGISTERS (prompt)->sp;
-  SCM_VM_DATA (vm)->ip = SCM_PROMPT_REGISTERS (prompt)->ip;
+  SCM_VM_DATA (vm)->fp = regs->fp;
+  SCM_VM_DATA (vm)->sp = regs->sp;
+  SCM_VM_DATA (vm)->ip = regs->ip;
 
-  /* Since we're jumping down, we should always have enough space */
+  /* Since we're jumping down, we should always have enough space.  */
   if (SCM_VM_DATA (vm)->sp + n + 1 >= SCM_VM_DATA (vm)->stack_limit)
     abort ();
 
@@ -236,7 +221,7 @@ scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv, scm_t_int64 cookie)
   *(++(SCM_VM_DATA (vm)->sp)) = scm_from_size_t (n+1); /* +1 for continuation */
 
   /* Jump! */
-  SCM_I_LONGJMP (SCM_PROMPT_REGISTERS (prompt)->regs, 1);
+  SCM_I_LONGJMP (regs->regs, 1);
 
   /* Shouldn't get here */
   abort ();
@@ -266,14 +251,6 @@ SCM_DEFINE (scm_at_abort, "@abort", 2, 0, 0, (SCM tag, SCM args),
 #undef FUNC_NAME
 
 void
-scm_i_prompt_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
-{
-  scm_puts_unlocked ("#<prompt ", port);
-  scm_intprint (SCM_UNPACK (exp), 16, port);
-  scm_putc_unlocked ('>', port);
-}
-
-void
 scm_init_control (void)
 {
 #include "libguile/control.x"
diff --git a/libguile/control.h b/libguile/control.h
index ebf255f72..a91285588 100644
--- a/libguile/control.h
+++ b/libguile/control.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2010, 2011  Free Software Foundation, Inc.
+/* Copyright (C) 2010, 2011, 2012  Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -20,32 +20,21 @@
 #define SCM_CONTROL_H
 
 
-#define SCM_F_PROMPT_ESCAPE 0x1
-
-#define SCM_PROMPT_P(x)		(SCM_HAS_TYP7 (x, scm_tc7_prompt))
-#define SCM_PROMPT_FLAGS(x)	(SCM_CELL_WORD ((x), 0) >> 8)
-#define SCM_PROMPT_ESCAPE_P(x)	(SCM_PROMPT_FLAGS (x) & SCM_F_PROMPT_ESCAPE)
-#define SCM_PROMPT_TAG(x)	(SCM_CELL_OBJECT ((x), 1))
-#define SCM_PROMPT_REGISTERS(x)	((struct scm_prompt_registers*)SCM_CELL_WORD ((x), 2))
-#define SCM_PROMPT_DYNWINDS(x)	(SCM_CELL_OBJECT ((x), 3))
-
-#define SCM_PROMPT_SETJMP(p)	(SCM_I_SETJMP (SCM_PROMPT_REGISTERS (p)->regs))
-
-struct scm_prompt_registers
+typedef struct
 {
   scm_t_uint8 *ip;
   SCM *sp;
   SCM *fp;
   scm_t_int64 cookie;
   scm_i_jmp_buf regs;  
-};
+} scm_t_prompt_registers;
+
 
+SCM_INTERNAL scm_t_prompt_registers*
+scm_c_make_prompt_registers (SCM *fp, SCM *sp,
+                             scm_t_uint8 *abort_ip,
+                             scm_t_int64 vm_cookie);
 
-SCM_INTERNAL SCM scm_c_make_prompt (SCM k, SCM *fp, SCM *sp,
-                                    scm_t_uint8 *abort_ip,
-                                    scm_t_uint8 escape_only_p,
-                                    scm_t_int64 vm_cookie,
-                                    SCM winds);
 SCM_INTERNAL SCM scm_i_prompt_pop_abort_args_x (SCM vm);
 
 SCM_INTERNAL void scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv,
@@ -53,7 +42,6 @@ SCM_INTERNAL void scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv,
 SCM_INTERNAL SCM scm_at_abort (SCM tag, SCM args) SCM_NORETURN;
 
 
-SCM_INTERNAL void scm_i_prompt_print (SCM exp, SCM port, scm_print_state *pstate);
 SCM_INTERNAL void scm_init_control (void);
 
 
diff --git a/libguile/dynstack.c b/libguile/dynstack.c
new file mode 100644
index 000000000..56e007c1f
--- /dev/null
+++ b/libguile/dynstack.c
@@ -0,0 +1,544 @@
+/* Copyright (C) 2012 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
+#include <assert.h>
+
+#include "libguile/_scm.h"
+#include "libguile/control.h"
+#include "libguile/eval.h"
+#include "libguile/fluids.h"
+#include "libguile/dynstack.h"
+
+
+
+
+#define PROMPT_WORDS 2
+#define PROMPT_KEY(top) (SCM_PACK ((top)[0]))
+#define PROMPT_REGS(top) ((scm_t_prompt_registers*) ((top)[1]))
+
+#define WINDER_WORDS 2
+#define WINDER_PROC(top) ((scm_t_guard) ((top)[0]))
+#define WINDER_DATA(top) ((void *) ((top)[1]))
+
+#define DYNWIND_WORDS 2
+#define DYNWIND_ENTER(top) (SCM_PACK ((top)[0]))
+#define DYNWIND_LEAVE(top) (SCM_PACK ((top)[1]))
+
+#define WITH_FLUIDS_FLUIDS(top) ((SCM*)((top) + 1))
+#define WITH_FLUIDS_VALUES(top) ((SCM*)((top)[0]))
+
+
+
+
+static void
+copy_scm_t_bits (scm_t_bits *dst, scm_t_bits *src, size_t n)
+{
+  size_t i;
+
+  for (i = 0; i < n; i++)
+    dst[i] = src[i];
+}
+
+static void
+copy_scm (SCM *dst, SCM *src, size_t n)
+{
+  size_t i;
+
+  for (i = 0; i < n; i++)
+    dst[i] = src[i];
+}
+
+static void
+clear_scm_t_bits (scm_t_bits *items, size_t n)
+{
+  size_t i;
+
+  for (i = 0; i < n; i++)
+    items[i] = 0;
+}
+
+/* Ensure space for N additional words.  */
+static void
+dynstack_ensure_space (scm_t_dynstack *dynstack, size_t n)
+{
+  size_t capacity = SCM_DYNSTACK_CAPACITY (dynstack);
+  size_t height = SCM_DYNSTACK_HEIGHT (dynstack);
+
+  n += SCM_DYNSTACK_HEADER_LEN;
+
+  if (capacity < height + n)
+    {
+      scm_t_bits *new_base;
+
+      while (capacity < height + n)
+        capacity = (capacity < 4) ? 8 : (capacity * 2);
+
+      new_base = scm_gc_malloc (capacity * sizeof(scm_t_bits), "dynstack");
+
+      copy_scm_t_bits (new_base, dynstack->base, height);
+      clear_scm_t_bits (dynstack->base, height);
+        
+      dynstack->base = new_base;
+      dynstack->top = new_base + height;
+      dynstack->limit = new_base + capacity;
+    }
+}
+
+static inline scm_t_bits *
+push_dynstack_entry_unchecked (scm_t_dynstack *dynstack,
+                               scm_t_dynstack_item_type type,
+                               scm_t_bits flags, size_t len)
+{
+  scm_t_bits *ret = dynstack->top;
+
+  SCM_DYNSTACK_SET_TAG (dynstack->top, SCM_MAKE_DYNSTACK_TAG (type, flags, len));
+  dynstack->top += SCM_DYNSTACK_HEADER_LEN + len;
+  SCM_DYNSTACK_SET_PREV_OFFSET (dynstack->top, SCM_DYNSTACK_HEADER_LEN + len);
+
+  return ret;
+}
+
+static inline scm_t_bits *
+push_dynstack_entry (scm_t_dynstack *dynstack,
+                     scm_t_dynstack_item_type type,
+                     scm_t_bits flags, size_t len)
+{
+  if (SCM_UNLIKELY (!SCM_DYNSTACK_HAS_SPACE (dynstack, len)))
+    dynstack_ensure_space (dynstack, len);
+  return push_dynstack_entry_unchecked (dynstack, type, flags, len);
+}
+  
+void
+scm_dynstack_push_frame (scm_t_dynstack *dynstack,
+                         scm_t_dynstack_frame_flags flags)
+{
+  push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_FRAME, flags, 0);
+}
+
+void
+scm_dynstack_push_rewinder (scm_t_dynstack *dynstack,
+                            scm_t_dynstack_winder_flags flags,
+                            scm_t_guard proc, void *data)
+{
+  scm_t_bits *words;
+
+  words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_REWINDER, flags, 2);
+  words[0] = (scm_t_bits) proc;
+  words[1] = (scm_t_bits) data;
+}
+
+void
+scm_dynstack_push_unwinder (scm_t_dynstack *dynstack,
+                            scm_t_dynstack_winder_flags flags,
+                            scm_t_guard proc, void *data)
+{
+  scm_t_bits *words;
+
+  words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_UNWINDER, flags, 2);
+  words[0] = (scm_t_bits) proc;
+  words[1] = (scm_t_bits) data;
+}
+
+/* The fluids are stored on the stack.  However, the values have to be
+   stored on the heap, so that all continuations that capture this
+   dynamic scope capture the same bindings.  */
+void
+scm_dynstack_push_fluids (scm_t_dynstack *dynstack, size_t n,
+                          SCM *fluids, SCM *values, SCM dynamic_state)
+{
+  scm_t_bits *words;
+  SCM *heap_values;
+
+  n = scm_prepare_fluids (n, fluids, values);
+  heap_values = scm_gc_malloc (n * sizeof (scm_t_bits), "with-fluids");
+  copy_scm (heap_values, values, n);
+
+  words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_WITH_FLUIDS,
+                               0, n + 1);
+  words[0] = (scm_t_bits) heap_values;
+  copy_scm (WITH_FLUIDS_FLUIDS (words), fluids, n);
+
+  /* Go ahead and swap them.  */
+  scm_swap_fluids (n, WITH_FLUIDS_FLUIDS (words), WITH_FLUIDS_VALUES (words),
+                   dynamic_state);
+}
+
+void
+scm_dynstack_push_prompt (scm_t_dynstack *dynstack,
+                          scm_t_dynstack_prompt_flags flags,
+                          SCM key, scm_t_prompt_registers *regs)
+{
+  scm_t_bits *words;
+
+  words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_PROMPT, flags, 2);
+  words[0] = SCM_UNPACK (key);
+  words[1] = (scm_t_bits) regs;
+}
+
+void
+scm_dynstack_push_dynwind (scm_t_dynstack *dynstack, SCM enter, SCM leave)
+{
+  scm_t_bits *words;
+
+  words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_DYNWIND, 0, 2);
+  words[0] = SCM_UNPACK (enter);
+  words[1] = SCM_UNPACK (leave);
+}
+
+static inline scm_t_bits
+dynstack_pop (scm_t_dynstack *dynstack, scm_t_bits **words)
+{
+  scm_t_bits *prev = SCM_DYNSTACK_PREV (dynstack->top);
+  scm_t_bits tag;
+
+  if (SCM_UNLIKELY (!prev))
+    abort ();
+
+  SCM_DYNSTACK_SET_PREV_OFFSET (dynstack->top, 0);
+  dynstack->top = prev;
+
+  tag = SCM_DYNSTACK_TAG (dynstack->top);
+  SCM_DYNSTACK_SET_TAG (dynstack->top, 0);
+  *words = dynstack->top;
+
+  return tag;
+}
+  
+void
+scm_dynstack_pop (scm_t_dynstack *dynstack)
+{
+  scm_t_bits tag, *words;
+  tag = dynstack_pop (dynstack, &words);
+  clear_scm_t_bits (words, SCM_DYNSTACK_TAG_LEN (tag));
+}
+  
+scm_t_dynstack *
+scm_dynstack_capture_all (scm_t_dynstack *dynstack)
+{
+  return scm_dynstack_capture (dynstack, SCM_DYNSTACK_FIRST (dynstack));
+}
+
+scm_t_dynstack *
+scm_dynstack_capture (scm_t_dynstack *dynstack, scm_t_bits *item)
+{
+  char *mem;
+  scm_t_dynstack *ret;
+  size_t len;
+
+  assert (item >= SCM_DYNSTACK_FIRST (dynstack));
+  assert (item <= dynstack->top);
+
+  len = dynstack->top - item + SCM_DYNSTACK_HEADER_LEN;
+  mem = scm_gc_malloc (sizeof (*ret) + len * sizeof(scm_t_bits), "dynstack");
+  ret = (scm_t_dynstack *) mem;
+  ret->base = (scm_t_bits *) (mem + sizeof (*ret));
+  ret->limit = ret->base + len;
+  ret->top = ret->base + len;
+
+  copy_scm_t_bits (ret->base, item - SCM_DYNSTACK_HEADER_LEN, len);
+  SCM_DYNSTACK_SET_PREV_OFFSET (SCM_DYNSTACK_FIRST (ret), 0);
+
+  return ret;
+}
+
+void
+scm_dynstack_wind_1 (scm_t_dynstack *dynstack, scm_t_bits *item)
+{
+  scm_t_bits tag = SCM_DYNSTACK_TAG (item);
+  scm_t_dynstack_item_type type = SCM_DYNSTACK_TAG_TYPE (tag);
+  scm_t_bits flags = SCM_DYNSTACK_TAG_FLAGS (tag);
+  size_t len = SCM_DYNSTACK_TAG_LEN (tag);
+  
+  switch (type)
+    {
+    case SCM_DYNSTACK_TYPE_FRAME:
+      if (!(flags & SCM_F_DYNSTACK_FRAME_REWINDABLE))
+        scm_misc_error ("scm_dynstack_wind_1",
+                        "cannot invoke continuation from this context",
+                        SCM_EOL);
+      break;
+
+    case SCM_DYNSTACK_TYPE_UNWINDER:
+      break;
+
+    case SCM_DYNSTACK_TYPE_REWINDER:
+      WINDER_PROC (item) (WINDER_DATA (item));
+      break;
+
+    case SCM_DYNSTACK_TYPE_WITH_FLUIDS:
+      scm_swap_fluids (len - 1,  WITH_FLUIDS_FLUIDS (item),
+                       WITH_FLUIDS_VALUES (item),
+                       SCM_I_CURRENT_THREAD->dynamic_state);
+      break;
+
+    case SCM_DYNSTACK_TYPE_PROMPT:
+      /* see vm_reinstate_partial_continuation */
+      break;
+
+    case SCM_DYNSTACK_TYPE_DYNWIND:
+      scm_call_0 (DYNWIND_ENTER (item));
+      break;
+
+    case SCM_DYNSTACK_TYPE_NONE:
+    default:
+      abort ();
+    }
+
+  {
+    scm_t_bits *words = push_dynstack_entry (dynstack, type, flags, len);
+
+    copy_scm_t_bits (words, item, len);
+  }
+}
+
+scm_t_bits
+scm_dynstack_unwind_1 (scm_t_dynstack *dynstack)
+{
+  scm_t_bits tag;
+  scm_t_bits *words;
+  scm_t_dynstack_item_type type;
+  size_t len;
+
+  tag = dynstack_pop (dynstack, &words);
+  
+  type = SCM_DYNSTACK_TAG_TYPE (tag);
+  len = SCM_DYNSTACK_TAG_LEN (tag);
+  
+  switch (type)
+    {
+    case SCM_DYNSTACK_TYPE_FRAME:
+      break;
+
+    case SCM_DYNSTACK_TYPE_UNWINDER:
+      WINDER_PROC (words) (WINDER_DATA (words));
+      clear_scm_t_bits (words, WINDER_WORDS);
+      break;
+
+    case SCM_DYNSTACK_TYPE_REWINDER:
+      clear_scm_t_bits (words, WINDER_WORDS);
+      break;
+
+    case SCM_DYNSTACK_TYPE_WITH_FLUIDS:
+      scm_swap_fluids (len - 1,  WITH_FLUIDS_FLUIDS (words),
+                       WITH_FLUIDS_VALUES (words),
+                       SCM_I_CURRENT_THREAD->dynamic_state);
+      clear_scm_t_bits (words, len);
+      break;
+
+    case SCM_DYNSTACK_TYPE_PROMPT:
+      /* we could invalidate the prompt */
+      clear_scm_t_bits (words, PROMPT_WORDS);
+      break;
+
+    case SCM_DYNSTACK_TYPE_DYNWIND:
+      {
+        SCM proc = DYNWIND_LEAVE (words);
+        clear_scm_t_bits (words, DYNWIND_WORDS);
+        scm_call_0 (proc);
+      }
+      break;
+
+    case SCM_DYNSTACK_TYPE_NONE:
+    default:
+      abort ();
+    }
+
+  return tag;
+}
+
+void
+scm_dynstack_wind (scm_t_dynstack *dynstack, scm_t_bits *item)
+{
+  for (; SCM_DYNSTACK_TAG (item); item = SCM_DYNSTACK_NEXT (item))
+    scm_dynstack_wind_1 (dynstack, item);
+}
+
+void
+scm_dynstack_unwind (scm_t_dynstack *dynstack, scm_t_bits *base)
+{
+  while (dynstack->top > base)
+    scm_dynstack_unwind_1 (dynstack);
+}
+
+static int
+same_entries (scm_t_bits *walk_a, scm_t_bits *next_a,
+              scm_t_bits *walk_b, scm_t_bits *next_b)
+{
+  if (SCM_DYNSTACK_TAG (walk_a) != SCM_DYNSTACK_TAG (walk_b))
+    return 0;
+
+  if (next_a - walk_a != next_b - walk_b)
+    return 0;
+
+  assert (SCM_DYNSTACK_PREV_OFFSET (next_a) == next_a - walk_a);
+  assert (SCM_DYNSTACK_PREV_OFFSET (next_b) == next_b - walk_b);
+
+  while (walk_a != next_a)
+    if (*(walk_a++) != *(walk_b++))
+      return 0;
+
+  return 1;
+}
+
+static ptrdiff_t
+shared_prefix_length (scm_t_dynstack *a, scm_t_dynstack *b)
+{
+  scm_t_bits *walk_a, *next_a, *walk_b, *next_b;
+
+  walk_a = SCM_DYNSTACK_FIRST (a);
+  walk_b = SCM_DYNSTACK_FIRST (b);
+
+  next_a = SCM_DYNSTACK_NEXT (walk_a);
+  next_b = SCM_DYNSTACK_NEXT (walk_b);
+
+  while (next_a && next_b && same_entries (walk_a, next_a, walk_b, next_b))
+    {
+      walk_a = next_a;
+      walk_b = next_b;
+
+      next_a = SCM_DYNSTACK_NEXT (walk_a);
+      next_b = SCM_DYNSTACK_NEXT (walk_b);
+    }
+
+  return walk_a - a->base;
+}
+
+scm_t_bits *
+scm_dynstack_unwind_fork (scm_t_dynstack *dynstack, scm_t_dynstack *branch)
+{
+  ptrdiff_t join_height;
+
+  join_height = shared_prefix_length (dynstack, branch);
+
+  scm_dynstack_unwind (dynstack, dynstack->base + join_height);
+
+  return branch->base + join_height;
+}
+
+scm_t_bits*
+scm_dynstack_find_prompt (scm_t_dynstack *dynstack, SCM key,
+                          scm_t_prompt_registers **regs,
+                          scm_t_dynstack_prompt_flags *flags)
+{
+  scm_t_bits *walk;
+
+  for (walk = SCM_DYNSTACK_PREV (dynstack->top); walk;
+       walk = SCM_DYNSTACK_PREV (walk))
+    {
+      scm_t_bits tag = SCM_DYNSTACK_TAG (walk);
+
+      if (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_PROMPT
+          && scm_is_eq (PROMPT_KEY (walk), key))
+        {
+          if (regs)
+            *regs = PROMPT_REGS (walk);
+          if (flags)
+            *flags = SCM_DYNSTACK_TAG_FLAGS (tag);
+          return walk;
+        }
+    }
+
+  return NULL;
+}
+
+scm_t_prompt_registers*
+scm_dynstack_relocate_prompt (scm_t_dynstack *dynstack, scm_t_ptrdiff reloc,
+                              scm_t_uint64 vm_cookie)
+{
+  scm_t_bits *item;
+  scm_t_prompt_registers *prev, *rewound;
+
+  item = SCM_DYNSTACK_PREV (dynstack->top);
+  if (SCM_DYNSTACK_TAG_TYPE (SCM_DYNSTACK_TAG (item))
+      != SCM_DYNSTACK_TYPE_PROMPT)
+    abort ();
+
+  prev = PROMPT_REGS (item);
+  rewound = scm_c_make_prompt_registers (prev->fp + reloc,
+                                         prev->sp + reloc,
+                                         prev->ip,
+                                         vm_cookie);
+  item[1] = (scm_t_bits) rewound;
+
+  return rewound;
+}
+
+void
+scm_dynstack_unwind_frame (scm_t_dynstack *dynstack)
+{
+  /* Unwind up to and including the next frame entry.  */
+  while (1)
+    {
+      scm_t_bits tag, *words;
+
+      tag = dynstack_pop (dynstack, &words);
+
+      switch (SCM_DYNSTACK_TAG_TYPE (tag))
+        {
+        case SCM_DYNSTACK_TYPE_FRAME:
+          return;
+        case SCM_DYNSTACK_TYPE_REWINDER:
+          clear_scm_t_bits (words, WINDER_WORDS);
+          continue;
+        case SCM_DYNSTACK_TYPE_UNWINDER:
+          {
+            scm_t_guard proc = WINDER_PROC (words);
+            void *data = WINDER_DATA (words);
+            clear_scm_t_bits (words, WINDER_WORDS);
+            if (SCM_DYNSTACK_TAG_FLAGS (tag) & SCM_F_DYNSTACK_WINDER_EXPLICIT)
+              proc (data);
+            continue;
+          }
+        default:
+          /* We should only see winders.  */
+          abort ();
+        }
+    }
+}
+
+/* This function must not allocate.  */
+void
+scm_dynstack_unwind_fluids (scm_t_dynstack *dynstack, SCM dynamic_state)
+{
+  scm_t_bits tag, *words;
+  size_t len;
+  
+  tag = dynstack_pop (dynstack, &words);
+  len = SCM_DYNSTACK_TAG_LEN (tag);
+
+  assert (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_WITH_FLUIDS);
+  assert (len >= 1);
+
+  scm_swap_fluids (len - 1, WITH_FLUIDS_FLUIDS (words),
+                   WITH_FLUIDS_VALUES (words), dynamic_state);
+  clear_scm_t_bits (words, len);
+}
+
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/dynstack.h b/libguile/dynstack.h
new file mode 100644
index 000000000..33389cad7
--- /dev/null
+++ b/libguile/dynstack.h
@@ -0,0 +1,206 @@
+/* classes: h_files */
+
+#ifndef SCM_DYNSTACK_H
+#define SCM_DYNSTACK_H
+
+/* Copyright (C) 2012 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+
+
+#include "libguile/__scm.h"
+#include "libguile/control.h"
+
+
+
+typedef struct
+{
+  scm_t_bits *base;
+  scm_t_bits *top;
+  scm_t_bits *limit;
+} scm_t_dynstack;
+
+
+
+/* Items on the dynstack are preceded by two-word headers, giving the
+   offset of the preceding item (or 0 if there is none) and the type,
+   flags, and length of the following dynstack entry, in words.  In
+   addition, there is a "null header" at the top of the stack,
+   indicating the length of the previous item, but with a tag of zero.
+
+   For example, consider an empty dynstack, with a capacity of 6 words:
+
+   +----------+----------+                                           +
+   |prev=0    |tag=0     |                                           |
+   +----------+----------+                                           +
+   ^base                 ^top                                   limit^
+
+   Now we evaluate (dynamic-wind enter thunk leave).  That will result
+   in a dynstack of:
+
+                         / the len=2 words     \
+   +----------+----------+----------+----------+----------+----------+
+   |prev=0    |tag:len=2 |enter     |leave     |prev=4    |tag=0     |
+   +----------+----------+----------+----------+----------+----------+
+   ^base                                                    top,limit^
+
+   The tag is a combination of the type of the dynstack item, some flags
+   associated with the item, and the length of the item.  See
+   SCM_MAKE_DYNSTACK_TAG below for the details.
+
+   This arrangement makes it possible to have variable-length dynstack
+   items, and yet be able to traverse them forwards or backwards.  */
+
+#define SCM_DYNSTACK_HEADER_LEN 2
+
+#define SCM_DYNSTACK_PREV_OFFSET(top) ((top)[-2])
+#define SCM_DYNSTACK_SET_PREV_OFFSET(top, offset) (top)[-2] = (offset)
+
+#define SCM_DYNSTACK_TAG(top) ((top)[-1])
+#define SCM_DYNSTACK_SET_TAG(top, tag) (top)[-1] = (tag)
+
+typedef enum {
+  SCM_DYNSTACK_TYPE_NONE = 0,
+  SCM_DYNSTACK_TYPE_FRAME,
+  SCM_DYNSTACK_TYPE_UNWINDER,
+  SCM_DYNSTACK_TYPE_REWINDER,
+  SCM_DYNSTACK_TYPE_WITH_FLUIDS,
+  SCM_DYNSTACK_TYPE_PROMPT,
+  SCM_DYNSTACK_TYPE_DYNWIND,
+} scm_t_dynstack_item_type;
+
+#define SCM_DYNSTACK_TAG_TYPE_MASK 0xf
+#define SCM_DYNSTACK_TAG_FLAGS_MASK 0xf0
+#define SCM_DYNSTACK_TAG_FLAGS_SHIFT 4
+#define SCM_DYNSTACK_TAG_LEN_SHIFT 8
+
+#define SCM_MAKE_DYNSTACK_TAG(type, flags, len)           \
+  ((type) | (flags) | ((len) << SCM_DYNSTACK_TAG_LEN_SHIFT))
+
+#define SCM_DYNSTACK_TAG_TYPE(tag)                     \
+  ((tag) & SCM_DYNSTACK_TAG_TYPE_MASK)
+#define SCM_DYNSTACK_TAG_FLAGS(tag)                    \
+  ((tag) & SCM_DYNSTACK_TAG_FLAGS_MASK)
+#define SCM_DYNSTACK_TAG_LEN(tag)                      \
+  ((tag) >> SCM_DYNSTACK_TAG_LEN_SHIFT)
+
+#define SCM_DYNSTACK_PREV(top)                                          \
+  (SCM_DYNSTACK_PREV_OFFSET (top)                                       \
+   ? ((top) - SCM_DYNSTACK_PREV_OFFSET (top)) : NULL)
+#define SCM_DYNSTACK_NEXT(top)                                          \
+  (SCM_DYNSTACK_TAG (top)                                               \
+   ? ((top) + SCM_DYNSTACK_TAG_LEN (SCM_DYNSTACK_TAG (top))             \
+      + SCM_DYNSTACK_HEADER_LEN)                                        \
+   : NULL)
+
+#define SCM_DYNSTACK_FIRST(dynstack) \
+  ((dynstack)->base + SCM_DYNSTACK_HEADER_LEN)
+
+#define SCM_DYNSTACK_CAPACITY(dynstack) \
+  ((dynstack)->limit - (dynstack)->base)
+#define SCM_DYNSTACK_SPACE(dynstack) \
+  ((dynstack)->limit - (dynstack)->top)
+#define SCM_DYNSTACK_HEIGHT(dynstack) \
+  ((dynstack)->top - (dynstack)->base)
+
+#define SCM_DYNSTACK_HAS_SPACE(dynstack, n) \
+  (SCM_DYNSTACK_SPACE (dynstack) >= n + SCM_DYNSTACK_HEADER_LEN)
+
+typedef enum {
+  SCM_F_DYNSTACK_FRAME_REWINDABLE = (1 << SCM_DYNSTACK_TAG_FLAGS_SHIFT)
+} scm_t_dynstack_frame_flags;
+
+typedef enum {
+  SCM_F_DYNSTACK_WINDER_EXPLICIT = (1 << SCM_DYNSTACK_TAG_FLAGS_SHIFT)
+} scm_t_dynstack_winder_flags;
+
+typedef enum {
+  SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY = (1 << SCM_DYNSTACK_TAG_FLAGS_SHIFT)
+} scm_t_dynstack_prompt_flags;
+
+typedef void (*scm_t_guard) (void *);
+
+
+
+
+/* Pushing and popping entries on the dynamic stack.  */
+
+SCM_INTERNAL void scm_dynstack_push_frame (scm_t_dynstack *,
+                                           scm_t_dynstack_frame_flags);
+SCM_INTERNAL void scm_dynstack_push_rewinder (scm_t_dynstack *,
+                                              scm_t_dynstack_winder_flags,
+                                              scm_t_guard, void *);
+SCM_INTERNAL void scm_dynstack_push_unwinder (scm_t_dynstack *,
+                                              scm_t_dynstack_winder_flags,
+                                              scm_t_guard, void *);
+SCM_INTERNAL void scm_dynstack_push_fluids (scm_t_dynstack *,
+                                            size_t,
+                                            SCM *fluids,
+                                            SCM *values,
+                                            SCM dynamic_state);
+SCM_INTERNAL void scm_dynstack_push_prompt (scm_t_dynstack *,
+                                            scm_t_dynstack_prompt_flags,
+                                            SCM key,
+                                            scm_t_prompt_registers *);
+SCM_INTERNAL void scm_dynstack_push_dynwind (scm_t_dynstack *,
+                                             SCM enter, SCM leave);
+
+SCM_INTERNAL void scm_dynstack_pop (scm_t_dynstack *);
+
+
+
+
+/* Capturing, winding, and unwinding.  */
+
+SCM_INTERNAL scm_t_dynstack* scm_dynstack_capture_all (scm_t_dynstack *dynstack);
+SCM_INTERNAL scm_t_dynstack* scm_dynstack_capture (scm_t_dynstack *dynstack,
+                                                   scm_t_bits *item);
+
+SCM_INTERNAL void scm_dynstack_wind_1 (scm_t_dynstack *, scm_t_bits *);
+SCM_INTERNAL scm_t_bits scm_dynstack_unwind_1 (scm_t_dynstack *);
+
+SCM_INTERNAL void scm_dynstack_wind (scm_t_dynstack *, scm_t_bits *);
+SCM_INTERNAL void scm_dynstack_unwind (scm_t_dynstack *, scm_t_bits *);
+
+SCM_INTERNAL scm_t_bits* scm_dynstack_unwind_fork (scm_t_dynstack *,
+                                                   scm_t_dynstack *);
+
+SCM_INTERNAL void scm_dynstack_unwind_frame (scm_t_dynstack *);
+SCM_INTERNAL void scm_dynstack_unwind_fluids (scm_t_dynstack *dynstack,
+                                              SCM dynamic_state);
+
+
+
+
+/* Miscellany.  */
+
+SCM_INTERNAL scm_t_bits* scm_dynstack_find_prompt (scm_t_dynstack *, SCM,
+                                                   scm_t_prompt_registers **,
+                                                   scm_t_dynstack_prompt_flags *);
+
+SCM_INTERNAL scm_t_prompt_registers*
+scm_dynstack_relocate_prompt (scm_t_dynstack *, scm_t_ptrdiff, scm_t_uint64);
+
+
+#endif  /* SCM_DYNSTACK_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/dynwind.c b/libguile/dynwind.c
index bec2dc806..05791860a 100644
--- a/libguile/dynwind.c
+++ b/libguile/dynwind.c
@@ -1,5 +1,5 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2008, 2010, 2011 Free Software Foundation, Inc.
- * 
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2008, 2010, 2011, 2012 Free Software Foundation, Inc.
+ *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
  * as published by the Free Software Foundation; either version 3 of
@@ -26,125 +26,72 @@
 #include <assert.h>
 
 #include "libguile/_scm.h"
-#include "libguile/control.h"
+#include "libguile/dynstack.h"
 #include "libguile/eval.h"
-#include "libguile/alist.h"
-#include "libguile/fluids.h"
 #include "libguile/ports.h"
-#include "libguile/smob.h"
 
 #include "libguile/dynwind.h"
-
-
-/* {Dynamic wind}
- 
-   Things that can be on the wind list:
-
-   #<frame>
-   #<winder>
-   #<with-fluids>
-   #<prompt>
-   (enter-proc . leave-proc)     dynamic-wind
-
-*/
 
 
+
 
 SCM
 scm_dynamic_wind (SCM in_guard, SCM thunk, SCM out_guard)
 #define FUNC_NAME "dynamic-wind"
 {
-  SCM ans, old_winds;
-  SCM_ASSERT (scm_is_true (scm_thunk_p (out_guard)),
-	      out_guard,
+  SCM ans;
+  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+
+  SCM_ASSERT (scm_is_true (scm_thunk_p (out_guard)), out_guard,
 	      SCM_ARG3, FUNC_NAME);
+
   scm_call_0 (in_guard);
-  old_winds = scm_i_dynwinds ();
-  scm_i_set_dynwinds (scm_acons (in_guard, out_guard, old_winds));
+  scm_dynstack_push_dynwind (&thread->dynstack, in_guard, out_guard);
+
   ans = scm_call_0 (thunk);
-  scm_i_set_dynwinds (old_winds);
+
+  scm_dynstack_pop (&thread->dynstack);
   scm_call_0 (out_guard);
+
   return ans;
 }
 #undef FUNC_NAME
 
-/* Frames and winders. */
-
-static scm_t_bits tc16_frame;
-#define FRAME_P(f)     SCM_SMOB_PREDICATE (tc16_frame, (f))
-
-#define FRAME_F_REWINDABLE    (1 << 0)
-#define FRAME_REWINDABLE_P(f) (SCM_SMOB_FLAGS(f) & FRAME_F_REWINDABLE)
-
-static scm_t_bits tc16_winder;
-#define WINDER_P(w)     SCM_SMOB_PREDICATE (tc16_winder, (w))
-#define WINDER_PROC(w)  ((void (*)(void *))SCM_SMOB_DATA (w))
-#define WINDER_DATA(w)  ((void *)SCM_SMOB_DATA_2 (w))
-
-#define WINDER_F_EXPLICIT    (1 << 0)
-#define WINDER_F_REWIND      (1 << 1)
-#define WINDER_F_MARK        (1 << 2)
-#define WINDER_EXPLICIT_P(w) (SCM_SMOB_FLAGS(w) & WINDER_F_EXPLICIT)
-#define WINDER_REWIND_P(w)   (SCM_SMOB_FLAGS(w) & WINDER_F_REWIND)
-#define WINDER_MARK_P(w)     (SCM_SMOB_FLAGS(w) & WINDER_F_MARK)
 
 void
 scm_dynwind_begin (scm_t_dynwind_flags flags)
 {
-  SCM f;
-  SCM_NEWSMOB (f, tc16_frame, 0);
-  if (flags & SCM_F_DYNWIND_REWINDABLE)
-    SCM_SET_SMOB_FLAGS (f, FRAME_F_REWINDABLE);
-  scm_i_set_dynwinds (scm_cons (f, scm_i_dynwinds ()));
+  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+
+  scm_dynstack_push_frame (&thread->dynstack, flags);
 }
 
+/* FIXME -- breaking abstractions */
 void
 scm_dynwind_end (void)
 {
-  SCM winds;
-
-  /* Unwind upto and including the next frame entry.  We can only
-     encounter #<winder> entries on the way.
-   */
-
-  winds = scm_i_dynwinds ();
-  while (scm_is_pair (winds))
-    {
-      SCM entry = SCM_CAR (winds);
-      winds = SCM_CDR (winds);
-
-      scm_i_set_dynwinds (winds);
-
-      if (FRAME_P (entry))
-	return;
-
-      assert (WINDER_P (entry));
-      if (!WINDER_REWIND_P (entry) && WINDER_EXPLICIT_P (entry))
-	WINDER_PROC(entry) (WINDER_DATA (entry));
-    }
-
-  assert (0);
+  scm_dynstack_unwind_frame (&SCM_I_CURRENT_THREAD->dynstack);
 }
 
 void
 scm_dynwind_unwind_handler (void (*proc) (void *), void *data,
 			    scm_t_wind_flags flags)
 {
-  SCM w;
-  SCM_NEWSMOB2 (w, tc16_winder,	(scm_t_bits) proc, (scm_t_bits) data);
-  if (flags & SCM_F_WIND_EXPLICITLY)
-    SCM_SET_SMOB_FLAGS (w, WINDER_F_EXPLICIT);
-  scm_i_set_dynwinds (scm_cons (w, scm_i_dynwinds ()));
+  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_t_dynstack *dynstack = &thread->dynstack;
+
+  scm_dynstack_push_unwinder (dynstack, flags, proc, data);
 }
 
 void
 scm_dynwind_rewind_handler (void (*proc) (void *), void *data,
 			    scm_t_wind_flags flags)
 {
-  SCM w;
-  SCM_NEWSMOB2 (w, tc16_winder,	(scm_t_bits) proc, (scm_t_bits) data);
-  SCM_SET_SMOB_FLAGS (w, WINDER_F_REWIND);
-  scm_i_set_dynwinds (scm_cons (w, scm_i_dynwinds ()));
+  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_t_dynstack *dynstack = &thread->dynstack;
+
+  scm_dynstack_push_rewinder (dynstack, 0, proc, data);
+
   if (flags & SCM_F_WIND_EXPLICITLY)
     proc (data);
 }
@@ -153,23 +100,16 @@ void
 scm_dynwind_unwind_handler_with_scm (void (*proc) (SCM), SCM data,
 				     scm_t_wind_flags flags)
 {
-  SCM w;
-  scm_t_bits fl = ((flags&SCM_F_WIND_EXPLICITLY)? WINDER_F_EXPLICIT : 0);
-  SCM_NEWSMOB2 (w, tc16_winder,	(scm_t_bits) proc, SCM_UNPACK (data));
-  SCM_SET_SMOB_FLAGS (w, fl | WINDER_F_MARK);
-  scm_i_set_dynwinds (scm_cons (w, scm_i_dynwinds ()));
+  /* FIXME: This is not a safe cast.  */
+  scm_dynwind_unwind_handler ((scm_t_guard) proc, SCM2PTR (data), flags);
 }
 
 void
 scm_dynwind_rewind_handler_with_scm (void (*proc) (SCM), SCM data,
 				     scm_t_wind_flags flags)
 {
-  SCM w;
-  SCM_NEWSMOB2 (w, tc16_winder, (scm_t_bits) proc, SCM_UNPACK (data));
-  SCM_SET_SMOB_FLAGS (w, WINDER_F_REWIND | WINDER_F_MARK);
-  scm_i_set_dynwinds (scm_cons (w, scm_i_dynwinds ()));
-  if (flags & SCM_F_WIND_EXPLICITLY)
-    proc (data);
+  /* FIXME: This is not a safe cast.  */
+  scm_dynwind_rewind_handler ((scm_t_guard) proc, SCM2PTR (data), flags);
 }
 
 void
@@ -178,19 +118,6 @@ scm_dynwind_free (void *mem)
   scm_dynwind_unwind_handler (free, mem, SCM_F_WIND_EXPLICITLY);
 }
 
-#ifdef GUILE_DEBUG
-SCM_DEFINE (scm_wind_chain, "wind-chain", 0, 0, 0, 
-            (),
-	    "Return the current wind chain. The wind chain contains all\n"
-	    "information required by @code{dynamic-wind} to call its\n"
-	    "argument thunks when entering/exiting its scope.")
-#define FUNC_NAME s_scm_wind_chain
-{
-  return scm_i_dynwinds ();
-}
-#undef FUNC_NAME
-#endif
-
 void
 scm_swap_bindings (SCM vars, SCM vals)
 {
@@ -206,97 +133,8 @@ scm_swap_bindings (SCM vars, SCM vals)
 }
 
 void
-scm_dowinds (SCM to, long delta)
-{
-  scm_i_dowinds (to, delta, NULL, NULL);
-}
-
-void 
-scm_i_dowinds (SCM to, long delta, void (*turn_func) (void *), void *data)
-{
- tail:
-  if (scm_is_eq (to, scm_i_dynwinds ()))
-    {
-      if (turn_func)
-	turn_func (data);
-    }
-  else if (delta < 0)
-    {
-      SCM wind_elt;
-
-      scm_i_dowinds (SCM_CDR (to), 1 + delta, turn_func, data);
-      wind_elt = SCM_CAR (to);
-
-      if (FRAME_P (wind_elt))
-	{
-	  if (!FRAME_REWINDABLE_P (wind_elt))
-	    scm_misc_error ("dowinds", 
-			    "cannot invoke continuation from this context",
-			    SCM_EOL);
-	}
-      else if (WINDER_P (wind_elt))
-	{
-	  if (WINDER_REWIND_P (wind_elt))
-	    WINDER_PROC (wind_elt) (WINDER_DATA (wind_elt));
-	}
-      else if (SCM_WITH_FLUIDS_P (wind_elt))
-	{
-          scm_i_swap_with_fluids (wind_elt,
-                                  SCM_I_CURRENT_THREAD->dynamic_state);
-	}
-      else if (SCM_PROMPT_P (wind_elt))
-        ; /* pass -- see vm_reinstate_partial_continuation */
-      else if (scm_is_pair (wind_elt))
-        scm_call_0 (SCM_CAR (wind_elt));
-      else
-        /* trash on the wind list */
-        abort ();
-
-      scm_i_set_dynwinds (to);
-    }
-  else
-    {
-      SCM wind;
-      SCM wind_elt;
-
-      wind = scm_i_dynwinds ();
-      wind_elt = SCM_CAR (wind);
-      scm_i_set_dynwinds (SCM_CDR (wind));
-
-      if (FRAME_P (wind_elt))
-	{
-	  /* Nothing to do. */
-	}
-      else if (WINDER_P (wind_elt))
-	{
-	  if (!WINDER_REWIND_P (wind_elt))
-	    WINDER_PROC (wind_elt) (WINDER_DATA (wind_elt));
-	}
-      else if (SCM_WITH_FLUIDS_P (wind_elt))
-	{
-          scm_i_swap_with_fluids (wind_elt,
-                                  SCM_I_CURRENT_THREAD->dynamic_state);
-	}
-      else if (SCM_PROMPT_P (wind_elt))
-        ; /* pass -- though we could invalidate the prompt */
-      else if (scm_is_pair (wind_elt))
-        scm_call_0 (SCM_CDR (wind_elt));
-      else
-        /* trash on the wind list */
-        abort ();
-
-      delta--;
-      goto tail;		/* scm_dowinds(to, delta-1); */
-    }
-}
-
-void
 scm_init_dynwind ()
 {
-  tc16_frame = scm_make_smob_type ("frame", 0);
-
-  tc16_winder = scm_make_smob_type ("winder", 0);
-
 #include "libguile/dynwind.x"
 }
 
diff --git a/libguile/dynwind.h b/libguile/dynwind.h
index 6e952c4db..9ade05c0b 100644
--- a/libguile/dynwind.h
+++ b/libguile/dynwind.h
@@ -3,7 +3,7 @@
 #ifndef SCM_DYNWIND_H
 #define SCM_DYNWIND_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2003,2004, 2006, 2008, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2003,2004, 2006, 2008, 2011, 2012 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -24,25 +24,22 @@
 
 
 #include "libguile/__scm.h"
+#include "libguile/dynstack.h"
 
 
 
-typedef void (*scm_t_guard) (void *);
-
 SCM_API SCM scm_dynamic_wind (SCM thunk1, SCM thunk2, SCM thunk3);
-SCM_API void scm_dowinds (SCM to, long delta);
-SCM_INTERNAL void scm_i_dowinds (SCM to, long delta,
-				 void (*turn_func) (void *), void *data);
+
 SCM_INTERNAL void scm_init_dynwind (void);
 
 SCM_API void scm_swap_bindings (SCM vars, SCM vals);
 
 typedef enum {
-  SCM_F_DYNWIND_REWINDABLE = (1 << 0)
+  SCM_F_DYNWIND_REWINDABLE = SCM_F_DYNSTACK_FRAME_REWINDABLE
 } scm_t_dynwind_flags;
 
 typedef enum {
-  SCM_F_WIND_EXPLICITLY = (1 << 0)
+  SCM_F_WIND_EXPLICITLY = SCM_F_DYNSTACK_WINDER_EXPLICIT
 } scm_t_wind_flags;
 
 SCM_API void scm_dynwind_begin (scm_t_dynwind_flags);
@@ -60,9 +57,6 @@ SCM_API void scm_dynwind_rewind_handler_with_scm (void (*func) (SCM), SCM data,
 
 SCM_API void scm_dynwind_free (void *mem);
 
-#ifdef GUILE_DEBUG
-SCM_API SCM scm_wind_chain (void);
-#endif /*GUILE_DEBUG*/
 
 #endif  /* SCM_DYNWIND_H */
 
diff --git a/libguile/eval.c b/libguile/eval.c
index 5a42b1ead..142d20abf 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012
  * Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
@@ -266,14 +266,14 @@ eval (SCM x, SCM env)
 
     case SCM_M_DYNWIND:
       {
-        SCM in, out, res, old_winds;
+        SCM in, out, res;
+        scm_i_thread *t = SCM_I_CURRENT_THREAD;
         in = EVAL1 (CAR (mx), env);
         out = EVAL1 (CDDR (mx), env);
         scm_call_0 (in);
-        old_winds = scm_i_dynwinds ();
-        scm_i_set_dynwinds (scm_acons (in, out, old_winds));
+        scm_dynstack_push_dynwind (&t->dynstack, in, out);
         res = eval (CADR (mx), env);
-        scm_i_set_dynwinds (old_winds);
+        scm_dynstack_pop (&t->dynstack);
         scm_call_0 (out);
         return res;
       }
@@ -281,7 +281,9 @@ eval (SCM x, SCM env)
     case SCM_M_WITH_FLUIDS:
       {
         long i, len;
-        SCM *fluidv, *valuesv, walk, wf, res;
+        SCM *fluidv, *valuesv, walk, res;
+        scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+
         len = scm_ilength (CAR (mx));
         fluidv = alloca (sizeof (SCM)*len);
         for (i = 0, walk = CAR (mx); i < len; i++, walk = CDR (walk))
@@ -290,12 +292,10 @@ eval (SCM x, SCM env)
         for (i = 0, walk = CADR (mx); i < len; i++, walk = CDR (walk))
           valuesv[i] = EVAL1 (CAR (walk), env);
         
-        wf = scm_i_make_with_fluids (len, fluidv, valuesv);
-        scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state);
-        scm_i_set_dynwinds (scm_cons (wf, scm_i_dynwinds ()));
+        scm_dynstack_push_fluids (&thread->dynstack, len, fluidv, valuesv,
+                                  thread->dynamic_state);
         res = eval (CDDR (mx), env);
-        scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state);
-        scm_i_set_dynwinds (CDR (scm_i_dynwinds ()));
+        scm_dynstack_unwind_fluids (&thread->dynstack, thread->dynamic_state);
         
         return res;
       }
@@ -437,20 +437,27 @@ eval (SCM x, SCM env)
 
     case SCM_M_PROMPT:
       {
-        SCM vm, res;
-        /* We need the prompt and handler values after a longjmp case,
-           so make sure they are volatile.  */
-        volatile SCM handler, prompt;
-
-        vm = scm_the_vm ();
-        prompt = scm_c_make_prompt (EVAL1 (CAR (mx), env),
-                                    SCM_VM_DATA (vm)->fp,
-                                    SCM_VM_DATA (vm)->sp, SCM_VM_DATA (vm)->ip,
-                                    0, -1, scm_i_dynwinds ());
+        SCM vm, k, res;
+        scm_t_dynstack_prompt_flags flags;
+        scm_t_prompt_registers *regs;
+        /* We need the handler after nonlocal return to the setjmp, so
+           make sure it is volatile.  */
+        volatile SCM handler;
+
+        k = EVAL1 (CAR (mx), env);
         handler = EVAL1 (CDDR (mx), env);
-        scm_i_set_dynwinds (scm_cons (prompt, scm_i_dynwinds ()));
+        vm = scm_the_vm ();
+
+        /* Push the prompt onto the dynamic stack. */
+        regs = scm_c_make_prompt_registers (SCM_VM_DATA (vm)->fp,
+                                            SCM_VM_DATA (vm)->sp,
+                                            SCM_VM_DATA (vm)->ip,
+                                            -1);
+        flags = SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY;
+        scm_dynstack_push_prompt (&SCM_I_CURRENT_THREAD->dynstack,
+                                  flags, k, regs);
 
-        if (SCM_PROMPT_SETJMP (prompt))
+        if (SCM_I_SETJMP (regs->regs))
           {
             /* The prompt exited nonlocally. */
             proc = handler;
@@ -459,7 +466,7 @@ eval (SCM x, SCM env)
           }
         
         res = eval (CADR (mx), env);
-        scm_i_set_dynwinds (CDR (scm_i_dynwinds ()));
+        scm_dynstack_pop (&SCM_I_CURRENT_THREAD->dynstack);
         return res;
       }
 
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 282718e65..8e36acde6 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -20,7 +20,6 @@
 # include <config.h>
 #endif
 
-#include <alloca.h>
 #include <stdio.h>
 #include <string.h>
 
@@ -92,14 +91,6 @@ scm_i_dynamic_state_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED
   scm_putc_unlocked ('>', port);
 }
 
-void
-scm_i_with_fluids_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
-{
-  scm_puts_unlocked ("#<with-fluids ", port);
-  scm_intprint (SCM_UNPACK (exp), 16, port);
-  scm_putc_unlocked ('>', port);
-}
-
 
 /* Return a new fluid.  */
 static SCM
@@ -310,76 +301,67 @@ apply_thunk (void *thunk)
   return scm_call_0 (SCM_PACK (thunk));
 }
 
-SCM
-scm_i_make_with_fluids (size_t n, SCM *fluids, SCM *vals)
+size_t
+scm_prepare_fluids (size_t n, SCM *fluids, SCM *values)
 {
-  SCM ret;
+  size_t j = n;
 
   /* Ensure that there are no duplicates in the fluids set -- an N^2 operation,
      but N will usually be small, so perhaps that's OK. */
-  {
-    size_t i, j = n;
+  while (j--)
+    {
+      size_t i;
+
+      if (SCM_UNLIKELY (!IS_FLUID (fluids[j])))
+        scm_wrong_type_arg ("with-fluids", 0, fluids[j]);
 
-    while (j--)
       for (i = 0; i < j; i++)
         if (scm_is_eq (fluids[i], fluids[j]))
           {
-            vals[i] = vals[j]; /* later bindings win */
+            values[i] = values[j]; /* later bindings win */
             n--;
             break;
           }
-  }
-        
-  ret = scm_words (scm_tc7_with_fluids | (n << 8), 1 + n*2);
-  SCM_SET_CELL_WORD_1 (ret, n);
-
-  while (n--)
-    {
-      if (SCM_UNLIKELY (!IS_FLUID (fluids[n])))
-        scm_wrong_type_arg ("with-fluids", 0, fluids[n]);
-      SCM_SET_CELL_OBJECT (ret, 1 + n * 2, fluids[n]);
-      SCM_SET_CELL_OBJECT (ret, 2 + n * 2, vals[n]);
     }
 
-  return ret;
+  return n;
 }
   
 void
-scm_i_swap_with_fluids (SCM wf, SCM dynstate)
+scm_swap_fluids (size_t n, SCM *fluids, SCM *values, SCM dynstate)
 {
-  SCM fluids;
+  SCM fluid_vector;
   size_t i, max = 0;
 
-  fluids = DYNAMIC_STATE_FLUIDS (dynstate);
+  fluid_vector = DYNAMIC_STATE_FLUIDS (dynstate);
 
   /* We could cache the max in the with-fluids, but that would take more mem,
      and we're touching all the fluids anyway, so this per-swap traversal should
      be OK. */
-  for (i = 0; i < SCM_WITH_FLUIDS_LEN (wf); i++)
+  for (i = 0; i < n; i++)
     {
-      size_t num = FLUID_NUM (SCM_WITH_FLUIDS_NTH_FLUID (wf, i));
+      size_t num = FLUID_NUM (fluids[i]);
       max = (max > num) ? max : num;
     }
 
-  if (SCM_UNLIKELY (max >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
+  if (SCM_UNLIKELY (max >= SCM_SIMPLE_VECTOR_LENGTH (fluid_vector)))
     {
       /* Lazily grow the current thread's dynamic state.  */
       grow_dynamic_state (dynstate);
 
-      fluids = DYNAMIC_STATE_FLUIDS (dynstate);
+      fluid_vector = DYNAMIC_STATE_FLUIDS (dynstate);
     }
 
   /* Bind the fluids. Order doesn't matter, as all fluids are distinct. */
-  for (i = 0; i < SCM_WITH_FLUIDS_LEN (wf); i++)
+  for (i = 0; i < n; i++)
     {
       size_t fluid_num;
       SCM x;
       
-      fluid_num = FLUID_NUM (SCM_WITH_FLUIDS_NTH_FLUID (wf, i));
-      x = SCM_SIMPLE_VECTOR_REF (fluids, fluid_num);
-      SCM_SIMPLE_VECTOR_SET (fluids, fluid_num,
-                             SCM_WITH_FLUIDS_NTH_VAL (wf, i));
-      SCM_WITH_FLUIDS_SET_NTH_VAL (wf, i, x);
+      fluid_num = FLUID_NUM (fluids[i]);
+      x = SCM_SIMPLE_VECTOR_REF (fluid_vector, fluid_num);
+      SCM_SIMPLE_VECTOR_SET (fluid_vector, fluid_num, values[i]);
+      values[i] = x;
     }
 }
   
@@ -400,9 +382,10 @@ SCM
 scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
 #define FUNC_NAME "scm_c_with_fluids"
 {
-  SCM wf, ans;
+  SCM ans;
   long flen, vlen, i;
   SCM *fluidsv, *valuesv;
+  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
 
   SCM_VALIDATE_LIST_COPYLEN (1, fluids, flen);
   SCM_VALIDATE_LIST_COPYLEN (2, values, vlen);
@@ -423,12 +406,10 @@ scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
       values = SCM_CDR (values);
     }
 
-  wf = scm_i_make_with_fluids (flen, fluidsv, valuesv);
-  scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state);
-  scm_i_set_dynwinds (scm_cons (wf, scm_i_dynwinds ()));
+  scm_dynstack_push_fluids (&thread->dynstack, flen, fluidsv, valuesv,
+                            thread->dynamic_state);
   ans = cproc (cdata);
-  scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state);
-  scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ()));
+  scm_dynstack_unwind_fluids (&thread->dynstack, thread->dynamic_state);
 
   return ans;
 }
@@ -449,14 +430,13 @@ SCM
 scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata)
 #define FUNC_NAME "scm_c_with_fluid"
 {
-  SCM ans, wf;
+  SCM ans;
+  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
 
-  wf = scm_i_make_with_fluids (1, &fluid, &value);
-  scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state);
-  scm_i_set_dynwinds (scm_cons (wf, scm_i_dynwinds ()));
+  scm_dynstack_push_fluids (&thread->dynstack, 1, &fluid, &value,
+                            thread->dynamic_state);
   ans = cproc (cdata);
-  scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state);
-  scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ()));
+  scm_dynstack_unwind_fluids (&thread->dynstack, thread->dynamic_state);
 
   return ans;
 }
diff --git a/libguile/fluids.h b/libguile/fluids.h
index 7d134b922..227877251 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -3,7 +3,7 @@
 #ifndef SCM_FLUIDS_H
 #define SCM_FLUIDS_H
 
-/* Copyright (C) 1996,2000,2001, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1996,2000,2001, 2006, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -27,17 +27,6 @@
 #include "libguile/root.h"
 #include "libguile/vectors.h"
 
-/* These "with-fluids" objects live on the dynamic stack, and record previous
-   values of fluids. Guile uses shallow binding, so the current fluid values are
-   always in the same place for a given thread, in the dynamic-state vector.
- */
-
-#define SCM_WITH_FLUIDS_P(x) (SCM_HAS_TYP7 (x, scm_tc7_with_fluids))
-#define SCM_WITH_FLUIDS_LEN(x) (SCM_CELL_WORD ((x), 0) >> 8)
-#define SCM_WITH_FLUIDS_NTH_FLUID(x,n) (SCM_CELL_OBJECT ((x), 1 + (n)*2))
-#define SCM_WITH_FLUIDS_NTH_VAL(x,n) (SCM_CELL_OBJECT ((x), 2 + (n)*2))
-#define SCM_WITH_FLUIDS_SET_NTH_VAL(x,n,v) (SCM_SET_CELL_OBJECT ((x), 2 + (n)*2, (v)))
-
 
 /* Fluids.
 
@@ -70,8 +59,9 @@ SCM_API SCM scm_fluid_set_x (SCM fluid, SCM value);
 SCM_API SCM scm_fluid_unset_x (SCM fluid);
 SCM_API SCM scm_fluid_bound_p (SCM fluid);
 
-SCM_INTERNAL SCM scm_i_make_with_fluids (size_t n, SCM *fluids, SCM *vals);
-SCM_INTERNAL void scm_i_swap_with_fluids (SCM with_fluids, SCM dynamic_state);
+SCM_INTERNAL size_t scm_prepare_fluids (size_t n, SCM *fluids, SCM *vals);
+SCM_INTERNAL void scm_swap_fluids (size_t n, SCM *fluids, SCM *vals,
+                                   SCM dynamic_state);
 
 SCM_API SCM scm_c_with_fluids (SCM fluids, SCM vals,
 			       SCM (*cproc)(void *), void *cdata);
@@ -101,7 +91,6 @@ SCM_INTERNAL SCM scm_i_make_initial_dynamic_state (void);
 
 SCM_INTERNAL void scm_i_fluid_print (SCM exp, SCM port, scm_print_state *pstate);
 SCM_INTERNAL void scm_i_dynamic_state_print (SCM exp, SCM port, scm_print_state *pstate);
-SCM_INTERNAL void scm_i_with_fluids_print (SCM exp, SCM port, scm_print_state *pstate);
 SCM_INTERNAL void scm_init_fluids (void);
 
 #endif  /* SCM_FLUIDS_H */
diff --git a/libguile/print.c b/libguile/print.c
index eb601322e..fd0cc3da9 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -645,12 +645,6 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	case scm_tc7_vm_cont:
 	  scm_i_vm_cont_print (exp, port, pstate);
 	  break;
-	case scm_tc7_prompt:
-	  scm_i_prompt_print (exp, port, pstate);
-	  break;
-	case scm_tc7_with_fluids:
-	  scm_i_with_fluids_print (exp, port, pstate);
-	  break;
 	case scm_tc7_array:
 	  ENTER_NESTED_DATA (pstate, exp, circref);
           scm_i_print_array (exp, port, pstate);
diff --git a/libguile/root.c b/libguile/root.c
index 8c8fd1aa5..c83da1c3c 100644
--- a/libguile/root.c
+++ b/libguile/root.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000, 2001, 2002, 2006, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000, 2001, 2002, 2006, 2008, 2009, 2012 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -109,12 +109,14 @@ scm_internal_cwdr (scm_t_catch_body body, void *body_data,
 		   SCM_STACKITEM *stack_start)
 {
   struct cwdr_handler_data my_handler_data;
-  SCM answer, old_winds;
+  scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
+  SCM answer;
+  scm_t_dynstack *old_dynstack;
 
   /* Exit caller's dynamic state.
    */
-  old_winds = scm_i_dynwinds ();
-  scm_dowinds (SCM_EOL, scm_ilength (old_winds));
+  old_dynstack = scm_dynstack_capture_all (dynstack);
+  scm_dynstack_unwind (dynstack, SCM_DYNSTACK_FIRST (dynstack));
 
   scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
   scm_dynwind_current_dynamic_state (scm_make_dynamic_state (SCM_UNDEFINED));
@@ -128,7 +130,7 @@ scm_internal_cwdr (scm_t_catch_body body, void *body_data,
 
   /* Enter caller's dynamic state.
    */
-  scm_dowinds (old_winds, - scm_ilength (old_winds));
+  scm_dynstack_wind (dynstack, SCM_DYNSTACK_FIRST (old_dynstack));
 
   /* Now run the real handler iff the body did a throw. */
   if (my_handler_data.run_handler)
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 9599554a2..610a36e24 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -1,5 +1,5 @@
 /* A stack holds a frame chain
- * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation
+ * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -95,19 +95,17 @@ stack_depth (SCM frame)
  * encountered.
  */
 
-static SCM
+static SCM*
 find_prompt (SCM key)
 {
-  SCM winds;
-  for (winds = scm_i_dynwinds (); scm_is_pair (winds); winds = scm_cdr (winds))
-    {
-      SCM elt = scm_car (winds);
-      if (SCM_PROMPT_P (elt) && scm_is_eq (SCM_PROMPT_TAG (elt), key))
-        return elt;
-    }
-  scm_misc_error ("make-stack", "Prompt tag not found while narrowing stack",
-                  scm_list_1 (key));
-  return SCM_BOOL_F; /* not reached */
+  scm_t_prompt_registers *regs;
+
+  if (!scm_dynstack_find_prompt (&SCM_I_CURRENT_THREAD->dynstack, key,
+                                 &regs, NULL))
+    scm_misc_error ("make-stack", "Prompt tag not found while narrowing stack",
+                    scm_list_1 (key));
+
+  return regs->fp;
 }
 
 static void
@@ -136,10 +134,9 @@ narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key)
     {
       /* Cut until the given prompt tag is seen. FIXME, assumes prompt tags are
          symbols. */
-      SCM prompt = find_prompt (inner_key);
+      SCM *fp = find_prompt (inner_key);
       for (; len; len--, frame = scm_frame_previous (frame))
-        if (SCM_PROMPT_REGISTERS (prompt)->fp
-            == SCM_VM_FRAME_FP (frame) - SCM_VM_FRAME_OFFSET (frame))
+        if (fp == SCM_VM_FRAME_FP (frame) - SCM_VM_FRAME_OFFSET (frame))
           break;
     }
   else
@@ -171,13 +168,12 @@ narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key)
     {
       /* Cut until the given prompt tag is seen. FIXME, assumes prompt tags are
          symbols. */
-      SCM prompt = find_prompt (outer_key);
+      SCM *fp = find_prompt (outer_key);
       while (len)
         {
           frame = scm_stack_ref (stack, scm_from_long (len - 1));
           len--;
-          if (SCM_PROMPT_REGISTERS (prompt)->fp
-              == SCM_VM_FRAME_FP (frame) - SCM_VM_FRAME_OFFSET (frame))
+          if (fp == SCM_VM_FRAME_FP (frame) - SCM_VM_FRAME_OFFSET (frame))
             break;
         }
     }
@@ -257,7 +253,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
       SCM cont;
       struct scm_vm_cont *c;
 
-      cont = scm_i_vm_capture_continuation (scm_the_vm ());
+      cont = scm_i_capture_current_stack ();
       c = SCM_VM_CONT_DATA (cont);
 
       frame = scm_c_make_frame (cont, c->fp + c->reloc,
diff --git a/libguile/tags.h b/libguile/tags.h
index b49e61651..a194ea0be 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -423,8 +423,8 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
 #define scm_tc7_vm		55
 #define scm_tc7_vm_cont		71
 
-#define scm_tc7_prompt		61
-#define scm_tc7_with_fluids	63
+#define scm_tc7_unused_17	61
+#define scm_tc7_unused_21	63
 #define scm_tc7_unused_19	69
 #define scm_tc7_program		79
 #define scm_tc7_weak_set	85
diff --git a/libguile/threads.c b/libguile/threads.c
index 313557001..f9104f9e3 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -543,7 +543,9 @@ guilify_self_1 (struct GC_stack_base *base)
   t.held_mutex = NULL;
   t.join_queue = SCM_EOL;
   t.dynamic_state = SCM_BOOL_F;
-  t.dynwinds = SCM_EOL;
+  t.dynstack.base = NULL;
+  t.dynstack.top = NULL;
+  t.dynstack.limit = NULL;
   t.active_asyncs = SCM_EOL;
   t.block_asyncs = 1;
   t.pending_asyncs = 1;
@@ -617,6 +619,10 @@ guilify_self_2 (SCM parent)
   else
     t->dynamic_state = scm_i_make_initial_dynamic_state ();
 
+  t->dynstack.base = scm_gc_malloc (16 * sizeof (scm_t_bits), "dynstack");
+  t->dynstack.limit = t->dynstack.base + 16;
+  t->dynstack.top = t->dynstack.base + SCM_DYNSTACK_HEADER_LEN;
+
   t->join_queue = make_queue ();
   t->block_asyncs = 0;
 }
diff --git a/libguile/threads.h b/libguile/threads.h
index 54d64141b..3030f6fdc 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -3,7 +3,7 @@
 #ifndef SCM_THREADS_H
 #define SCM_THREADS_H
 
-/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2011, 2012 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -27,8 +27,8 @@
 #include "libguile/procs.h"
 #include "libguile/throw.h"
 #include "libguile/root.h"
+#include "libguile/dynstack.h"
 #include "libguile/iselect.h"
-#include "libguile/dynwind.h"
 #include "libguile/continuations.h"
 
 #if SCM_USE_PTHREAD_THREADS
@@ -79,7 +79,9 @@ typedef struct scm_i_thread {
   /* Other thread local things.
    */
   SCM dynamic_state;
-  SCM dynwinds;
+
+  /* The dynamic stack.  */
+  scm_t_dynstack dynstack;
 
   /* For system asyncs.
    */
@@ -200,12 +202,8 @@ SCM_INTERNAL SCM_THREAD_LOCAL scm_i_thread *scm_i_current_thread;
 
 # endif /* !SCM_HAVE_THREAD_STORAGE_CLASS */
 
-# define scm_i_dynwinds()         (SCM_I_CURRENT_THREAD->dynwinds)
-# define scm_i_set_dynwinds(w)    (SCM_I_CURRENT_THREAD->dynwinds = (w))
-
 #endif /* BUILDING_LIBGUILE */
 
-
 SCM_INTERNAL scm_i_pthread_mutex_t scm_i_misc_mutex;
 
 /* Convenience functions for working with the pthread API in guile
diff --git a/libguile/throw.c b/libguile/throw.c
index 29ccc8aba..2f5c71225 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -456,7 +456,11 @@ SCM_SYMBOL (sym_pre_init_catch_tag, "%pre-init-catch-tag");
 static SCM
 pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
 {
-  SCM vm, prompt, res;
+  volatile SCM vm, v_handler;
+  SCM res;
+  scm_t_prompt_registers *regs;
+  scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
+  scm_t_dynstack_prompt_flags flags;
 
   /* Only handle catch-alls without pre-unwind handlers */
   if (!SCM_UNBNDP (pre_unwind_handler))
@@ -464,22 +468,29 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
   if (scm_is_false (scm_eqv_p (tag, SCM_BOOL_T)))
     abort ();
 
+  /* These two are volatile, so we know we can access them after a
+     nonlocal return to the setjmp.  */
   vm = scm_the_vm ();
-  prompt = scm_c_make_prompt (sym_pre_init_catch_tag,
-                              SCM_VM_DATA (vm)->fp, SCM_VM_DATA (vm)->sp,
-                              SCM_VM_DATA (vm)->ip, 1, -1, scm_i_dynwinds ());
-  scm_i_set_dynwinds (scm_cons (prompt, SCM_PROMPT_DYNWINDS (prompt)));
+  v_handler = handler;
 
-  if (SCM_PROMPT_SETJMP (prompt))
+  /* Push the prompt onto the dynamic stack. */
+  regs = scm_c_make_prompt_registers (SCM_VM_DATA (vm)->fp,
+                                      SCM_VM_DATA (vm)->sp,
+                                      SCM_VM_DATA (vm)->ip,
+                                      -1);
+  flags = SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY;
+  scm_dynstack_push_prompt (dynstack, flags, sym_pre_init_catch_tag, regs);
+
+  if (SCM_I_SETJMP (regs->regs))
     {
       /* nonlocal exit */
       SCM args = scm_i_prompt_pop_abort_args_x (vm);
       /* cdr past the continuation */
-      return scm_apply_0 (handler, scm_cdr (args));
+      return scm_apply_0 (v_handler, scm_cdr (args));
     }
 
   res = scm_call_0 (thunk);
-  scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ()));
+  scm_dynstack_pop (dynstack);
 
   return res;
 }
@@ -487,14 +498,9 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
 static int
 find_pre_init_catch (void)
 {
-  SCM winds;
-
-  /* Search the wind list for an appropriate prompt.
-     "Waiter, please bring us the wind list." */
-  for (winds = scm_i_dynwinds (); scm_is_pair (winds); winds = SCM_CDR (winds))
-    if (SCM_PROMPT_P (SCM_CAR (winds))
-        && scm_is_eq (SCM_PROMPT_TAG (SCM_CAR (winds)), sym_pre_init_catch_tag))
-      return 1;
+  if (scm_dynstack_find_prompt (&SCM_I_CURRENT_THREAD->dynstack,
+                                sym_pre_init_catch_tag, NULL, NULL))
+    return 1;
 
   return 0;
 }
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 8981042f8..f30ed9d02 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001,2008,2009,2010,2011 Free Software Foundation, Inc.
+/* Copyright (C) 2001,2008,2009,2010,2011,2012 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -1032,25 +1032,49 @@ VM_DEFINE_INSTRUCTION (58, continuation_call, "continuation-call", 0, -1, 0)
 
 VM_DEFINE_INSTRUCTION (59, partial_cont_call, "partial-cont-call", 0, -1, 0)
 {
-  SCM vmcont, intwinds, prevwinds;
-  POP2 (intwinds, vmcont);
+  SCM vmcont;
+  scm_t_ptrdiff reloc;
+  POP (vmcont);
   SYNC_REGISTER ();
   if (SCM_UNLIKELY (!SCM_VM_CONT_REWINDABLE_P (vmcont)))
     { finish_args = vmcont;
       goto vm_error_continuation_not_rewindable;
     }
-  prevwinds = scm_i_dynwinds ();
-  vm_reinstate_partial_continuation (vm, vmcont, intwinds, sp + 1 - fp, fp,
-                                     vm_cookie);
+  reloc = vm_reinstate_partial_continuation (vm, vmcont, sp + 1 - fp, fp,
+                                             vm_cookie);
 
-  /* Rewind prompt jmpbuffers, if any. */
+  /* The prompt captured a slice of the dynamic stack.  Here we wind
+     those entries onto the current thread's stack.
+
+     Unhappily, this code must be here, in vm_engine, so that the setjmp
+     captures the stack in this function, and so that subsequently wound
+     stack entries don't see stale prompts.  */
   {
-    SCM winds = scm_i_dynwinds ();
-    for (; !scm_is_eq (winds, prevwinds); winds = scm_cdr (winds))
-      if (SCM_PROMPT_P (scm_car (winds)) && SCM_PROMPT_SETJMP (scm_car (winds)))
-        break;
+    scm_t_bits *walk;
+
+    for (walk = SCM_DYNSTACK_FIRST (SCM_VM_CONT_DATA (vmcont)->dynstack);
+         SCM_DYNSTACK_TAG (walk);
+         walk = SCM_DYNSTACK_NEXT (walk))
+      {
+        scm_t_bits tag = SCM_DYNSTACK_TAG (walk);
+
+        scm_dynstack_wind_1 (&current_thread->dynstack, walk);
+
+        if (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_PROMPT)
+          {
+            scm_t_prompt_registers *rewound;
+
+            rewound = scm_dynstack_relocate_prompt (&current_thread->dynstack,
+                                                    reloc, vm_cookie);
+
+            /* Reset the jmpbuf.  */
+            if (SCM_I_SETJMP (rewound->regs))
+              /* Non-local exit to this newly rewound prompt.  */
+              break;
+          }
+      }
   }
-    
+
   CACHE_REGISTER ();
   program = SCM_FRAME_PROGRAM (fp);
   CACHE_PROGRAM ();
@@ -1176,9 +1200,12 @@ VM_DEFINE_INSTRUCTION (65, call_cc, "call/cc", 0, 1, 1)
 {
   int first;
   SCM proc, vm_cont, cont;
+  scm_t_dynstack *dynstack;
   POP (proc);
   SYNC_ALL ();
-  vm_cont = scm_i_vm_capture_stack (vp->stack_base, fp, sp, ip, NULL, 0);
+  dynstack = scm_dynstack_capture_all (&current_thread->dynstack);
+  vm_cont = scm_i_vm_capture_stack (vp->stack_base, fp, sp, ip, NULL,
+                                    dynstack, 0);
   cont = scm_i_make_continuation (&first, vm, vm_cont);
   if (first) 
     {
@@ -1211,15 +1238,18 @@ VM_DEFINE_INSTRUCTION (66, tail_call_cc, "tail-call/cc", 0, 1, 1)
 {
   int first;
   SCM proc, vm_cont, cont;
+  scm_t_dynstack *dynstack;
   POP (proc);
   SYNC_ALL ();
   /* In contrast to call/cc, tail-call/cc captures the continuation without the
      stack frame. */
+  dynstack = scm_dynstack_capture_all (&current_thread->dynstack);
   vm_cont = scm_i_vm_capture_stack (vp->stack_base,
                                     SCM_FRAME_DYNAMIC_LINK (fp),
                                     SCM_FRAME_LOWER_ADDRESS (fp) - 1,
                                     SCM_FRAME_RETURN_ADDRESS (fp),
                                     SCM_FRAME_MV_RETURN_ADDRESS (fp),
+                                    dynstack,
                                     0);
   cont = scm_i_make_continuation (&first, vm, vm_cont);
   if (first) 
@@ -1543,7 +1573,9 @@ VM_DEFINE_INSTRUCTION (85, prompt, "prompt", 4, 2, 0)
 {
   scm_t_int32 offset;
   scm_t_uint8 escape_only_p;
-  SCM k, prompt;
+  SCM k;
+  scm_t_dynstack_prompt_flags flags;
+  scm_t_prompt_registers *regs;
 
   escape_only_p = FETCH ();
   FETCH_OFFSET (offset);
@@ -1551,10 +1583,10 @@ VM_DEFINE_INSTRUCTION (85, prompt, "prompt", 4, 2, 0)
 
   SYNC_REGISTER ();
   /* Push the prompt onto the dynamic stack. */
-  prompt = scm_c_make_prompt (k, fp, sp, ip + offset, escape_only_p, vm_cookie,
-                              scm_i_dynwinds ());
-  scm_i_set_dynwinds (scm_cons (prompt, SCM_PROMPT_DYNWINDS (prompt)));
-  if (SCM_PROMPT_SETJMP (prompt))
+  regs = scm_c_make_prompt_registers (fp, sp, ip + offset, vm_cookie);
+  flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0;
+  scm_dynstack_push_prompt (&current_thread->dynstack, flags, k, regs);
+  if (SCM_I_SETJMP (regs->regs))
     {
       /* The prompt exited nonlocally. Cache the regs back from the vp, and go
          to the handler.
@@ -1595,7 +1627,7 @@ VM_DEFINE_INSTRUCTION (86, wind, "wind", 0, 2, 0)
       finish_args = unwind;
       goto vm_error_not_a_thunk;
     }
-  scm_i_set_dynwinds (scm_cons (scm_cons (wind, unwind), scm_i_dynwinds ()));
+  scm_dynstack_push_dynwind (&current_thread->dynstack, wind, unwind);
   NEXT;
 }
 
@@ -1614,32 +1646,28 @@ VM_DEFINE_INSTRUCTION (88, unwind, "unwind", 0, 0, 0)
 {
   /* A normal exit from the dynamic extent of an expression. Pop the top entry
      off of the dynamic stack. */
-  scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ()));
+  scm_dynstack_pop (&current_thread->dynstack);
   NEXT;
 }
 
 VM_DEFINE_INSTRUCTION (89, wind_fluids, "wind-fluids", 1, -1, 0)
 {
   unsigned n = FETCH ();
-  SCM wf;
   
   SYNC_REGISTER ();
   sp -= 2 * n;
   CHECK_UNDERFLOW ();
-  wf = scm_i_make_with_fluids (n, sp + 1, sp + 1 + n);
+  scm_dynstack_push_fluids (&current_thread->dynstack, n, sp + 1, sp + 1 + n,
+                            current_thread->dynamic_state);
   NULLSTACK (2 * n);
-
-  scm_i_swap_with_fluids (wf, current_thread->dynamic_state);
-  scm_i_set_dynwinds (scm_cons (wf, scm_i_dynwinds ()));
   NEXT;
 }
 
 VM_DEFINE_INSTRUCTION (90, unwind_fluids, "unwind-fluids", 0, 0, 0)
 {
-  SCM wf;
-  wf = scm_car (scm_i_dynwinds ());
-  scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ()));
-  scm_i_swap_with_fluids (wf, current_thread->dynamic_state);
+  /* This function must not allocate.  */
+  scm_dynstack_unwind_fluids (&current_thread->dynstack,
+                              current_thread->dynamic_state);
   NEXT;
 }
 
diff --git a/libguile/vm.c b/libguile/vm.c
index e386202ad..a283857f0 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -101,7 +101,8 @@ scm_i_vm_cont_print (SCM x, SCM port, scm_print_state *pstate)
  */
 SCM
 scm_i_vm_capture_stack (SCM *stack_base, SCM *fp, SCM *sp, scm_t_uint8 *ra,
-                        scm_t_uint8 *mvra, scm_t_uint32 flags)
+                        scm_t_uint8 *mvra, scm_t_dynstack *dynstack,
+                        scm_t_uint32 flags)
 {
   struct scm_vm_cont *p;
 
@@ -124,6 +125,7 @@ scm_i_vm_capture_stack (SCM *stack_base, SCM *fp, SCM *sp, scm_t_uint8 *ra,
   p->fp = fp;
   memcpy (p->stack_base, stack_base, (sp + 1 - stack_base) * sizeof (SCM));
   p->reloc = p->stack_base - stack_base;
+  p->dynstack = dynstack;
   p->flags = flags;
   return scm_cell (scm_tc7_vm_cont, (scm_t_bits)p);
 }
@@ -183,10 +185,19 @@ vm_return_to_continuation (SCM vm, SCM cont, size_t n, SCM *argv)
 }
 
 SCM
-scm_i_vm_capture_continuation (SCM vm)
+scm_i_capture_current_stack (void)
 {
-  struct scm_vm *vp = SCM_VM_DATA (vm);
-  return scm_i_vm_capture_stack (vp->stack_base, vp->fp, vp->sp, vp->ip, NULL, 0);
+  scm_i_thread *thread;
+  SCM vm;
+  struct scm_vm *vp;
+
+  thread = SCM_I_CURRENT_THREAD;
+  vm = scm_the_vm ();
+  vp = SCM_VM_DATA (vm);
+
+  return scm_i_vm_capture_stack (vp->stack_base, vp->fp, vp->sp, vp->ip, NULL,
+                                 scm_dynstack_capture_all (&thread->dynstack),
+                                 0);
 }
 
 static void
@@ -264,13 +275,14 @@ vm_abort (SCM vm, size_t n, scm_t_int64 vm_cookie)
   scm_c_abort (vm, tag, n + tail_len, argv, vm_cookie);
 }
 
-static void
-vm_reinstate_partial_continuation (SCM vm, SCM cont, SCM intwinds,
+static scm_t_ptrdiff
+vm_reinstate_partial_continuation (SCM vm, SCM cont,
                                    size_t n, SCM *argv, scm_t_int64 vm_cookie)
 {
   struct scm_vm *vp;
   struct scm_vm_cont *cp;
   SCM *argv_copy, *base;
+  scm_t_ptrdiff reloc;
   size_t i;
 
   argv_copy = alloca (n * sizeof(SCM));
@@ -279,9 +291,10 @@ vm_reinstate_partial_continuation (SCM vm, SCM cont, SCM intwinds,
   vp = SCM_VM_DATA (vm);
   cp = SCM_VM_CONT_DATA (cont);
   base = SCM_FRAME_UPPER_ADDRESS (vp->fp) + 1;
+  reloc = cp->reloc + (base - cp->stack_base);
 
 #define RELOC(scm_p)						\
-  (((SCM *) (scm_p)) + cp->reloc + (base - cp->stack_base))
+  (((SCM *) (scm_p)) + reloc)
 
   if ((base - vp->stack_base) + cp->stack_size + n + 1 > vp->stack_size)
     scm_misc_error ("vm-engine",
@@ -312,31 +325,16 @@ vm_reinstate_partial_continuation (SCM vm, SCM cont, SCM intwinds,
   vp->sp++;
   *vp->sp = scm_from_size_t (n);
 
-  /* Finally, rewind the dynamic state.
+  /* Finally, rewind the dynamic state.  Unhappily, we have to do this
+     in the vm_engine.  If we do it here, the stack frame will likely
+     have been stompled by some future call out of the VM, so we will
+     return to some other part of the VM.
 
-     We have to treat prompts specially, because we could be rewinding the
-     dynamic state from a different thread, or just a different position on the
-     C and/or VM stack -- so we need to reset the jump buffers so that an abort
-     comes back here, with appropriately adjusted sp and fp registers. */
-  {
-    long delta = 0;
-    SCM newwinds = scm_i_dynwinds ();
-    for (; scm_is_pair (intwinds); intwinds = scm_cdr (intwinds), delta--)
-      {
-        SCM x = scm_car (intwinds);
-        if (SCM_PROMPT_P (x))
-          /* the jmpbuf will be reset by our caller */
-          x = scm_c_make_prompt (SCM_PROMPT_TAG (x),
-                                 RELOC (SCM_PROMPT_REGISTERS (x)->fp),
-                                 RELOC (SCM_PROMPT_REGISTERS (x)->sp),
-                                 SCM_PROMPT_REGISTERS (x)->ip,
-                                 SCM_PROMPT_ESCAPE_P (x),
-                                 vm_cookie,
-                                 newwinds);
-        newwinds = scm_cons (x, newwinds);
-      }
-    scm_dowinds (newwinds, delta);
-  }
+     We used to wind and relocate the prompts here, but that's bogus,
+     because a rewinder would then be able to abort to a prompt with a
+     stale jmpbuf.  */
+
+  return reloc;
 #undef RELOC
 }
 
diff --git a/libguile/vm.h b/libguile/vm.h
index 2479ee4a4..cf712fdd2 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -93,6 +93,7 @@ struct scm_vm_cont {
   scm_t_ptrdiff stack_size;
   SCM *stack_base;
   scm_t_ptrdiff reloc;
+  scm_t_dynstack *dynstack;
   scm_t_uint32 flags;
 };
 
@@ -107,9 +108,10 @@ SCM_INTERNAL SCM scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs);
 
 SCM_INTERNAL void scm_i_vm_print (SCM x, SCM port,
                                   scm_print_state *pstate);
-SCM_INTERNAL SCM scm_i_vm_capture_continuation (SCM vm);
+SCM_INTERNAL SCM scm_i_capture_current_stack (void);
 SCM_INTERNAL SCM scm_i_vm_capture_stack (SCM *stack_base, SCM *fp, SCM *sp,
                                          scm_t_uint8 *ra, scm_t_uint8 *mvra,
+                                         scm_t_dynstack *dynstack,
                                          scm_t_uint32 flags);
 SCM_INTERNAL void scm_i_vm_cont_print (SCM x, SCM port,
                                        scm_print_state *pstate);
author	Andy Wingo <wingo@pobox.com>	2012-03-03 17:01:16 +0100
committer	Andy Wingo <wingo@pobox.com>	2012-03-03 17:06:02 +0100
commit	9ede013f68361df731cadc62844be11d1bfea7e5 (patch)
tree	5f507a75e7aa6f932a44f1ddf98045137cd6913d
parent	05b4d9106d301af055d675cd0ffdd3699642a0ee (diff)