optimize outgoing native manyarg calls

diff --git a/src/comp.c b/src/comp.c
index 0fadeaad11cadd135396b3fdd4a85b5a65a69420..d705b5fa70f6eb1bd59aa53826b368f4ea6ad187 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -2398,12 +2398,10 @@ compile_f (const char *lisp_f_name, const char *c_f_name,
        docall:
          {
            res = NULL;
-           ptrdiff_t nargs = op + 1;
-           pop (nargs, &stack, args);
+           pop (op + 1, &stack, args);
            if (stack->const_set &&
                stack->type == Lisp_Symbol)
              {
-               ptrdiff_t native_nargs = op;
                char *sym_name = (char *) SDATA (SYMBOL_NAME (stack->constant));
                if (!strcmp (sym_name,
                             lisp_f_name))
@@ -2412,24 +2410,49 @@ compile_f (const char *lisp_f_name, const char *c_f_name,
                    res = gcc_jit_context_new_call (comp.ctxt,
                                                    NULL,
                                                    comp.func,
-                                                   native_nargs,
+                                                   op,
                                                    args + 1);
                  } else if (SUBRP ((XSYMBOL (stack->constant)->u.s.function)))
                  {
                    /* Optimize primitive native calls.  */
                    emit_comment (format_string ("Calling primitive %s",
                                                 sym_name));
+                   /* FIXME we really should check is a primitive too!!  */
                    struct Lisp_Subr *subr =
                      XSUBR ((XSYMBOL (stack->constant)->u.s.function));
                    if (subr->max_args == MANY)
                      {
-                       /* FIXME: do we want to optimize this case too?  */
-                       goto dofuncall;
+                       /* f (nargs, args); */
+                       args[0] =
+                         gcc_jit_context_new_rvalue_from_int (
+                           comp.ctxt,
+                           comp.ptrdiff_type,
+                           op);
+                       args[1] =
+                         gcc_jit_lvalue_get_address ((stack + 1)->gcc_lval,
+                                                     NULL);
+                       gcc_jit_type *types[] =
+                         { comp.ptrdiff_type, comp.lisp_obj_ptr_type };
+                       gcc_jit_type *fn_ptr_type =
+                         gcc_jit_context_new_function_ptr_type (
+                           comp.ctxt,
+                           NULL,
+                           comp.lisp_obj_type,
+                           2, types, 0);
+                       res =
+                         gcc_jit_context_new_call_through_ptr (
+                           comp.ctxt,
+                           NULL,
+                           gcc_jit_context_new_rvalue_from_ptr (
+                             comp.ctxt,
+                             fn_ptr_type,
+                             subr->function.a0),
+                           2, args);
                      } else
                      {
-                       gcc_jit_type *types[native_nargs];
+                       gcc_jit_type *types[op];
 
-                       for (int i = 0; i < native_nargs; i++)
+                       for (int i = 0; i < op; i++)
                          types[i] = comp.lisp_obj_type;
 
                        gcc_jit_type *fn_ptr_type =
@@ -2437,7 +2460,7 @@ compile_f (const char *lisp_f_name, const char *c_f_name,
                            comp.ctxt,
                            NULL,
                            comp.lisp_obj_type,
-                           native_nargs,
+                           op,
                            types,
                            0);
                        res =
@@ -2448,15 +2471,14 @@ compile_f (const char *lisp_f_name, const char *c_f_name,
                              comp.ctxt,
                              fn_ptr_type,
                              subr->function.a0),
-                           native_nargs,
+                           op,
                            args + 1);
                      }
                  }
              }
-         dofuncall:
            /* Fall back to regular funcall dispatch mechanism. */
            if (!res)
-             res = emit_call_n_ref ("Ffuncall", nargs, stack->gcc_lval);
+             res = emit_call_n_ref ("Ffuncall", op + 1, stack->gcc_lval);
 
            PUSH_RVAL (res);
            break;

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index ef8e57c40c1531465d89ecd0b1e273787667a5aa..d732d558cddfd5e8602332302c2d101dd81057be 100644 (file)
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -189,7 +189,16 @@
   (byte-compile #'comp-tests-ffuncall-native-f)
   (native-compile #'comp-tests-ffuncall-native-f)
 
-  (should (vectorp (comp-tests-ffuncall-native-f)))
+  (should (equal (comp-tests-ffuncall-native-f) [nil]))
+
+  (defun comp-tests-ffuncall-native-rest-f ()
+    "Call a primitive with no dedicate op with &rest."
+    (vector 1 2 3))
+
+  (byte-compile #'comp-tests-ffuncall-native-rest-f)
+  (native-compile #'comp-tests-ffuncall-native-rest-f)
+
+  (should (equal (comp-tests-ffuncall-native-rest-f) [1 2 3]))
 
   (defun comp-tests-ffuncall-apply-many-f (x)
     (apply #'list x))