[Guile-commits] 25/26: Optimize abort-to-prompt to avoid alloca

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit bf66fdca55f677195e7824946837e89f075bd262
Author: Andy Wingo <address@hidden>
Date:   Tue Jun 26 17:08:24 2018 +0200

    Optimize abort-to-prompt to avoid alloca
    
    * libguile/vm.c (capture_delimited_continuation): Adapt to caller not
      truncating vp->sp to vp->fp before calling.
      (abort_to_prompt): Inline vm_abort and avoid the alloca.
---
 libguile/vm.c | 61 ++++++++++++++++++++++-------------------------------------
 1 file changed, 23 insertions(+), 38 deletions(-)

diff --git a/libguile/vm.c b/libguile/vm.c
index 53d06b2..0d424ec 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -1329,8 +1329,10 @@ capture_delimited_continuation (struct scm_vm *vp,
 
   scm_dynstack_relocate_prompts (dynstack, vp->stack_top - base_fp);
 
-  /* Capture from the base_fp to the top thunk application frame. */
-  vm_cont = scm_i_vm_capture_stack (base_fp, vp->fp, vp->sp, vp->ip, dynstack,
+  /* Capture from the base_fp to the top thunk application frame.  Don't
+     capture values from the most recent frame, as they are the abort
+     args.  */
+  vm_cont = scm_i_vm_capture_stack (base_fp, vp->fp, vp->fp, vp->ip, dynstack,
                                     flags);
 
   return scm_i_make_composable_continuation (vm_cont);
@@ -1345,18 +1347,21 @@ scm_i_vm_abort (SCM *tag_and_argv, size_t n)
 }
 
 static void
-vm_abort (struct scm_vm *vp, SCM tag, size_t n, SCM *argv,
-          jmp_buf *current_registers)
+abort_to_prompt (scm_thread *thread, jmp_buf *current_registers)
 {
-  SCM cont;
-  scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
+  struct scm_vm *vp = &thread->vm;
+  scm_t_dynstack *dynstack = &thread->dynstack;
+  SCM tag, cont;
+  size_t nargs;
   scm_t_bits *prompt;
   scm_t_dynstack_prompt_flags flags;
   ptrdiff_t fp_offset, sp_offset;
   union scm_vm_stack_element *fp, *sp;
   uint32_t *ip;
   jmp_buf *registers;
-  size_t i;
+
+  tag = SCM_FRAME_LOCAL (vp->fp, 1);
+  nargs = frame_locals_count (thread) - 2;
 
   prompt = scm_dynstack_find_prompt (dynstack, tag,
                                      &flags, &fp_offset, &sp_offset, &ip,
@@ -1383,19 +1388,20 @@ vm_abort (struct scm_vm *vp, SCM tag, size_t n, SCM 
*argv,
   /* Unwind.  */
   scm_dynstack_unwind (dynstack, prompt);
 
-  /* Restore VM regs */
-  vp->fp = fp;
-  vp->sp = sp - n - 1;
-  vp->ip = ip;
+  sp = sp - nargs - 1;
 
-  /* Since we're jumping down, we should always have enough space.  */
-  if (vp->sp < vp->stack_limit)
+  /* Shuffle abort arguments down to the prompt continuation.  We have
+     to be jumping to an older part of the stack.  */
+  if (sp < vp->sp)
     abort ();
+  sp[nargs].as_scm = cont;
+  while (nargs--)
+    sp[nargs] = vp->sp[nargs];
 
-  /* Push vals */
-  vp->sp[n].as_scm = cont;
-  for (i = 0; i < n; i++)
-    vp->sp[n - i - 1].as_scm = argv[i];
+  /* Restore VM regs */
+  vp->fp = fp;
+  vp->sp = sp;
+  vp->ip = ip;
 
   /* Jump! */
   longjmp (*registers, 1);
@@ -1404,27 +1410,6 @@ vm_abort (struct scm_vm *vp, SCM tag, size_t n, SCM 
*argv,
   abort ();
 }
 
-static void
-abort_to_prompt (scm_thread *thread, jmp_buf *current_registers)
-{
-  struct scm_vm *vp = &thread->vm;
-  SCM tag;
-  size_t nargs, i;
-  SCM *argv;
-
-  tag = SCM_FRAME_LOCAL (vp->fp, 1);
-  nargs = frame_locals_count (thread) - 2;
-
-  /* FIXME: Avoid this alloca.  */
-  argv = alloca (nargs * sizeof (SCM));
-  for (i = 0; i < nargs; i++)
-    argv[i] = vp->sp[nargs - i - 1].as_scm;
-
-  vp->sp = vp->fp;
-
-  vm_abort (vp, tag, nargs, argv, current_registers);
-}
-
 SCM
 scm_call_n (SCM proc, SCM *argv, size_t nargs)
 {