diff options
author | Andy Wingo <wingo@pobox.com> | 2012-03-07 10:27:16 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-03-07 10:27:16 +0100 |
commit | 9d381ba4788b4d447acd3238c2fc8b86da4998b2 (patch) | |
tree | 5fd37ed1b9d73a20dbfadce6c4681bba8f05c75e | |
parent | 3c12fc359561aedb179a524667ba03481333f482 (diff) | |
download | guile-9d381ba4788b4d447acd3238c2fc8b86da4998b2.tar.gz |
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.
-rw-r--r-- | libguile/control.c | 54 | ||||
-rw-r--r-- | libguile/control.h | 17 | ||||
-rw-r--r-- | libguile/dynstack.c | 62 | ||||
-rw-r--r-- | libguile/dynstack.h | 22 | ||||
-rw-r--r-- | libguile/eval.c | 19 | ||||
-rw-r--r-- | libguile/stacks.c | 6 | ||||
-rw-r--r-- | libguile/throw.c | 23 | ||||
-rw-r--r-- | libguile/vm-engine.c | 21 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 65 | ||||
-rw-r--r-- | libguile/vm.c | 44 | ||||
-rw-r--r-- | libguile/vm.h | 1 |
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, ®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 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, + ®isters); + + 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, - ®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 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, + ®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 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 (¤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 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; |