summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/control.c54
-rw-r--r--libguile/control.h17
-rw-r--r--libguile/dynstack.c62
-rw-r--r--libguile/dynstack.h22
-rw-r--r--libguile/eval.c19
-rw-r--r--libguile/stacks.c6
-rw-r--r--libguile/throw.c23
-rw-r--r--libguile/vm-engine.c21
-rw-r--r--libguile/vm-i-system.c65
-rw-r--r--libguile/vm.c44
-rw-r--r--libguile/vm.h1
11 files changed, 152 insertions, 182 deletions
diff --git a/libguile/control.c b/libguile/control.c
index 613ffbe4c..54c1cd3f4 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -37,21 +37,6 @@
-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;
- regs->sp = sp;
- regs->ip = abort_ip;
- regs->cookie = vm_cookie;
-
- return regs;
-}
-
/* Only to be called if the SCM_I_SETJMP returns 1 */
SCM
scm_i_prompt_pop_abort_args_x (SCM vm)
@@ -137,26 +122,32 @@ SCM_STATIC_OBJCODE (cont_objcode) = {
static SCM
-reify_partial_continuation (SCM vm, scm_t_prompt_registers *regs,
+reify_partial_continuation (SCM vm,
+ SCM *saved_fp, SCM *saved_sp, scm_t_uint8 *saved_ip,
+ scm_i_jmp_buf *saved_registers,
scm_t_dynstack *dynstack,
- scm_t_int64 cookie)
+ scm_i_jmp_buf *current_registers)
{
SCM vm_cont, ret;
scm_t_uint32 flags;
flags = SCM_F_VM_CONT_PARTIAL;
- if (cookie >= 0 && regs->cookie == cookie)
+ /* If we are aborting to a prompt that has the same registers as those
+ of the abort, it means there are no intervening C frames on the
+ stack, and so the continuation can be relocated elsewhere on the
+ stack: it is rewindable. */
+ if (saved_registers && saved_registers == current_registers)
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 (regs->sp[1]) != regs->fp)
+ if ((SCM*)SCM_UNPACK (saved_sp[1]) != saved_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 (regs->sp + 4,
+ vm_cont = scm_i_vm_capture_stack (saved_sp + 4,
SCM_VM_DATA (vm)->fp,
SCM_VM_DATA (vm)->sp,
NULL,
@@ -173,16 +164,20 @@ reify_partial_continuation (SCM vm, scm_t_prompt_registers *regs,
}
void
-scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv, scm_t_int64 cookie)
+scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv,
+ scm_i_jmp_buf *current_registers)
{
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;
+ SCM *fp, *sp;
+ scm_t_uint8 *ip;
+ scm_i_jmp_buf *registers;
size_t i;
- prompt = scm_dynstack_find_prompt (dynstack, tag, &regs, &flags);
+ prompt = scm_dynstack_find_prompt (dynstack, tag,
+ &flags, &fp, &sp, &ip, &registers);
if (!prompt)
scm_misc_error ("abort", "Abort to unknown prompt", scm_list_1 (tag));
@@ -195,7 +190,8 @@ scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv, scm_t_int64 cookie)
scm_t_dynstack *captured;
captured = scm_dynstack_capture (dynstack, SCM_DYNSTACK_NEXT (prompt));
- cont = reify_partial_continuation (vm, regs, captured, cookie);
+ cont = reify_partial_continuation (vm, fp, sp, ip, registers, captured,
+ current_registers);
}
/* Unwind. */
@@ -206,9 +202,9 @@ scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv, scm_t_int64 cookie)
vm = scm_the_vm ();
/* Restore VM regs */
- SCM_VM_DATA (vm)->fp = regs->fp;
- SCM_VM_DATA (vm)->sp = regs->sp;
- SCM_VM_DATA (vm)->ip = regs->ip;
+ SCM_VM_DATA (vm)->fp = fp;
+ SCM_VM_DATA (vm)->sp = sp;
+ SCM_VM_DATA (vm)->ip = ip;
/* 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)
@@ -221,7 +217,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 (regs->regs, 1);
+ SCM_I_LONGJMP (*registers, 1);
/* Shouldn't get here */
abort ();
@@ -240,7 +236,7 @@ SCM_DEFINE (scm_at_abort, "@abort", 2, 0, 0, (SCM tag, SCM args),
for (i = 0; i < n; i++, args = scm_cdr (args))
argv[i] = scm_car (args);
- scm_c_abort (scm_the_vm (), tag, n, argv, -1);
+ scm_c_abort (scm_the_vm (), tag, n, argv, NULL);
/* Oh, what, you're still here? The abort must have been reinstated. Actually,
that's quite impossible, given that we're already in C-land here, so...
diff --git a/libguile/control.h b/libguile/control.h
index a91285588..470919472 100644
--- a/libguile/control.h
+++ b/libguile/control.h
@@ -20,25 +20,10 @@
#define SCM_CONTROL_H
-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_i_prompt_pop_abort_args_x (SCM vm);
SCM_INTERNAL void scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv,
- scm_t_int64 cookie) SCM_NORETURN;
+ scm_i_jmp_buf *registers) SCM_NORETURN;
SCM_INTERNAL SCM scm_at_abort (SCM tag, SCM args) SCM_NORETURN;
diff --git a/libguile/dynstack.c b/libguile/dynstack.c
index 56e007c1f..ce9a2feae 100644
--- a/libguile/dynstack.c
+++ b/libguile/dynstack.c
@@ -34,9 +34,12 @@
-#define PROMPT_WORDS 2
+#define PROMPT_WORDS 5
#define PROMPT_KEY(top) (SCM_PACK ((top)[0]))
-#define PROMPT_REGS(top) ((scm_t_prompt_registers*) ((top)[1]))
+#define PROMPT_FP(top) ((SCM *) ((top)[1]))
+#define PROMPT_SP(top) ((SCM *) ((top)[2]))
+#define PROMPT_IP(top) ((scm_t_uint8 *) ((top)[3]))
+#define PROMPT_JMPBUF(top) ((scm_i_jmp_buf *) ((top)[4]))
#define WINDER_WORDS 2
#define WINDER_PROC(top) ((scm_t_guard) ((top)[0]))
@@ -188,13 +191,19 @@ scm_dynstack_push_fluids (scm_t_dynstack *dynstack, size_t n,
void
scm_dynstack_push_prompt (scm_t_dynstack *dynstack,
scm_t_dynstack_prompt_flags flags,
- SCM key, scm_t_prompt_registers *regs)
+ SCM key,
+ SCM *fp, SCM *sp, scm_t_uint8 *ip,
+ scm_i_jmp_buf *registers)
{
scm_t_bits *words;
- words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_PROMPT, flags, 2);
+ words = push_dynstack_entry (dynstack, SCM_DYNSTACK_TYPE_PROMPT, flags,
+ PROMPT_WORDS);
words[0] = SCM_UNPACK (key);
- words[1] = (scm_t_bits) regs;
+ words[1] = (scm_t_bits) fp;
+ words[2] = (scm_t_bits) sp;
+ words[3] = (scm_t_bits) ip;
+ words[4] = (scm_t_bits) registers;
}
void
@@ -439,8 +448,9 @@ scm_dynstack_unwind_fork (scm_t_dynstack *dynstack, scm_t_dynstack *branch)
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_dynstack_prompt_flags *flags,
+ SCM **fp, SCM **sp, scm_t_uint8 **ip,
+ scm_i_jmp_buf **registers)
{
scm_t_bits *walk;
@@ -452,10 +462,16 @@ scm_dynstack_find_prompt (scm_t_dynstack *dynstack, SCM key,
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);
+ if (fp)
+ *fp = PROMPT_FP (walk);
+ if (sp)
+ *sp = PROMPT_SP (walk);
+ if (ip)
+ *ip = PROMPT_IP (walk);
+ if (registers)
+ *registers = PROMPT_JMPBUF (walk);
return walk;
}
}
@@ -463,26 +479,22 @@ scm_dynstack_find_prompt (scm_t_dynstack *dynstack, SCM key,
return NULL;
}
-scm_t_prompt_registers*
-scm_dynstack_relocate_prompt (scm_t_dynstack *dynstack, scm_t_ptrdiff reloc,
- scm_t_uint64 vm_cookie)
+void
+scm_dynstack_wind_prompt (scm_t_dynstack *dynstack, scm_t_bits *item,
+ scm_t_ptrdiff reloc, scm_i_jmp_buf *registers)
{
- scm_t_bits *item;
- scm_t_prompt_registers *prev, *rewound;
+ scm_t_bits tag = SCM_DYNSTACK_TAG (item);
- item = SCM_DYNSTACK_PREV (dynstack->top);
- if (SCM_DYNSTACK_TAG_TYPE (SCM_DYNSTACK_TAG (item))
- != SCM_DYNSTACK_TYPE_PROMPT)
+ if (SCM_DYNSTACK_TAG_TYPE (tag) != 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;
+ scm_dynstack_push_prompt (dynstack,
+ SCM_DYNSTACK_TAG_FLAGS (tag),
+ PROMPT_KEY (item),
+ PROMPT_FP (item) + reloc,
+ PROMPT_SP (item) + reloc,
+ PROMPT_IP (item),
+ registers);
}
void
diff --git a/libguile/dynstack.h b/libguile/dynstack.h
index 33389cad7..207638ec7 100644
--- a/libguile/dynstack.h
+++ b/libguile/dynstack.h
@@ -156,7 +156,8 @@ SCM_INTERNAL void scm_dynstack_push_fluids (scm_t_dynstack *,
SCM_INTERNAL void scm_dynstack_push_prompt (scm_t_dynstack *,
scm_t_dynstack_prompt_flags,
SCM key,
- scm_t_prompt_registers *);
+ SCM *fp, SCM *sp, scm_t_uint8 *ip,
+ scm_i_jmp_buf *registers);
SCM_INTERNAL void scm_dynstack_push_dynwind (scm_t_dynstack *,
SCM enter, SCM leave);
@@ -177,6 +178,11 @@ 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 *);
+
+
+
+/* Miscellany. */
+
SCM_INTERNAL scm_t_bits* scm_dynstack_unwind_fork (scm_t_dynstack *,
scm_t_dynstack *);
@@ -184,17 +190,13 @@ 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_t_dynstack_prompt_flags *,
+ SCM **, SCM **, scm_t_uint8 **,
+ scm_i_jmp_buf **);
-SCM_INTERNAL scm_t_prompt_registers*
-scm_dynstack_relocate_prompt (scm_t_dynstack *, scm_t_ptrdiff, scm_t_uint64);
+SCM_INTERNAL void scm_dynstack_wind_prompt (scm_t_dynstack *, scm_t_bits *,
+ scm_t_ptrdiff, scm_i_jmp_buf *);
#endif /* SCM_DYNSTACK_H */
diff --git a/libguile/eval.c b/libguile/eval.c
index 142d20abf..d7ab5627f 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -438,8 +438,7 @@ eval (SCM x, SCM env)
case SCM_M_PROMPT:
{
SCM vm, k, res;
- scm_t_dynstack_prompt_flags flags;
- scm_t_prompt_registers *regs;
+ scm_i_jmp_buf registers;
/* We need the handler after nonlocal return to the setjmp, so
make sure it is volatile. */
volatile SCM handler;
@@ -449,15 +448,15 @@ eval (SCM x, SCM env)
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_I_SETJMP (regs->regs))
+ SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY,
+ k,
+ SCM_VM_DATA (vm)->fp,
+ SCM_VM_DATA (vm)->sp,
+ SCM_VM_DATA (vm)->ip,
+ &registers);
+
+ if (SCM_I_SETJMP (registers))
{
/* The prompt exited nonlocally. */
proc = handler;
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 610a36e24..13d347a95 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -98,14 +98,14 @@ stack_depth (SCM frame)
static SCM*
find_prompt (SCM key)
{
- scm_t_prompt_registers *regs;
+ SCM *fp;
if (!scm_dynstack_find_prompt (&SCM_I_CURRENT_THREAD->dynstack, key,
- &regs, NULL))
+ NULL, &fp, NULL, NULL, NULL))
scm_misc_error ("make-stack", "Prompt tag not found while narrowing stack",
scm_list_1 (key));
- return regs->fp;
+ return fp;
}
static void
diff --git a/libguile/throw.c b/libguile/throw.c
index 2f5c71225..ae131d0ad 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -458,9 +458,8 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
{
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;
+ scm_i_jmp_buf registers;
/* Only handle catch-alls without pre-unwind handlers */
if (!SCM_UNBNDP (pre_unwind_handler))
@@ -474,14 +473,15 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
v_handler = handler;
/* 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))
+ scm_dynstack_push_prompt (dynstack,
+ SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY,
+ sym_pre_init_catch_tag,
+ SCM_VM_DATA (vm)->fp,
+ SCM_VM_DATA (vm)->sp,
+ SCM_VM_DATA (vm)->ip,
+ &registers);
+
+ if (SCM_I_SETJMP (registers))
{
/* nonlocal exit */
SCM args = scm_i_prompt_pop_abort_args_x (vm);
@@ -499,7 +499,8 @@ static int
find_pre_init_catch (void)
{
if (scm_dynstack_find_prompt (&SCM_I_CURRENT_THREAD->dynstack,
- sym_pre_init_catch_tag, NULL, NULL))
+ sym_pre_init_catch_tag,
+ NULL, NULL, NULL, NULL, NULL))
return 1;
return 0;
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 8bc37a9fd..1d16ec431 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -53,13 +53,14 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
SCM *stack_limit = vp->stack_limit; /* stack limit address */
scm_i_thread *current_thread = SCM_I_CURRENT_THREAD;
- scm_t_int64 vm_cookie = vp->cookie++;
/* Internal variables */
int nvalues = 0;
const char *func_name = NULL; /* used for error reporting */
SCM finish_args; /* used both for returns: both in error
and normal situations */
+ scm_i_jmp_buf registers; /* used for prompts */
+
#ifdef HAVE_LABELS_AS_VALUES
static const void **jump_table_pointer = NULL;
#endif
@@ -88,6 +89,24 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
jump_table = jump_table_pointer;
#endif
+ if (SCM_I_SETJMP (registers))
+ {
+ /* Non-local return. Cache the VM registers back from the vp, and
+ go to the handler.
+
+ Note, at this point, we must assume that any variable local to
+ vm_engine that can be assigned *has* been assigned. So we need to pull
+ all our state back from the ip/fp/sp.
+ */
+ CACHE_REGISTER ();
+ program = SCM_FRAME_PROGRAM (fp);
+ CACHE_PROGRAM ();
+ /* The stack contains the values returned to this continuation,
+ along with a number-of-values marker -- like an MV return. */
+ ABORT_CONTINUATION_HOOK ();
+ NEXT;
+ }
+
/* Initialization */
{
SCM prog = program;
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 114b4224f..bad4c3020 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -1046,47 +1046,15 @@ VM_DEFINE_INSTRUCTION (60, continuation_call, "continuation-call", 0, -1, 0)
VM_DEFINE_INSTRUCTION (61, partial_cont_call, "partial-cont-call", 0, -1, 0)
{
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;
}
- reloc = vm_reinstate_partial_continuation (vm, vmcont, sp + 1 - fp, fp,
- vm_cookie);
-
- /* 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_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;
- }
- }
- }
+ vm_reinstate_partial_continuation (vm, vmcont, sp + 1 - fp, fp,
+ &current_thread->dynstack,
+ &registers);
CACHE_REGISTER ();
program = SCM_FRAME_PROGRAM (fp);
@@ -1588,7 +1556,6 @@ VM_DEFINE_INSTRUCTION (87, prompt, "prompt", 4, 2, 0)
scm_t_uint8 escape_only_p;
SCM k;
scm_t_dynstack_prompt_flags flags;
- scm_t_prompt_registers *regs;
escape_only_p = FETCH ();
FETCH_OFFSET (offset);
@@ -1596,29 +1563,9 @@ VM_DEFINE_INSTRUCTION (87, prompt, "prompt", 4, 2, 0)
SYNC_REGISTER ();
/* Push the prompt onto the dynamic stack. */
- 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.
-
- Note, at this point, we must assume that any variable local to
- vm_engine that can be assigned *has* been assigned. So we need to pull
- all our state back from the ip/fp/sp.
- */
- CACHE_REGISTER ();
- program = SCM_FRAME_PROGRAM (fp);
- CACHE_PROGRAM ();
- /* The stack contains the values returned to this prompt, along
- with a number-of-values marker -- like an MV return. */
- ABORT_CONTINUATION_HOOK ();
- NEXT;
- }
-
- /* Otherwise setjmp returned for the first time, so we go to execute the
- prompt's body. */
+ scm_dynstack_push_prompt (&current_thread->dynstack, flags, k,
+ fp, sp, ip + offset, &registers);
NEXT;
}
@@ -1642,7 +1589,7 @@ VM_DEFINE_INSTRUCTION (89, abort, "abort", 1, -1, -1)
SYNC_REGISTER ();
if (sp - n - 2 <= SCM_FRAME_UPPER_ADDRESS (fp))
goto vm_error_stack_underflow;
- vm_abort (vm, n, vm_cookie);
+ vm_abort (vm, n, &registers);
/* vm_abort should not return */
abort ();
}
diff --git a/libguile/vm.c b/libguile/vm.c
index a283857f0..4d32c9545 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -247,9 +247,11 @@ vm_dispatch_hook (SCM vm, int hook_num)
vp->trace_level = saved_trace_level;
}
-static void vm_abort (SCM vm, size_t n, scm_t_int64 cookie) SCM_NORETURN;
static void
-vm_abort (SCM vm, size_t n, scm_t_int64 vm_cookie)
+vm_abort (SCM vm, size_t n, scm_i_jmp_buf *current_registers) SCM_NORETURN;
+
+static void
+vm_abort (SCM vm, size_t n, scm_i_jmp_buf *current_registers)
{
size_t i;
ssize_t tail_len;
@@ -272,12 +274,13 @@ vm_abort (SCM vm, size_t n, scm_t_int64 vm_cookie)
/* NULLSTACK (n + 1) */
SCM_VM_DATA (vm)->sp -= n + 1;
- scm_c_abort (vm, tag, n + tail_len, argv, vm_cookie);
+ scm_c_abort (vm, tag, n + tail_len, argv, current_registers);
}
-static scm_t_ptrdiff
-vm_reinstate_partial_continuation (SCM vm, SCM cont,
- size_t n, SCM *argv, scm_t_int64 vm_cookie)
+static void
+vm_reinstate_partial_continuation (SCM vm, SCM cont, size_t n, SCM *argv,
+ scm_t_dynstack *dynstack,
+ scm_i_jmp_buf *registers)
{
struct scm_vm *vp;
struct scm_vm_cont *cp;
@@ -325,16 +328,24 @@ vm_reinstate_partial_continuation (SCM vm, SCM cont,
vp->sp++;
*vp->sp = scm_from_size_t (n);
- /* 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 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;
+ /* The prompt captured a slice of the dynamic stack. Here we wind
+ those entries onto the current thread's stack. We also have to
+ relocate any prompts that we see along the way. */
+ {
+ scm_t_bits *walk;
+
+ for (walk = SCM_DYNSTACK_FIRST (cp->dynstack);
+ SCM_DYNSTACK_TAG (walk);
+ walk = SCM_DYNSTACK_NEXT (walk))
+ {
+ scm_t_bits tag = SCM_DYNSTACK_TAG (walk);
+
+ if (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_PROMPT)
+ scm_dynstack_wind_prompt (dynstack, walk, reloc, registers);
+ else
+ scm_dynstack_wind_1 (dynstack, walk);
+ }
+ }
#undef RELOC
}
@@ -522,7 +533,6 @@ make_vm (void)
vp->trace_level = 0;
for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
vp->hooks[i] = SCM_BOOL_F;
- vp->cookie = 0;
return scm_cell (scm_tc7_vm, (scm_t_bits)vp);
}
#undef FUNC_NAME
diff --git a/libguile/vm.h b/libguile/vm.h
index cf712fdd2..c45d17f10 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -50,7 +50,6 @@ struct scm_vm {
int engine; /* which vm engine we're using */
SCM hooks[SCM_VM_NUM_HOOKS]; /* hooks */
int trace_level; /* traces enabled if trace_level > 0 */
- scm_t_int64 cookie; /* used to detect unrewindable continuations */
};
SCM_API SCM scm_the_vm_fluid;