void
scm_c_abort (struct scm_vm *vp, 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_dynstack_prompt_flags flags;
scm_t_ptrdiff fp_offset, sp_offset;
union scm_vm_stack_element *fp, *sp;
scm_t_uint32 *ip;
scm_i_jmp_buf *registers;
size_t i;
prompt = scm_dynstack_find_prompt (dynstack, tag,
&flags, &fp_offset, &sp_offset, &ip,
®isters);
if (!prompt)
scm_misc_error ("abort", "Abort to unknown prompt", scm_list_1 (tag));
fp = vp->stack_top - fp_offset;
sp = vp->stack_top - sp_offset;
/* 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;
captured = scm_dynstack_capture (dynstack, SCM_DYNSTACK_NEXT (prompt));
cont = reify_partial_continuation (vp, fp, sp, ip, registers, captured,
current_registers);
}
/* Unwind. */
scm_dynstack_unwind (dynstack, prompt);
/* Restore VM regs */
vp->fp = fp;
vp->sp = sp - n - 1;
vp->ip = ip;
/* Since we're jumping down, we should always have enough space. */
if (vp->sp < vp->stack_limit)
abort ();
/* Push vals */
vp->sp[n].as_scm = cont;
for (i = 0; i < n; i++)
vp->sp[n - i - 1].as_scm = argv[i];
/* Jump! */
SCM_I_LONGJMP (*registers, 1);
/* Shouldn't get here */
abort ();
}
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;
}
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);
}
