[Guile-commits] 03/07: Small subr-call refactor

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 8832e8b68c528fe48e65902692abe713730dd68e
Author: Andy Wingo <address@hidden>
Date:   Thu Oct 22 12:13:37 2015 +0000

    Small subr-call refactor
    
    * libguile/gsubr.c (scm_apply_subr): New internal helper.
    * libguile/vm-engine.c (subr-call): Call out to scm_apply_subr.
    * doc/ref/vm.texi (subr-call): Don't specify how the foreign pointer is
      obtained.
---
 doc/ref/vm.texi      |    7 ++---
 libguile/gsubr.c     |   43 ++++++++++++++++++++++++++++-
 libguile/gsubr.h     |    6 +++-
 libguile/vm-engine.c |   74 +++++--------------------------------------------
 4 files changed, 58 insertions(+), 72 deletions(-)

diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index 45c3928..e44f211 100644
--- a/doc/ref/vm.texi
+++ b/doc/ref/vm.texi
@@ -888,10 +888,9 @@ compiler probably shouldn't emit code with these 
instructions.  However,
 it's still interesting to know how these things work, so we document
 these trampoline instructions here.
 
address@hidden Instruction {} subr-call c24:@var{ptr-idx}
-Call a subr, passing all locals in this frame as arguments.  Fetch the
-foreign pointer from @var{ptr-idx}, a free variable.  Return from the
-calling frame.
address@hidden Instruction {} subr-call x24:@var{_}
+Call a subr, passing all locals in this frame as arguments.  Return from
+the calling frame.
 @end deftypefn
 
 @deftypefn Instruction {} foreign-call c12:@var{cif-idx} c12:@var{ptr-idx}
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index 329241d..a3b804b 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995-2001, 2006, 2008-2011, 2013
+/* Copyright (C) 1995-2001, 2006, 2008-2011, 2013, 2015
  *   Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -296,6 +296,47 @@ scm_i_primitive_call_ip (SCM subr)
 }
 
 SCM
+scm_apply_subr (union scm_vm_stack_element *sp, scm_t_ptrdiff nslots)
+{
+  SCM (*subr)() = SCM_SUBRF (sp[nslots - 1].as_scm);
+
+#define ARG(i) (sp[i].as_scm)
+  switch (nslots - 1)
+    {
+    case 0:
+      return subr ();
+    case 1:
+      return subr (ARG (0));
+    case 2:
+      return subr (ARG (1), ARG (0));
+    case 3:
+      return subr (ARG (2), ARG (1), ARG (0));
+    case 4:
+      return subr (ARG (3), ARG (2), ARG (1), ARG (0));
+    case 5:
+      return subr (ARG (4), ARG (3), ARG (2), ARG (1), ARG (0));
+    case 6:
+      return subr (ARG (5), ARG (4), ARG (3), ARG (2), ARG (1),
+                   ARG (0));
+    case 7:
+      return subr (ARG (6), ARG (5), ARG (4), ARG (3), ARG (2),
+                   ARG (1), ARG (0));
+    case 8:
+      return subr (ARG (7), ARG (6), ARG (5), ARG (4), ARG (3),
+                   ARG (2), ARG (1), ARG (0));
+    case 9:
+      return subr (ARG (8), ARG (7), ARG (6), ARG (5), ARG (4),
+                   ARG (3), ARG (2), ARG (1), ARG (0));
+    case 10:
+      return subr (ARG (9), ARG (8), ARG (7), ARG (6), ARG (5),
+                   ARG (4), ARG (3), ARG (2), ARG (1), ARG (0));
+    default:
+      abort ();
+    }
+#undef ARG
+}
+
+SCM
 scm_c_make_gsubr (const char *name, int req, int opt, int rst, SCM (*fcn)())
 {
   return create_subr (0, name, req, opt, rst, fcn, NULL);
diff --git a/libguile/gsubr.h b/libguile/gsubr.h
index 065b947..a9db85e 100644
--- a/libguile/gsubr.h
+++ b/libguile/gsubr.h
@@ -4,7 +4,7 @@
 #define SCM_GSUBR_H
 
 /* Copyright (C) 1995, 1996, 1998, 2000, 2001, 2006, 2008, 2009,
- *   2010, 2011, 2013 Free Software Foundation, Inc.
+ *   2010, 2011, 2013, 2015 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -57,6 +57,10 @@
 SCM_INTERNAL int scm_i_primitive_arity (SCM subr, int *req, int *opt, int 
*rest);
 SCM_INTERNAL scm_t_uintptr scm_i_primitive_call_ip (SCM subr);
 
+union scm_vm_stack_element;
+SCM_INTERNAL SCM scm_apply_subr (union scm_vm_stack_element *sp,
+                                 scm_t_ptrdiff nargs);
+
 SCM_API SCM scm_c_make_gsubr (const char *name,
                              int req, int opt, int rst, scm_t_subr fcn);
 SCM_API SCM scm_c_make_gsubr_with_generic (const char *name,
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 308c04c..d5f6857 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -781,77 +781,19 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
    * Specialized call stubs
    */
 
