[Guile-commits] 16/26: Reinstating undelimited continuations uses intrinsic

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 5e8e816c61f99ef1d96ad186d949659bf3aa8853
Author: Andy Wingo <address@hidden>
Date:   Tue Jun 26 10:57:23 2018 +0200

    Reinstating undelimited continuations uses intrinsic
    
    * libguile/continuations.h (scm_t_contregs): Remove "struct vm*" member;
      unneeded.
    * libguile/continuations.c (scm_i_make_continuation): No need to store
      continuation->vp.
      (scm_i_contregs): New internal function, replaces scm_i_contregs_vp
      and scm_i_contregs_vm_cont.
      (scm_i_check_continuation): Remove; moved to vm.c.
      (scm_i_reinstate_continuation): Add an abort(), to satisfy
      SCM_NORETURN.
    * libguile/intrinsics.h: Add new "reinstate-continuation!" intrinsic.
    * libguile/vm-engine.c (continuation-call): Use new
      reinstate-continuation! intrinsic.
    * libguile/vm.c (vm_return_to_continuation_inner): Move later in the
      file.
      (reinstate_continuation_x): New intrinsic.
      (scm_bootstrap_vm): Init new intrinsic.
---
 libguile/continuations.c |  29 +++--------
 libguile/continuations.h |   8 +--
 libguile/intrinsics.h    |   2 +
 libguile/vm-engine.c     |   9 +---
 libguile/vm.c            | 128 ++++++++++++++++++++++++++---------------------
 5 files changed, 83 insertions(+), 93 deletions(-)

diff --git a/libguile/continuations.c b/libguile/continuations.c
index 6446a56..c99e0eb 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -193,7 +193,6 @@ scm_i_make_continuation (int *first, struct scm_vm *vp, SCM 
vm_cont)
 #endif
   continuation->offset = continuation->stack - src;
   memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size);
-  continuation->vp = vp;
   continuation->vm_cont = vm_cont;
   saved_cookie = vp->resumable_prompt_cookie;
   capture_auxiliary_stack (thread, continuation);
@@ -236,16 +235,13 @@ scm_i_continuation_to_frame (SCM continuation, struct 
scm_frame *frame)
     return 0;
 }
 
-struct scm_vm *
-scm_i_contregs_vp (SCM contregs)
+scm_t_contregs *
+scm_i_contregs (SCM contregs)
 {
-  return SCM_CONTREGS (contregs)->vp;
-}
+  if (!SCM_CONTREGSP (contregs))
+    abort ();
 
-SCM
-scm_i_contregs_vm_cont (SCM contregs)
-{
-  return SCM_CONTREGS (contregs)->vm_cont;
+  return SCM_CONTREGS (contregs);
 }
 
 
@@ -336,24 +332,11 @@ scm_dynthrow (SCM cont)
   copy_stack_and_call (continuation, dst);
 }
 
-
-void
-scm_i_check_continuation (SCM cont)
-{
-  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
-  scm_t_contregs *continuation = SCM_CONTREGS (cont);
-
-  if (!scm_is_eq (continuation->root, thread->continuation_root))
-    scm_misc_error
-      ("%continuation-call", 
-       "invoking continuation would cross continuation barrier: ~A",
-       scm_list_1 (cont));
-}
-
 void
 scm_i_reinstate_continuation (SCM cont)
 {
   scm_dynthrow (cont);
+  abort (); /* Unreachable.  */
 }
 
 SCM
diff --git a/libguile/continuations.h b/libguile/continuations.h
index a9ab5ea..6b52f26 100644
--- a/libguile/continuations.h
+++ b/libguile/continuations.h
@@ -49,7 +49,6 @@ typedef struct
 #endif
   size_t num_stack_items;   /* size of the saved stack.  */
   SCM root;                 /* continuation root identifier.  */
