[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-159-g9d381ba
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-159-g9d381ba |
|
Date: |
Wed, 07 Mar 2012 09:28:56 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=9d381ba4788b4d447acd3238c2fc8b86da4998b2
The branch, master has been updated
via 9d381ba4788b4d447acd3238c2fc8b86da4998b2 (commit)
from 3c12fc359561aedb179a524667ba03481333f482 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 9d381ba4788b4d447acd3238c2fc8b86da4998b2
Author: Andy Wingo <address@hidden>
Date: Wed Mar 7 10:27:16 2012 +0100
dynstack: pushing a prompt no longer allocates memory
* libguile/control.h: Remove scm_t_prompt_registers and
scm_c_make_prompt_registers.
(scm_c_abort): Take a pointer to a jmpbuf instead of a cookie. It
will serve the same purpose.
* libguile/control.c (reify_partial_continuation, scm_at_abort): Adapt
to new prompt representation.
* libguile/dynstack.h:
* libguile/dynstack.c (scm_dynstack_push_prompt): Prompts now have 5
words instead of 2, as they now push the fp, sp, ip, and jmpbuf on the
stack separately. This avoids allocation.
(scm_dynstack_find_prompt): Likewise, add return values for fp, sp,
etc.
(scm_dynstack_wind_prompt): Replaces scm_dynstack_relocate_prompt.
* libguile/eval.c (eval):
* libguile/stacks.c (find_prompt):
* libguile/throw.c (pre_init_catch): Adapt to the new prompt mechanism.
* libguile/vm-engine.c (vm_engine): Setjmp an on-stack jmpbuf every time
the VM enters. We can then re-use that jmpbuf for all prompts in that
invocation.
* libguile/vm-i-system.c (partial_cont_call): Adapt to change in prompt
representation. We don't need to wind here any more, since we pass in
the prompt's jmpbuf.
(prompt): Adapt to scm_dynstack_push_prompt change.
(abort): Adapt to vm_abort change.
* libguile/vm.h (struct scm_vm): No more cookie.
* libguile/vm.c (vm_abort): Adapt to scm_c_abort change.
(vm_reinstate_partial_continuation): Rewind the dynamic stack here,
now that we do have a valid jmpbuf.
(make_vm): No need to initialize a cookie.
-----------------------------------------------------------------------
Summary of changes:
libguile/control.c | 54 ++++++++++++++++++---------------------
libguile/control.h | 17 +------------
libguile/dynstack.c | 62 +++++++++++++++++++++++++++------------------
libguile/dynstack.h | 22 +++++++++-------
libguile/eval.c | 19 ++++++-------
libguile/stacks.c | 6 ++--
libguile/throw.c | 23 +++++++++--------
libguile/vm-engine.c | 21 ++++++++++++++-
libguile/vm-i-system.c | 65 ++++-------------------------------------------
libguile/vm.c | 44 ++++++++++++++++++++------------
libguile/vm.h | 1 -
11 files changed, 152 insertions(+), 182 deletions(-)
diff --git a/libguile/control.c b/libguile/control.c
index 613ffbe..54c1cd3 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, ®s, &flags);
+ prompt = scm_dynstack_find_prompt (dynstack, tag,
+ &flags, &fp, &sp, &ip, ®isters);
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 a912855..4709194 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 56e007c..ce9a2fe 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 33389ca..207638e 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 142d20a..d7ab562 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,
+ ®isters);
+
+ if (SCM_I_SETJMP (registers))
{
/* The prompt exited nonlocally. */
proc = handler;
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 610a36e..13d347a 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,
- ®s, 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 2f5c712..ae131d0 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,
+ ®isters);
+
+ 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 8bc37a9..1d16ec4 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 114b422..bad4c30 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 (¤t_thread->dynstack, walk);
-
- if (SCM_DYNSTACK_TAG_TYPE (tag) == SCM_DYNSTACK_TYPE_PROMPT)
- {
- scm_t_prompt_registers *rewound;
-
- rewound = scm_dynstack_relocate_prompt (¤t_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,
+ ¤t_thread->dynstack,
+ ®isters);
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 (¤t_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 (¤t_thread->dynstack, flags, k,
+ fp, sp, ip + offset, ®isters);
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, ®isters);
/* vm_abort should not return */
abort ();
}
diff --git a/libguile/vm.c b/libguile/vm.c
index a283857..4d32c95 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 cf712fd..c45d17f 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;
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-159-g9d381ba,
Andy Wingo <=