3 files changed, 116 insertions, 17 deletions

diff --git a/src/bytecode.c b/src/bytecode.c
index 29b76f88ef7..fe59cf6600b 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -311,8 +311,6 @@ enum byte_code_op
 
 #define TOP (*top)
 
-#define UPDATE_OFFSET (backtrace_byte_offset = pc - bytestr_data);
-
 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
        doc: /* Function used internally in byte-compiled code.
 The first argument, BYTESTR, is a string of byte code;
@@ -433,7 +431,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
       /* NEXT is invoked at the end of an instruction to go to the
          next instruction.  It is either a computed goto, or a
          plain break.  */
-#define NEXT UPDATE_OFFSET goto *(targets[op = FETCH])
+#define NEXT goto *(targets[op = FETCH])
       /* FIRST is like NEXT, but is only used at the start of the
          interpreter body.  In the switch-based interpreter it is the
          switch, so the threaded definition must include a semicolon.  */
@@ -635,7 +633,90 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
                   }
               }
 #endif
-            TOP = Ffuncall (op + 1, &TOP);
+            Lisp_Object fun, original_fun;
+            Lisp_Object funcar;
+            Lisp_Object *fun_args;
+            ptrdiff_t numargs = op;
+            Lisp_Object val;
+            ptrdiff_t count_c;
+
+            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'");
+              }
+
+            fun_args = &TOP + 1;
+
+            count_c = record_in_backtrace_with_offset (TOP, fun_args, numargs, pc - bytestr_data - 1);
+
+            maybe_gc ();
+
+            if (debug_on_next_call)
+              do_debug_on_call (Qlambda, count);
+
+            original_fun = TOP;
+
+          retry:
+
+            /* Optimize for no indirection.  */
+            fun = original_fun;
+            if (SYMBOLP (fun) && !NILP (fun)
+                && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun)))
+              fun = indirect_function (fun);
+
+            if (COMPILEDP (fun))
+              {
+                Lisp_Object syms_left = AREF (fun, COMPILED_ARGLIST);
+                if (FIXNUMP (syms_left))
+                  {
+                    if (CONSP (AREF (fun, COMPILED_BYTECODE)))
+                      Ffetch_bytecode (fun);
+                    val = exec_byte_code (AREF (fun, COMPILED_BYTECODE),
+                                          AREF (fun, COMPILED_CONSTANTS),
+                                          AREF (fun, COMPILED_STACK_DEPTH),
+                                          syms_left, numargs, fun_args);
+                  }
+                else
+                  {
+                    /* The rest of funcall_lambda is very bulky */
+                    val = funcall_lambda (fun, numargs, fun_args);
+                  }
+              }
+            else if (SUBRP (fun))
+              val = funcall_subr (XSUBR (fun), numargs, fun_args);
+#ifdef HAVE_MODULES
+            else if (MODULE_FUNCTIONP (fun))
+              val = funcall_module (fun, numargs, fun_args);
+#endif
+            else
+              {
+                if (NILP (fun))
+                  xsignal1 (Qvoid_function, original_fun);
+                if (!CONSP (fun)
+                    || (funcar = XCAR (fun), !SYMBOLP(funcar)))
+                  xsignal1 (Qinvalid_function, original_fun);
+                if (EQ (funcar, Qlambda)
+                    || EQ (funcar, Qclosure))
+                  val = funcall_lambda (fun, numargs, fun_args);
+                else if (EQ (funcar, Qautoload))
+                  {
+                    Fautoload_do_load (fun, original_fun, Qnil);
+                    goto retry;
+                  }
+                else
+                  xsignal1 (Qinvalid_function, original_fun);
+              }
+            lisp_eval_depth--;
+            if (backtrace_debug_on_exit (specpdl + count_c))
+              val = call_debugger (list2 (Qexit, val));
+            specpdl_ptr--;
+
+            TOP = val;
             NEXT;
           }
 
@@ -1451,7 +1532,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
         unbind_to (count, Qnil);
       error ("binding stack not balanced (serious byte compiler bug)");
     }
-  backtrace_byte_offset = -1;
+
   Lisp_Object result = TOP;
   SAFE_FREE ();
   return result;
diff --git a/src/eval.c b/src/eval.c
index 5b43b81a6ca..544dfc25af9 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -56,8 +56,6 @@ Lisp_Object Vrun_hooks;
 /* FIXME: We should probably get rid of this!  */
 Lisp_Object Vsignaling_function;
 
-int backtrace_byte_offset = -1;
-
 /* These would ordinarily be static, but they need to be visible to GDB.  */
 bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE;
 Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE;
@@ -65,7 +63,6 @@ Lisp_Object backtrace_function (union specbinding *) EXTERNALLY_VISIBLE;
 union specbinding *backtrace_next (union specbinding *) EXTERNALLY_VISIBLE;
 union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE;
 