-  struct scm_vm *vp;        /* vm */
   SCM vm_cont;              /* vm's stack and regs */
 
   /* The offset from the live stack location to this copy.  This is
@@ -71,15 +70,12 @@ typedef struct
 SCM_INTERNAL SCM scm_i_make_continuation (int *first,
                                           struct scm_vm *vp,
                                           SCM vm_cont);
-SCM_INTERNAL void scm_i_check_continuation (SCM cont);
-SCM_INTERNAL void scm_i_reinstate_continuation (SCM cont);
+SCM_INTERNAL void scm_i_reinstate_continuation (SCM cont) SCM_NORETURN;
 
-struct scm_frame;
 SCM_INTERNAL int scm_i_continuation_to_frame (SCM cont,
                                               struct scm_frame *frame);
 
-SCM_INTERNAL struct scm_vm* scm_i_contregs_vp (SCM contregs);
-SCM_INTERNAL SCM scm_i_contregs_vm_cont (SCM contregs);
+SCM_INTERNAL scm_t_contregs* scm_i_contregs (SCM contregs);
 
 SCM_API void *scm_c_with_continuation_barrier (void *(*func)(void*), void *);
 SCM_API SCM scm_with_continuation_barrier (SCM proc);
diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index df15515..5b183a6 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -52,6 +52,7 @@ typedef void (*scm_t_thread_u32_u32_scm_u8_u8_intrinsic) 
(scm_i_thread*, uint32_
                                                           uint8_t);
 typedef SCM (*scm_t_scm_from_scm_scm_intp_sp_intrinsic) (SCM, SCM, int*,
                                                          const union 
scm_vm_stack_element*);
+typedef void (*scm_t_thread_scm_noreturn_intrinsic) (scm_i_thread*, SCM) 
SCM_NORETURN;
 
 #define SCM_FOR_ALL_VM_INTRINSICS(M) \
   M(scm_from_scm_scm, add, "add", ADD) \
@@ -102,6 +103,7 @@ typedef SCM (*scm_t_scm_from_scm_scm_intp_sp_intrinsic) 
(SCM, SCM, int*,
   M(thread_u32_u32_scm_u8_u8, bind_kwargs, "bind-kwargs", BIND_KWARGS) \
   M(thread, push_interrupt_frame, "push-interrupt-frame", 
PUSH_INTERRUPT_FRAME) \
   M(scm_from_scm_scm_intp_sp, foreign_call, "foreign-call", FOREIGN_CALL) \
+  M(thread_scm_noreturn, reinstate_continuation_x, "reinstate-continuation!", 
REINSTATE_CONTINUATION_X) \
   /* Add new intrinsics here; also update scm_bootstrap_intrinsics.  */
 
 enum scm_vm_intrinsic
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 8e86382..dcbd96e 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -650,7 +650,7 @@ VM_NAME (scm_i_thread *thread, jmp_buf *registers, int 
resume)
 
       ALLOC_FRAME (3);
       SP_SET (1, ret);
-      SP_SET (0, scm_from_int (err));
+      SP_SET (0, scm_vm_intrinsics.s64_to_scm (err));
 
       NEXT (1);
     }
@@ -674,12 +674,7 @@ VM_NAME (scm_i_thread *thread, jmp_buf *registers, int 
resume)
         SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), contregs_idx);
 
       SYNC_IP ();
-      scm_i_check_continuation (contregs);
-      vm_return_to_continuation (scm_i_contregs_vp (contregs),
-                                 scm_i_contregs_vm_cont (contregs),
-                                 FRAME_LOCALS_COUNT_FROM (1),
-                                 sp);
-      scm_i_reinstate_continuation (contregs);
+      scm_vm_intrinsics.reinstate_continuation_x (thread, contregs);
 
       /* no NEXT */
       abort ();
diff --git a/libguile/vm.c b/libguile/vm.c
index bafdcf2..b3a680f 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -182,63 +182,6 @@ scm_i_vm_capture_stack (union scm_vm_stack_element 
*stack_top,
   return scm_cell (scm_tc7_vm_cont, (scm_t_bits) p);
 }
 
-struct return_to_continuation_data
-{
-  struct scm_vm_cont *cp;
-  struct scm_vm *vp;
-};
-
-/* Called with the GC lock to prevent the stack marker from traversing a
-   stack in an inconsistent state.  */
-static void *
-vm_return_to_continuation_inner (void *data_ptr)
-{
-  struct return_to_continuation_data *data = data_ptr;
-  struct scm_vm *vp = data->vp;
-  struct scm_vm_cont *cp = data->cp;
-
-  /* We know that there is enough space for the continuation, because we
-     captured it in the past.  However there may have been an expansion
-     since the capture, so we may have to re-link the frame
-     pointers.  */
-  memcpy (vp->stack_top - cp->stack_size,
-          cp->stack_bottom,
-          cp->stack_size * sizeof (*cp->stack_bottom));
-  vp->fp = vp->stack_top - cp->fp_offset;
-  vm_restore_sp (vp, vp->stack_top - cp->stack_size);
-
-  return NULL;
-}
-
-static void
-vm_return_to_continuation (struct scm_vm *vp, SCM cont, size_t n,
-                           union scm_vm_stack_element *argv)
-{
-  struct scm_vm_cont *cp;
-  union scm_vm_stack_element *argv_copy;
-  struct return_to_continuation_data data;
-
-  argv_copy = alloca (n * sizeof (*argv));
-  memcpy (argv_copy, argv, n * sizeof (*argv));
-
-  cp = SCM_VM_CONT_DATA (cont);
-
-  data.cp = cp;
-  data.vp = vp;
-  GC_call_with_alloc_lock (vm_return_to_continuation_inner, &data);
-
-  /* Now we have the continuation properly copied over.  We just need to
-     copy on an empty frame and the return values, as the continuation
-     expects.  */
-  vm_push_sp (vp, vp->sp - 3 - n);
-  vp->sp[n+2].as_scm = SCM_BOOL_F;
-  vp->sp[n+1].as_scm = SCM_BOOL_F;
-  vp->sp[n].as_scm = SCM_BOOL_F;
-  memcpy(vp->sp, argv_copy, n * sizeof (union scm_vm_stack_element));
-
-  vp->ip = cp->ra;
-}
-
 SCM
 scm_i_capture_current_stack (void)
 {
@@ -1285,6 +1228,76 @@ push_interrupt_frame (scm_i_thread *thread)
   SCM_FRAME_LOCAL (thread->vm.fp, 0) = proc;
 }
 
