mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

dynstack: pushing a prompt no longer allocates memory

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2012-03-07 10:27:16 +01:00
parent 3c12fc3595
commit 9d381ba478
11 changed files with 148 additions and 178 deletions
Download patch file Download diff file Expand all files Collapse all files

54
libguile/control.c
View file

@ -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...

17
libguile/control.h
View file

@ -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;

62
libguile/dynstack.c
View file

@ -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

22
libguile/dynstack.h
View file

@ -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 */

17
libguile/eval.c
View file

@ -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);
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 (regs->regs))
if (SCM_I_SETJMP (registers))
{
/* The prompt exited nonlocally. */
proc = handler;

6
libguile/stacks.c
View file

@ -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

21
libguile/throw.c
View file

@ -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);
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 (regs->regs))
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;

21
libguile/vm-engine.c
View file

@ -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;

65
libguile/vm-i-system.c
View file

@ -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 ();
}

40
libguile/vm.c
View file

@ -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.
/* 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;
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. */
for (walk = SCM_DYNSTACK_FIRST (cp->dynstack);
SCM_DYNSTACK_TAG (walk);
walk = SCM_DYNSTACK_NEXT (walk))
{
scm_t_bits tag = SCM_DYNSTACK_TAG (walk);
return reloc;
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

1
libguile/vm.h
View file

@ -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;