[Guile-commits] 01/01: Parse bytecode to determine minimum arity

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit d848af9a161b0c37964d582dfb8b52ed5112355f
Author: Andy Wingo <address@hidden>
Date:   Fri Jun 24 14:15:38 2016 +0200

    Parse bytecode to determine minimum arity
    
    * libguile/programs.c (try_parse_arity): New helper, to parse bytecode
      to determine the minimum arity of a function in a cheaper way than
      grovelling through the debug info.  Should speed up all thunk? checks
      and similar.
      (scm_i_program_arity): Simplify.
    * libguile/gsubr.h:
    * libguile/gsubr.c (scm_i_primitive_arity):
    * libguile/foreign.h:
    * libguile/foreign.c (scm_i_foreign_arity):
---
 libguile/foreign.c  |   19 --------------
 libguile/foreign.h  |    2 --
 libguile/gsubr.c    |   31 ----------------------
 libguile/gsubr.h    |    1 -
 libguile/programs.c |   71 +++++++++++++++++++++++++++++++++++++++++----------
 5 files changed, 58 insertions(+), 66 deletions(-)

diff --git a/libguile/foreign.c b/libguile/foreign.c
index 936f341..0992ef4 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -792,25 +792,6 @@ get_foreign_stub_code (unsigned int nargs)
   return &foreign_stub_code[nargs * 2];
 }
 
-/* Given a foreign procedure, determine its minimum arity. */
-int
-scm_i_foreign_arity (SCM foreign, int *req, int *opt, int *rest)
-{
-  const scm_t_uint32 *code = SCM_PROGRAM_CODE (foreign);
-
-  if (code < foreign_stub_code)
-    return 0;
-  if (code > (foreign_stub_code
-              + (sizeof(foreign_stub_code) / sizeof(scm_t_uint32))))
-    return 0;
-
-  *req = (code - foreign_stub_code) / 2;
-  *opt = 0;
-  *rest = 0;
-
-  return 1;
-}
-
 static SCM
 cif_to_procedure (SCM cif, SCM func_ptr)
 {
diff --git a/libguile/foreign.h b/libguile/foreign.h
index 53f39d5..4c1a19f 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -101,8 +101,6 @@ SCM_API SCM scm_procedure_to_pointer (SCM return_type, SCM 
func_ptr,
                                      SCM arg_types);
 SCM_INTERNAL SCM scm_i_foreign_call (SCM foreign,
                                      const union scm_vm_stack_element *argv);
-SCM_INTERNAL int scm_i_foreign_arity (SCM foreign,
-                                      int *req, int *opt, int *rest);
 
 
 
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index d80e5dd..b456b22 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -262,37 +262,6 @@ scm_i_primitive_code_p (const scm_t_uint32 *code)
   return 1;
 }
 
-/* Given a program that is a primitive, determine its minimum arity.
-   This is possible because each primitive's code is 4 32-bit words
-   long, and they are laid out contiguously in an ordered pattern.  */
-int
-scm_i_primitive_arity (SCM prim, int *req, int *opt, int *rest)
-{
-  const scm_t_uint32 *code = SCM_PROGRAM_CODE (prim);
-  unsigned idx, nargs, base, next;
-
-  if (!scm_i_primitive_code_p (code))
-    return 0;
-
-  idx = (code - subr_stub_code) / 4;
-
-  nargs = -1;
-  next = 0;
-  do
-    {
-      base = next;
-      nargs++;
-      next = (nargs + 1) * (nargs + 1);
-    }
-  while (idx >= next);
-
-  *rest = (next - idx) < (idx - base);
-  *req = *rest ? (next - 1) - idx : (base + nargs) - idx;
-  *opt = *rest ? idx - (next - nargs) : idx - base;
-
-  return 1;
-}
-
 scm_t_uintptr
 scm_i_primitive_call_ip (SCM subr)
 {
diff --git a/libguile/gsubr.h b/libguile/gsubr.h
index 725de2c..83eebc3 100644
--- a/libguile/gsubr.h
+++ b/libguile/gsubr.h
@@ -55,7 +55,6 @@
 
 
 SCM_INTERNAL int scm_i_primitive_code_p (const scm_t_uint32 *code);
-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;
diff --git a/libguile/programs.c b/libguile/programs.c
index 49d4c77..ba8e854 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -22,6 +22,7 @@
 
 #include <string.h>
 #include "_scm.h"
+#include "instructions.h"
 #include "modules.h"
 #include "programs.h"
 #include "procprop.h" /* scm_sym_name */
@@ -236,25 +237,69 @@ SCM_DEFINE (scm_program_free_variable_set_x, 
"program-free-variable-set!", 3, 0,
 }
 #undef FUNC_NAME
 
+/* It's hacky, but it manages to cover all of the non-keyword cases.  */
+static int
+try_parse_arity (SCM program, int *req, int *opt, int *rest)
+{
+  scm_t_uint32 *code = SCM_PROGRAM_CODE (program);
+  scm_t_uint32 slots, min;
+
+  switch (code[0] & 0xff) {
+  case scm_op_assert_nargs_ee:
+    slots = code[0] >> 8;
+    *req = slots - 1;
+    *opt = 0;
+    *rest = 0;
+    return 1;
+  case scm_op_assert_nargs_le:
+    slots = code[0] >> 8;
+    *req = 0;
+    *opt = slots - 1;
+    *rest = 0;
+    return 1;
+  case scm_op_bind_rest:
+    slots = code[0] >> 8;
+    *req = 0;
+    *opt = slots - 1;
+    *rest = 1;
+    return 1;
+  case scm_op_assert_nargs_ge:
+    min = code[0] >> 8;
+    switch (code[1] & 0xff) {
+    case scm_op_assert_nargs_le:
+      slots = code[1] >> 8;
+      *req = min - 1;
+      *opt = slots - 1 - *req;
+      *rest = 0;
+      return 1;
+    case scm_op_bind_rest:
+      slots = code[1] >> 8;
+      *req = min - 1;
+      *opt = slots - min;
+      *rest = 1;
+      return 1;
+    default:
+      return 0;
+    }
+  case scm_op_continuation_call:
+  case scm_op_compose_continuation:
+    *req = 0;
+    *opt = 0;
+    *rest = 1;
+    return 1;
+  default:
+    return 0;
+  }
+}
+
 int
 scm_i_program_arity (SCM program, int *req, int *opt, int *rest)
 {
   static SCM program_minimum_arity = SCM_BOOL_F;
   SCM l;
 
-  if (SCM_PRIMITIVE_P (program))
-    return scm_i_primitive_arity (program, req, opt, rest);
-
-  if (SCM_PROGRAM_IS_FOREIGN (program))
-    return scm_i_foreign_arity (program, req, opt, rest);
-
-  if (SCM_PROGRAM_IS_CONTINUATION (program)
-      || SCM_PROGRAM_IS_PARTIAL_CONTINUATION (program))
-    {
-      *req = *opt = 0;
-      *rest = 1;
-      return 1;
-    }
+  if (try_parse_arity (program, req, opt, rest))
+    return 1;
 
   if (scm_is_false (program_minimum_arity) && scm_module_system_booted_p)
     program_minimum_arity =