From 15961108c9acbef5b7e7daeb47f026969b7a5407 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 28 Dec 2021 16:50:07 +0100 Subject: [PATCH] Short-circuit the recursive bytecode funcall chain Inline parts of the code for function calls to speed up the common case of calling lexbound byte-code. By eliminating intermediate functions, this also reduces C stack usage a little. * src/bytecode.c (exec_byte_code): Inline parts of Ffuncall, funcall_lambda and fetch_and_exec_byte_code in the Bcall opcode handler. * src/eval.c (backtrace_debug_on_exit): Inline and move to lisp.h. (do_debug_on_call): Make global so that it can be called from bytecode.c. (funcall_general): New function, essentially the meat of Ffuncall. * src/lisp.h (backtrace_debug_on_exit): Moved here from eval.c. --- src/bytecode.c | 48 +++++++++++++++++++++++++++++++++++++++++++++++- src/eval.c | 45 +++++++++++++++++++++++++++++++++++++-------- src/lisp.h | 10 ++++++++++ 3 files changed, 94 insertions(+), 9 deletions(-) diff --git a/src/bytecode.c b/src/bytecode.c index b7e65d05aef..2be558d7472 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -629,7 +629,53 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, } } #endif - TOP = Ffuncall (op + 1, &TOP); + maybe_quit (); + + if (++lisp_eval_depth > max_lisp_eval_depth) + { + if (max_lisp_eval_depth < 100) + max_lisp_eval_depth = 100; + if (lisp_eval_depth > max_lisp_eval_depth) + error ("Lisp nesting exceeds `max-lisp-eval-depth'"); + } + + ptrdiff_t numargs = op; + Lisp_Object fun = TOP; + Lisp_Object *args = &TOP + 1; + + ptrdiff_t count1 = record_in_backtrace (fun, args, numargs); + maybe_gc (); + if (debug_on_next_call) + do_debug_on_call (Qlambda, count1); + + Lisp_Object original_fun = fun; + if (SYMBOLP (fun)) + fun = XSYMBOL (fun)->u.s.function; + Lisp_Object template; + Lisp_Object bytecode; + Lisp_Object val; + if (COMPILEDP (fun) + // Lexical binding only. + && (template = AREF (fun, COMPILED_ARGLIST), + FIXNUMP (template)) + // No autoloads. + && (bytecode = AREF (fun, COMPILED_BYTECODE), + !CONSP (bytecode))) + val = exec_byte_code (bytecode, + AREF (fun, COMPILED_CONSTANTS), + AREF (fun, COMPILED_STACK_DEPTH), + template, numargs, args); + else if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) + val = funcall_subr (XSUBR (fun), numargs, args); + else + val = funcall_general (original_fun, numargs, args); + + lisp_eval_depth--; + if (backtrace_debug_on_exit (specpdl + count1)) + val = call_debugger (list2 (Qexit, val)); + specpdl_ptr--; + + TOP = val; NEXT; } diff --git a/src/eval.c b/src/eval.c index 6a8c759c1d9..8912e285252 100644 --- a/src/eval.c +++ b/src/eval.c @@ -138,13 +138,6 @@ backtrace_args (union specbinding *pdl) return pdl->bt.args; } -static bool -backtrace_debug_on_exit (union specbinding *pdl) -{ - eassert (pdl->kind == SPECPDL_BACKTRACE); - return pdl->bt.debug_on_exit; -} - /* Functions to modify slots of backtrace records. */ static void @@ -354,7 +347,7 @@ call_debugger (Lisp_Object arg) return unbind_to (count, val); } -static void +void do_debug_on_call (Lisp_Object code, ptrdiff_t count) { debug_on_next_call = 0; @@ -3033,6 +3026,42 @@ FUNCTIONP (Lisp_Object object) return false; } +Lisp_Object +funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args) +{ + Lisp_Object original_fun = fun; + if (SYMBOLP (fun) && !NILP (fun) + && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun))) + fun = indirect_function (fun); + + if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) + return funcall_subr (XSUBR (fun), numargs, args); + else if (COMPILEDP (fun) + || SUBR_NATIVE_COMPILED_DYNP (fun) + || MODULE_FUNCTIONP (fun)) + return funcall_lambda (fun, numargs, args); + else + { + if (NILP (fun)) + xsignal1 (Qvoid_function, original_fun); + if (!CONSP (fun)) + xsignal1 (Qinvalid_function, original_fun); + Lisp_Object funcar = XCAR (fun); + if (!SYMBOLP (funcar)) + xsignal1 (Qinvalid_function, original_fun); + if (EQ (funcar, Qlambda) + || EQ (funcar, Qclosure)) + return funcall_lambda (fun, numargs, args); + else if (EQ (funcar, Qautoload)) + { + Fautoload_do_load (fun, original_fun, Qnil); + return funcall_general (original_fun, numargs, args); + } + else + xsignal1 (Qinvalid_function, original_fun); + } +} + DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0, doc: /* Call first argument as a function, passing remaining arguments to it. Return the value that function returns. diff --git a/src/lisp.h b/src/lisp.h index 97ed084ce85..020fe6e0943 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3343,6 +3343,13 @@ SPECPDL_INDEX (void) return specpdl_ptr - specpdl; } +INLINE bool +backtrace_debug_on_exit (union specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->bt.debug_on_exit; +} + /* This structure helps implement the `catch/throw' and `condition-case/signal' control structures. A struct handler contains all the information needed to restore the state of the interpreter after a non-local jump. @@ -4338,6 +4345,9 @@ extern void mark_specpdl (union specbinding *first, union specbinding *ptr); extern void get_backtrace (Lisp_Object array); Lisp_Object backtrace_top_function (void); extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); +void do_debug_on_call (Lisp_Object code, ptrdiff_t count); +Lisp_Object funcall_general (Lisp_Object fun, + ptrdiff_t numargs, Lisp_Object *args); /* Defined in unexmacosx.c. */ #if defined DARWIN_OS && defined HAVE_UNEXEC -- 2.39.2