-  /* subr-call ptr-idx:24
+  /* subr-call _:24
    *
-   * Call a subr, passing all locals in this frame as arguments.  Fetch
-   * the foreign pointer from PTR-IDX, a free variable.  Return from the
-   * calling frame.  This instruction is part of the trampolines
-   * created in gsubr.c, and is not generated by the compiler.
+   * Call a subr, passing all locals in this frame as arguments.  Return
+   * from the calling frame.  This instruction is part of the
+   * trampolines created in gsubr.c, and is not generated by the
+   * compiler.
    */
-  VM_DEFINE_OP (10, subr_call, "subr-call", OP1 (X8_C24))
+  VM_DEFINE_OP (10, subr_call, "subr-call", OP1 (X32))
     {
-      scm_t_uint32 ptr_idx;
-      SCM pointer, ret;
-      SCM (*subr)();
-
-      UNPACK_24 (op, ptr_idx);
-
-      pointer = SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), ptr_idx);
-      subr = SCM_POINTER_VALUE (pointer);
+      SCM ret;
 
       SYNC_IP ();
-
-      switch (FRAME_LOCALS_COUNT_FROM (1))
-        {
-        case 0:
-          ret = subr ();
-          break;
-        case 1:
-          ret = subr (SP_REF (0));
-          break;
-        case 2:
-          ret = subr (SP_REF (1), SP_REF (0));
-          break;
-        case 3:
-          ret = subr (SP_REF (2), SP_REF (1), SP_REF (0));
-          break;
-        case 4:
-          ret = subr (SP_REF (3), SP_REF (2), SP_REF (1),
-                      SP_REF (0));
-          break;
-        case 5:
-          ret = subr (SP_REF (4), SP_REF (3), SP_REF (2),
-                      SP_REF (1), SP_REF (0));
-          break;
-        case 6:
-          ret = subr (SP_REF (5), SP_REF (4), SP_REF (3),
-                      SP_REF (2), SP_REF (1), SP_REF (0));
-          break;
-        case 7:
-          ret = subr (SP_REF (6), SP_REF (5), SP_REF (4),
-                      SP_REF (3), SP_REF (2), SP_REF (1),
-                      SP_REF (0));
-          break;
-        case 8:
-          ret = subr (SP_REF (7), SP_REF (6), SP_REF (5),
-                      SP_REF (4), SP_REF (3), SP_REF (2),
-                      SP_REF (1), SP_REF (0));
-          break;
-        case 9:
-          ret = subr (SP_REF (8), SP_REF (7), SP_REF (6),
-                      SP_REF (5), SP_REF (4), SP_REF (3),
-                      SP_REF (2), SP_REF (1), SP_REF (0));
-          break;
-        case 10:
-          ret = subr (SP_REF (9), SP_REF (8), SP_REF (7),
-                      SP_REF (6), SP_REF (5), SP_REF (4),
-                      SP_REF (3), SP_REF (2), SP_REF (1),
-                      SP_REF (0));
-          break;
-        default:
-          abort ();
-        }
-
+      ret = scm_apply_subr (sp, FRAME_LOCALS_COUNT ());
       CACHE_SP ();
 
       if (SCM_UNLIKELY (SCM_VALUESP (ret)))