Exemple #1
0
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,
                                     &registers);

  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 ();
}
Exemple #2
0
scm_t_dynstack *
scm_dynstack_capture_all (scm_t_dynstack *dynstack)
{
  return scm_dynstack_capture (dynstack, SCM_DYNSTACK_FIRST (dynstack));
}