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.

diff --git a/src/bytecode.c b/src/bytecode.c
index b7e65d05aef670b0a04fef2d55b6df233ddac13d..2be558d747230c29fe68be29dc4c4c2eff3fbdbe 100644 (file)
--- 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 6a8c759c1d9f8f2acf16f5ff1a64d08168cacb5d..8912e285252ddf1b081d3c96e7652b46144ddce1 100644 (file)
--- 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 97ed084ce85727b526dc04ac1977392a8518a9fd..020fe6e0943335ce895db087c61f1b1ac65c6665 100644 (file)
--- 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