From: Andrea Corallo <andrea_corallo@yahoo.it>
Date: Sun, 30 Jun 2019 18:53:59 +0000 (+0200)
Subject: fix native call to MANY func
X-Git-Tag: emacs-28.0.90~2727^2~1408
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=3fd19aecee00d8ac1b001ed7aebf9c4ff4f36001;p=emacs.git

fix native call to MANY func
---

diff --git a/src/comp.c b/src/comp.c
index 3cd1c3c8dbb..d86bd1eb0c1 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -2286,7 +2286,7 @@ compile_f (const char *lisp_f_name, const char *c_f_name,
 	    if (stack->const_set &&
 		stack->type == Lisp_Symbol)
 	      {
-		ptrdiff_t native_nargs = nargs - 1;
+		ptrdiff_t native_nargs = op;
 		char *sym_name = (char *) SDATA (SYMBOL_NAME (stack->constant));
 		if (!strcmp (sym_name,
 			     lisp_f_name))
@@ -2304,29 +2304,39 @@ compile_f (const char *lisp_f_name, const char *c_f_name,
 						 sym_name));
 		    struct Lisp_Subr *subr =
 		      XSUBR ((XSYMBOL (stack->constant)->u.s.function));
-		    gcc_jit_type *types[native_nargs];
-
-		    for (int i = 0; i < native_nargs; i++)
-		      types[i] = comp.lisp_obj_type;
-
-		    gcc_jit_type *fn_ptr_type =
-		      gcc_jit_context_new_function_ptr_type (comp.ctxt,
-							     NULL,
-							     comp.lisp_obj_type,
-							     native_nargs,
-							     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),
-			native_nargs,
-			args + 1);
+		    if (subr->max_args == MANY)
+		      {
+			/* FIXME: do we want to optimize this case too?  */
+			goto dofuncall;
+		      } else
+		      {
+			gcc_jit_type *types[native_nargs];
+
+			for (int i = 0; i < native_nargs; i++)
+			  types[i] = comp.lisp_obj_type;
+
+			gcc_jit_type *fn_ptr_type =
+			  gcc_jit_context_new_function_ptr_type (
+			    comp.ctxt,
+			    NULL,
+			    comp.lisp_obj_type,
+			    native_nargs,
+			    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),
+			    native_nargs,
+			    args + 1);
+		      }
 		  }
 	      }
+	  dofuncall:
 	    /* Fall back to regular funcall dispatch mechanism. */
 	    if (!res)
 	      res = emit_call_n_ref ("Ffuncall", nargs, stack->gcc_lval);
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index afb2a663c0b..42e10ba5114 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -171,7 +171,15 @@
   (byte-compile #'comp-tests-ffuncall-native-f)
   (native-compile #'comp-tests-ffuncall-native-f)
 
-  (should (vectorp (comp-tests-ffuncall-native-f))))
+  (should (vectorp (comp-tests-ffuncall-native-f)))
+
+  (defun comp-tests-ffuncall-apply-many-f (x)
+    (apply #'list x))
+
+  (byte-compile #'comp-tests-ffuncall-apply-many-f)
+  (native-compile #'comp-tests-ffuncall-apply-many-f)
+
+  (should (equal (comp-tests-ffuncall-apply-many-f '(1 2 3)) '(1 2 3))))
 
 (ert-deftest  comp-tests-conditionals ()
   "Testing conditionals."