[Guile-commits] 24/26: Refactors to abort-to-prompt implementation

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 770360e06645528ede0595f7efb553e7e0ac3bfd
Author: Andy Wingo <address@hidden>
Date:   Tue Jun 26 16:39:34 2018 +0200

    Refactors to abort-to-prompt implementation
    
    * libguile/control.c (scm_abort_to_prompt_star)
    * libguile/throw.c (abort_to_prompt): Pass prompt tag and argv in one
      array.
    * libguile/vm.c (scm_i_vm_abort): Reimplement as a call into the VM's
      abort_to_prompt builtin.
      (vm_abort): New helper, a copy of scm_i_vm_abort.  Will allow us to
      avoid some arg shuffling when aborting from the VM.
    * libguile/vm.h: Remove setjmp include and simplify scm_i_vm_abort
      decl.
---
 libguile/control.c | 12 +++++++-----
 libguile/throw.c   | 15 ++++++++-------
 libguile/vm.c      | 14 +++++++++++---
 libguile/vm.h      |  5 +----
 4 files changed, 27 insertions(+), 19 deletions(-)

diff --git a/libguile/control.c b/libguile/control.c
index 38378ae..3068f6a 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -94,16 +94,18 @@ SCM_DEFINE (scm_abort_to_prompt_star, "abort-to-prompt*", 
2, 0, 0,
             "values in the list, @var{args}.")
 #define FUNC_NAME s_scm_abort_to_prompt_star
 {
-  SCM *argv;
+  SCM *tag_and_argv;
   size_t i;
   long n;
 
   SCM_VALIDATE_LIST_COPYLEN (SCM_ARG2, args, n);
-  argv = alloca (sizeof (SCM)*n);
-  for (i = 0; i < n; i++, args = scm_cdr (args))
-    argv[i] = scm_car (args);
+  n = n + 1; /* Add space for the tag.  */
+  tag_and_argv = alloca (sizeof (SCM)*(n+1));
+  tag_and_argv[0] = tag;
+  for (i = 1; i < n; i++, args = scm_cdr (args))
+    tag_and_argv[i] = scm_car (args);
 
-  scm_i_vm_abort (&SCM_I_CURRENT_THREAD->vm, tag, n, argv, NULL);
+  scm_i_vm_abort (tag_and_argv, n);
 
   /* 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...
diff --git a/libguile/throw.c b/libguile/throw.c
index 7372ccb..8a6f0f8 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -185,17 +185,18 @@ default_exception_handler (SCM k, SCM args)
 static void
 abort_to_prompt (SCM prompt_tag, SCM tag, SCM args)
 {
-  SCM *argv;
+  SCM *tag_and_argv;
   size_t i;
   long n;
 
-  n = scm_ilength (args) + 1;
-  argv = alloca (sizeof (SCM)*n);
-  argv[0] = tag;
-  for (i = 1; i < n; i++, args = scm_cdr (args))
-    argv[i] = scm_car (args);
+  n = scm_ilength (args) + 2;
+  tag_and_argv = alloca (sizeof (SCM)*n);
+  tag_and_argv[0] = prompt_tag;
+  tag_and_argv[1] = tag;
+  for (i = 2; i < n; i++, args = scm_cdr (args))
+    tag_and_argv[i] = scm_car (args);
 
-  scm_i_vm_abort (&SCM_I_CURRENT_THREAD->vm, prompt_tag, n, argv, NULL);
+  scm_i_vm_abort (tag_and_argv, n);
 
   /* 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...
diff --git a/libguile/vm.c b/libguile/vm.c
index 29f33e2..53d06b2 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -1337,8 +1337,16 @@ capture_delimited_continuation (struct scm_vm *vp,
 }
 
 void
-scm_i_vm_abort (struct scm_vm *vp, SCM tag, size_t n, SCM *argv,
-                jmp_buf *current_registers)
+scm_i_vm_abort (SCM *tag_and_argv, size_t n)
+{
+  scm_call_n (vm_builtin_abort_to_prompt, tag_and_argv, n);
+  /* Unreachable.  */
+  abort ();
+}
+
+static void
+vm_abort (struct scm_vm *vp, SCM tag, size_t n, SCM *argv,
+          jmp_buf *current_registers)
 {
   SCM cont;
   scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
@@ -1414,7 +1422,7 @@ abort_to_prompt (scm_thread *thread, jmp_buf 
*current_registers)
 
   vp->sp = vp->fp;
 
-  scm_i_vm_abort (vp, tag, nargs, argv, current_registers);
+  vm_abort (vp, tag, nargs, argv, current_registers);
 }
 
 SCM
diff --git a/libguile/vm.h b/libguile/vm.h
index 7d4f342..cf777a6 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -20,8 +20,6 @@
 #ifndef _SCM_VM_H_
 #define _SCM_VM_H_
 
-#include <setjmp.h>
-
 #include <libguile/gc.h>
 #include <libguile/programs.h>
 
@@ -122,8 +120,7 @@ SCM_INTERNAL SCM scm_i_vm_capture_stack (union 
scm_vm_stack_element *stack_top,
                                          uint32_t *ra,
                                          scm_t_dynstack *dynstack,
                                          uint32_t flags);
-SCM_INTERNAL void scm_i_vm_abort (struct scm_vm *vp, SCM tag, size_t n, SCM 
*argv,
-                                  jmp_buf *registers) SCM_NORETURN;
+SCM_INTERNAL void scm_i_vm_abort (SCM *tag_and_argv, size_t n) SCM_NORETURN;
 SCM_INTERNAL int scm_i_vm_cont_to_frame (SCM cont, struct scm_frame *frame);
 SCM_INTERNAL void scm_i_vm_cont_print (SCM x, SCM port,
                                        scm_print_state *pstate);