[Guile-commits] 04/13: Add unpack-values-object intrinsic

[Andy Wingo]

wingo pushed a commit to branch lightning
in repository guile.

commit ef4c1a5f55f058df39af381f9a3dcdaf1bf219c2
Author: Andy Wingo <address@hidden>
Date:   Sat Aug 11 10:48:29 2018 +0200

    Add unpack-values-object intrinsic
    
    * libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS): Add
      unpack-values-object.
    * libguile/vm-engine.c (subr-call): If the object is a values object,
      call out to unpack-values-object.  This is to avoid reifying
      allocate-frame code in each jitted subr.
    * libguile/vm.c (unpack_values_object, scm_bootstrap_vm): Define new
      intrinsic.
---
 libguile/intrinsics.h |  1 +
 libguile/vm-engine.c  |  8 ++------
 libguile/vm.c         | 12 ++++++++++++
 3 files changed, 15 insertions(+), 6 deletions(-)

diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index 136c29f..5a26b26 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -133,6 +133,7 @@ typedef uint32_t* (*scm_t_vra_from_thread_intrinsic) 
(scm_thread*);
   M(scm_from_thread_u64, allocate_words, "allocate-words", ALLOCATE_WORDS) \
   M(scm_from_thread, current_module, "current-module", CURRENT_MODULE) \
   M(thread_u8_scm_sp_vra, push_prompt, "push-prompt", PUSH_PROMPT) \
+  M(thread_scm, unpack_values_object, "unpack-values-object", 
UNPACK_VALUES_OBJECT) \
   /* 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 b22dee9..7750815 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -595,14 +595,10 @@ VM_NAME (scm_thread *thread)
       SYNC_IP ();
       ret = scm_apply_subr (sp, idx, FRAME_LOCALS_COUNT ());
 
-      CACHE_SP ();
-
       if (SCM_UNLIKELY (scm_is_values (ret)))
         {
-          size_t n, nvals = scm_i_nvalues (ret);
-          ALLOC_FRAME (nvals);
-          for (n = 0; n < nvals; n++)
-            FP_SET (n, scm_i_value_ref (ret, n));
+          CALL_INTRINSIC (unpack_values_object, (thread, ret));
+          CACHE_SP ();
           NEXT (1);
         }
       else
diff --git a/libguile/vm.c b/libguile/vm.c
index 8ad8cfe..9dc94f8 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -1183,6 +1183,17 @@ rest_arg_length (SCM x)
   return len;
 }
 
+/* This is here to avoid putting the code for "alloc-frame" in subr
+   calls. */
+static void
+unpack_values_object (scm_thread *thread, SCM obj)
+{
+  size_t n, nvals = scm_i_nvalues (obj);
+  alloc_frame (thread, nvals);
+  for (n = 0; n < nvals; n++)
+    SCM_FRAME_LOCAL (thread->vm.fp, n) = scm_i_value_ref (obj, n);
+}
+
 static SCM
 capture_delimited_continuation (struct scm_vm *vp,
                                 union scm_vm_stack_element *saved_fp,
@@ -1685,6 +1696,7 @@ scm_bootstrap_vm (void)
   scm_vm_intrinsics.rest_arg_length = rest_arg_length;
   scm_vm_intrinsics.abort_to_prompt = abort_to_prompt;
   scm_vm_intrinsics.get_callee_vcode = get_callee_vcode;
+  scm_vm_intrinsics.unpack_values_object = unpack_values_object;
 
   sym_keyword_argument_error = scm_from_latin1_symbol 
("keyword-argument-error");
   sym_regular = scm_from_latin1_symbol ("regular");