Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-25 06:17:34 +00:00
Code Issues Projects Releases Packages Wiki Activity

optimize outgoing native manyarg calls

Browse source
This commit is contained in:
Andrea Corallo 2019-07-06 11:02:52 +02:00 committed by Andrea Corallo
parent 4992fba7c5
commit 98b500a0a2
2 changed files with 44 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

46
src/comp.c
View file

@ -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;

11
test/src/comp-tests.el
View file

@ -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))