+struct return_to_continuation_data
+{
+  struct scm_vm_cont *cp;
+  struct scm_vm *vp;
+};
+
+/* Called with the GC lock to prevent the stack marker from traversing a
+   stack in an inconsistent state.  */
+static void *
+vm_return_to_continuation_inner (void *data_ptr)
+{
+  struct return_to_continuation_data *data = data_ptr;
+  struct scm_vm *vp = data->vp;
+  struct scm_vm_cont *cp = data->cp;
+
+  /* We know that there is enough space for the continuation, because we
+     captured it in the past.  However there may have been an expansion
+     since the capture, so we may have to re-link the frame
+     pointers.  */
+  memcpy (vp->stack_top - cp->stack_size,
+          cp->stack_bottom,
+          cp->stack_size * sizeof (*cp->stack_bottom));
+  vp->fp = vp->stack_top - cp->fp_offset;
+  vm_restore_sp (vp, vp->stack_top - cp->stack_size);
+
+  return NULL;
+}
+
+static void reinstate_continuation_x (scm_i_thread *thread, SCM cont) 
SCM_NORETURN;
+
+static void
+reinstate_continuation_x (scm_i_thread *thread, SCM cont)
+{
+  scm_t_contregs *continuation = scm_i_contregs (cont);
+  struct scm_vm *vp = &thread->vm;
+  struct scm_vm_cont *cp;
+  size_t n;
+  union scm_vm_stack_element *argv;
+  struct return_to_continuation_data data;
+
+  if (!scm_is_eq (continuation->root, thread->continuation_root))
+    scm_misc_error
+      ("%continuation-call",
+       "invoking continuation would cross continuation barrier: ~A",
+       scm_list_1 (cont));
+
+  n = frame_locals_count (thread) - 1,
+  argv = alloca (n * sizeof (*argv));
+  memcpy (argv, vp->sp, n * sizeof (*argv));
+
+  cp = SCM_VM_CONT_DATA (continuation->vm_cont);
+
+  data.cp = cp;
+  data.vp = vp;
+  GC_call_with_alloc_lock (vm_return_to_continuation_inner, &data);
+
+  /* Now we have the continuation properly copied over.  We just need to
+     copy on an empty frame and the return values, as the continuation
+     expects.  */
+  vm_push_sp (vp, vp->sp - 3 - n);
+  vp->sp[n+2].as_scm = SCM_BOOL_F;
+  vp->sp[n+1].as_scm = SCM_BOOL_F;
+  vp->sp[n].as_scm = SCM_BOOL_F;
+  memcpy(vp->sp, argv, n * sizeof (union scm_vm_stack_element));
+
+  vp->ip = cp->ra;
+
+  scm_i_reinstate_continuation (cont);
+}
+
 SCM
 scm_call_n (SCM proc, SCM *argv, size_t nargs)
 {
@@ -1628,6 +1641,7 @@ scm_bootstrap_vm (void)
   scm_vm_intrinsics.compute_kwargs_npositional = compute_kwargs_npositional;
   scm_vm_intrinsics.bind_kwargs = bind_kwargs;
   scm_vm_intrinsics.push_interrupt_frame = push_interrupt_frame;
+  scm_vm_intrinsics.reinstate_continuation_x = reinstate_continuation_x;
 
   sym_vm_run = scm_from_latin1_symbol ("vm-run");
   sym_vm_error = scm_from_latin1_symbol ("vm-error");