mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 23:00:22 +02:00
Code Activity

Refactor vm_abort

Browse source 
* libguile/vm.c (vm_abort):
* libguile/vm-i-system.c (abort): Refactor abort interface so that it is
  more amenable to the RTL VM.
This commit is contained in:
Andy Wingo 2013-10-14 17:32:16 +02:00
parent 5bd4b6585b
commit 99511cd0ab
2 changed files with 20 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1475,10 +1475,14 @@ VM_DEFINE_INSTRUCTION (88, wind, "wind", 0, 2, 0)
VM_DEFINE_INSTRUCTION (89, abort, "abort", 1, -1, -1) VM_DEFINE_INSTRUCTION (89, abort, "abort", 1, -1, -1)
{ {
unsigned n = FETCH (); ptrdiff_t n = FETCH ();
SYNC_REGISTER (); SCM tag, *stack_args, tail;
PRE_CHECK_UNDERFLOW (n + 2); PRE_CHECK_UNDERFLOW (n + 2);
vm_abort (vm, n, &registers); SYNC_REGISTER ();
tail = sp[0];
stack_args = sp - n;
tag = sp[-(n + 1)];
vm_abort (vm, tag, n, stack_args, tail, sp - (n + 2), &registers);
/* vm_abort should not return */ /* vm_abort should not return */
abort (); abort ();
} }

27
libguile/vm.c
View file

@ -273,33 +273,32 @@ vm_dispatch_hook (SCM vm, int hook_num, SCM *argv, int n)
} }
static void static void
vm_abort (SCM vm, size_t n, scm_i_jmp_buf *current_registers) SCM_NORETURN; vm_abort (SCM vm, SCM tag, size_t nstack, SCM *stack_args, SCM tail, SCM *sp,
scm_i_jmp_buf *current_registers) SCM_NORETURN;
static void static void
vm_abort (SCM vm, size_t n, scm_i_jmp_buf *current_registers) vm_abort (SCM vm, SCM tag, size_t nstack, SCM *stack_args, SCM tail, SCM *sp,
scm_i_jmp_buf *current_registers)
{ {
size_t i; size_t i;
ssize_t tail_len; ssize_t tail_len;
SCM tag, tail, *argv; SCM *argv;
/* FIXME: VM_ENABLE_STACK_NULLING */
tail = *(SCM_VM_DATA (vm)->sp--);
/* NULLSTACK (1) */
tail_len = scm_ilength (tail); tail_len = scm_ilength (tail);
if (tail_len < 0) if (tail_len < 0)
scm_misc_error ("vm-engine", "tail values to abort should be a list", scm_misc_error ("vm-engine", "tail values to abort should be a list",
scm_list_1 (tail)); scm_list_1 (tail));
tag = SCM_VM_DATA (vm)->sp[-n]; argv = alloca ((nstack + tail_len) * sizeof (SCM));
argv = alloca ((n + tail_len) * sizeof (SCM)); for (i = 0; i < nstack; i++)
for (i = 0; i < n; i++) argv[i] = stack_args[i];
argv[i] = SCM_VM_DATA (vm)->sp[-(n-1-i)]; for (; i < nstack + tail_len; i++, tail = scm_cdr (tail))
for (; i < n + tail_len; i++, tail = scm_cdr (tail))
argv[i] = scm_car (tail); argv[i] = scm_car (tail);
/* NULLSTACK (n + 1) */
SCM_VM_DATA (vm)->sp -= n + 1;
scm_c_abort (vm, tag, n + tail_len, argv, current_registers); /* FIXME: NULLSTACK (SCM_VM_DATA (vp)->sp - sp) */
SCM_VM_DATA (vm)->sp = sp;
scm_c_abort (vm, tag, nstack + tail_len, argv, current_registers);
} }
static void static void