-static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
 static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, ptrdiff_t);
 static Lisp_Object lambda_arity (Lisp_Object);
 
@@ -146,7 +143,7 @@ backtrace_bytecode_offset (union specbinding *pdl)
   return pdl->bt.bytecode_offset;
 }
 
-static bool
+bool
 backtrace_debug_on_exit (union specbinding *pdl)
 {
   eassert (pdl->kind == SPECPDL_BACKTRACE);
@@ -354,7 +351,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;
@@ -2146,6 +2143,27 @@ grow_specpdl (void)
 }
 
 ptrdiff_t
+record_in_backtrace_with_offset (Lisp_Object function, Lisp_Object *args,
+                                 ptrdiff_t nargs, int offset)
+{
+  ptrdiff_t count = SPECPDL_INDEX ();
+
+  eassert (nargs >= UNEVALLED);
+  specpdl_ptr->bt.kind = SPECPDL_BACKTRACE;
+  specpdl_ptr->bt.debug_on_exit = false;
+  specpdl_ptr->bt.function = function;
+  current_thread->stack_top = specpdl_ptr->bt.args = args;
+  specpdl_ptr->bt.nargs = nargs;
+  specpdl_ptr->bt.bytecode_offset = -1;
+  union specbinding *nxt = backtrace_top ();
+  if (backtrace_p (nxt) && nxt->kind == SPECPDL_BACKTRACE)
+    nxt->bt.bytecode_offset = offset;
+  grow_specpdl ();
+
+  return count;
+}
+
+ptrdiff_t
 record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
@@ -2156,10 +2174,7 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
   specpdl_ptr->bt.function = function;
   current_thread->stack_top = specpdl_ptr->bt.args = args;
   specpdl_ptr->bt.nargs = nargs;
-  union specbinding *nxt = specpdl_ptr;
-  nxt = backtrace_next(nxt);
-  if (nxt->kind == SPECPDL_BACKTRACE)
-    nxt->bt.bytecode_offset = backtrace_byte_offset;
+  specpdl_ptr->bt.bytecode_offset = -1;
   grow_specpdl ();
 
   return count;
@@ -2965,7 +2980,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count)
    FUN must be either a lambda-expression, a compiled-code object,
    or a module function.  */
 
-static Lisp_Object
+Lisp_Object
 funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
                 register Lisp_Object *arg_vector)
 {
@@ -3053,7 +3068,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
             arg = Qnil;
 
           /* Bind the argument.  */
-          if (!NILP (lexenv) && SYMBOLP (next))
+          if (!NILP (lexenv))
             /* Lexically bind NEXT by adding it to the lexenv alist.  */
             lexenv = Fcons (Fcons (next, arg), lexenv);
           else
diff --git a/src/lisp.h b/src/lisp.h
index ef6302a4670..e04e374ca97 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4113,7 +4113,6 @@ extern Lisp_Object Vautoload_queue;
 extern Lisp_Object Vrun_hooks;
 extern Lisp_Object Vsignaling_function;
 extern Lisp_Object inhibit_lisp_code;
-extern int backtrace_byte_offset;
 
 /* To run a normal hook, use the appropriate function from the list below.
    The calling convention:
@@ -4141,6 +4140,7 @@ extern AVOID signal_error (const char *, Lisp_Object);
 extern AVOID overflow_error (void);
 extern bool FUNCTIONP (Lisp_Object);
 extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector);
+extern Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
 extern Lisp_Object eval_sub (Lisp_Object form);
 extern Lisp_Object apply1 (Lisp_Object, Lisp_Object);
 extern Lisp_Object call0 (Lisp_Object);
@@ -4185,6 +4185,7 @@ extern Lisp_Object vformat_string (const char *, va_list)
   ATTRIBUTE_FORMAT_PRINTF (1, 0);
 extern void un_autoload (Lisp_Object);
 extern Lisp_Object call_debugger (Lisp_Object arg);
+extern void do_debug_on_call (Lisp_Object code, ptrdiff_t count);
 extern void init_eval_once (void);
 extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
 extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
@@ -4193,8 +4194,10 @@ extern void init_eval (void);
 extern void syms_of_eval (void);
 extern void prog_ignore (Lisp_Object);
 extern ptrdiff_t record_in_backtrace (Lisp_Object, Lisp_Object *, ptrdiff_t);
+extern ptrdiff_t record_in_backtrace_with_offset (Lisp_Object, Lisp_Object *, ptrdiff_t, int);
 extern void mark_specpdl (union specbinding *first, union specbinding *ptr);
 extern void get_backtrace (Lisp_Object array);
+extern bool backtrace_debug_on_exit (union specbinding *pdl);
 Lisp_Object backtrace_top_function (void);
 extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);