emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] /srv/bzr/emacs/trunk r112828: Merge the specpdl and backtr


From: Stefan Monnier
Subject: [Emacs-diffs] /srv/bzr/emacs/trunk r112828: Merge the specpdl and backtrace stacks. Make the structure of the
Date: Mon, 03 Jun 2013 05:01:53 -0400
User-agent: Bazaar (2.6b2)

------------------------------------------------------------
revno: 112828
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Mon 2013-06-03 05:01:53 -0400
message:
  Merge the specpdl and backtrace stacks.  Make the structure of the
  specpdl entries more obvious via a tagged union of structs.
  * src/lisp.h (BITS_PER_PTRDIFF_T): New constant.
  (enum specbind_tag): New enum.
  (struct specbinding): Make it a tagged union of structs.
  Add a case for backtrace records.
  (specpdl_symbol, specpdl_old_value, specpdl_where, specpdl_arg)
  (specpdl_func, backtrace_function, backtrace_nargs, backtrace_args)
  (backtrace_debug_on_exit): New accessors.
  (struct backtrace): Remove.
  (struct catchtag): Remove backlist field.
  * src/data.c (let_shadows_buffer_binding_p, let_shadows_global_binding_p):
  Move to eval.c.
  (Flocal_variable_p): Speed up the common case where the binding is
  already loaded.
  * src/eval.c (backtrace_list): Remove.
  (set_specpdl_symbol, set_specpdl_old_value): Remove.
  (set_backtrace_args, set_backtrace_nargs)
  (set_backtrace_debug_on_exit, backtrace_p, backtrace_top)
  (backtrace_next): New functions.
  (Fdefvaralias, Fdefvar): Adjust to new specpdl format.
  (unwind_to_catch, internal_lisp_condition_case)
  (internal_condition_case, internal_condition_case_1)
  (internal_condition_case_2, internal_condition_case_n): Don't bother
  with backtrace_list any more.
  (Fsignal): Adjust to new backtrace format.
  (grow_specpdl): Move up.
  (record_in_backtrace): New function.
  (eval_sub, Ffuncall): Use it.
  (apply_lambda): Adjust to new backtrace format.
  (let_shadows_buffer_binding_p, let_shadows_global_binding_p): Move from
  data.c.
  (specbind): Adjust to new specpdl format.  Simplify.
  (record_unwind_protect, unbind_to): Adjust to new specpdl format.
  (Fbacktrace_debug, Fbacktrace, Fbacktrace_frame): Adjust to new
  backtrace format.
  (mark_backtrace): Remove.
  (mark_specpdl, get_backtrace, backtrace_top_function): New functions.
  * src/xdisp.c (redisplay_internal): Use record_in_backtrace.
  * src/alloc.c (Fgarbage_collect): Use record_in_backtrace.
  Use mark_specpdl.
  * src/profiler.c (record_backtrace): Use get_backtrace.
  (handle_profiler_signal): Use backtrace_top_function.
  * src/.gdbinit (xbacktrace, hookpost-backtrace): Use new backtrace
  accessor functions.
modified:
  src/.gdbinit
  src/ChangeLog
  src/alloc.c
  src/data.c
  src/eval.c
  src/lisp.h
  src/profiler.c
  src/xdisp.c
=== modified file 'src/.gdbinit'
--- a/src/.gdbinit      2013-03-07 11:31:07 +0000
+++ b/src/.gdbinit      2013-06-03 09:01:53 +0000
@@ -1150,17 +1150,18 @@
 end
 
 define xbacktrace
-  set $bt = backtrace_list
-  while $bt
-    xgettype ($bt->function)
+  set $bt = backtrace_top ()
+  while backtrace_p ($bt)
+    set $fun = backtrace_function ($bt)
+    xgettype $fun
     if $type == Lisp_Symbol
-      xprintsym ($bt->function)
-      printf " (0x%x)\n", $bt->args
+      xprintsym $fun
+      printf " (0x%x)\n", backtrace_args ($bt)
     else
-      xgetptr $bt->function
+      xgetptr $fun
       printf "0x%x ", $ptr
       if $type == Lisp_Vectorlike
-       xgetptr ($bt->function)
+       xgetptr $fun
         set $size = ((struct Lisp_Vector *) $ptr)->header.size
         if ($size & PSEUDOVECTOR_FLAG)
          output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> 
PSEUDOVECTOR_AREA_BITS)
@@ -1172,7 +1173,7 @@
       end
       echo \n
     end
-    set $bt = $bt->next
+    set $bt = backtrace_next ($bt)
   end
 end
 document xbacktrace
@@ -1220,8 +1221,8 @@
 
 # Show Lisp backtrace after normal backtrace.
 define hookpost-backtrace
-  set $bt = backtrace_list
-  if $bt
+  set $bt = backtrace_top ()
+  if backtrace_p ($bt)
     echo \n
     echo Lisp Backtrace:\n
     xbacktrace

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2013-06-02 19:14:25 +0000
+++ b/src/ChangeLog     2013-06-03 09:01:53 +0000
@@ -1,3 +1,51 @@
+2013-06-03  Stefan Monnier  <address@hidden>
+
+       Merge the specpdl and backtrace stacks.  Make the structure of the
+       specpdl entries more obvious via a tagged union of structs.
+       * lisp.h (BITS_PER_PTRDIFF_T): New constant.
+       (enum specbind_tag): New enum.
+       (struct specbinding): Make it a tagged union of structs.
+       Add a case for backtrace records.
+       (specpdl_symbol, specpdl_old_value, specpdl_where, specpdl_arg)
+       (specpdl_func, backtrace_function, backtrace_nargs, backtrace_args)
+       (backtrace_debug_on_exit): New accessors.
+       (struct backtrace): Remove.
+       (struct catchtag): Remove backlist field.
+       * data.c (let_shadows_buffer_binding_p, let_shadows_global_binding_p):
+       Move to eval.c.
+       (Flocal_variable_p): Speed up the common case where the binding is
+       already loaded.
+       * eval.c (backtrace_list): Remove.
+       (set_specpdl_symbol, set_specpdl_old_value): Remove.
+       (set_backtrace_args, set_backtrace_nargs)
+       (set_backtrace_debug_on_exit, backtrace_p, backtrace_top)
+       (backtrace_next): New functions.
+       (Fdefvaralias, Fdefvar): Adjust to new specpdl format.
+       (unwind_to_catch, internal_lisp_condition_case)
+       (internal_condition_case, internal_condition_case_1)
+       (internal_condition_case_2, internal_condition_case_n): Don't bother
+       with backtrace_list any more.
+       (Fsignal): Adjust to new backtrace format.
+       (grow_specpdl): Move up.
+       (record_in_backtrace): New function.
+       (eval_sub, Ffuncall): Use it.
+       (apply_lambda): Adjust to new backtrace format.
+       (let_shadows_buffer_binding_p, let_shadows_global_binding_p): Move from
+       data.c.
+       (specbind): Adjust to new specpdl format.  Simplify.
+       (record_unwind_protect, unbind_to): Adjust to new specpdl format.
+       (Fbacktrace_debug, Fbacktrace, Fbacktrace_frame): Adjust to new
+       backtrace format.
+       (mark_backtrace): Remove.
+       (mark_specpdl, get_backtrace, backtrace_top_function): New functions.
+       * xdisp.c (redisplay_internal): Use record_in_backtrace.
+       * alloc.c (Fgarbage_collect): Use record_in_backtrace.
+       Use mark_specpdl.
+       * profiler.c (record_backtrace): Use get_backtrace.
+       (handle_profiler_signal): Use backtrace_top_function.
+       * .gdbinit (xbacktrace, hookpost-backtrace): Use new backtrace
+       accessor functions.
+
 2013-06-02  Jan Djärv  <address@hidden>
 
        * process.h (catch_child_signal): Declare.

=== modified file 'src/alloc.c'
--- a/src/alloc.c       2013-04-02 01:54:56 +0000
+++ b/src/alloc.c       2013-06-03 09:01:53 +0000
@@ -5165,7 +5165,6 @@
 See Info node `(elisp)Garbage Collection'.  */)
   (void)
 {
-  struct specbinding *bind;
   struct buffer *nextb;
   char stack_top_variable;
   ptrdiff_t i;
@@ -5174,7 +5173,6 @@
   EMACS_TIME start;
   Lisp_Object retval = Qnil;
   size_t tot_before = 0;
-  struct backtrace backtrace;
 
   if (abort_on_gc)
     emacs_abort ();
@@ -5185,12 +5183,7 @@
     return Qnil;
 
   /* Record this function, so it appears on the profiler's backtraces.  */
-  backtrace.next = backtrace_list;
-  backtrace.function = Qautomatic_gc;
-  backtrace.args = &Qnil;
-  backtrace.nargs = 0;
-  backtrace.debug_on_exit = 0;
-  backtrace_list = &backtrace;
+  record_in_backtrace (Qautomatic_gc, &Qnil, 0);
 
   check_cons_list ();
 
@@ -5257,11 +5250,7 @@
   for (i = 0; i < staticidx; i++)
     mark_object (*staticvec[i]);
 
-  for (bind = specpdl; bind != specpdl_ptr; bind++)
-    {
-      mark_object (bind->symbol);
-      mark_object (bind->old_value);
-    }
+  mark_specpdl ();
   mark_terminals ();
   mark_kboards ();
 
@@ -5295,7 +5284,6 @@
       mark_object (handler->var);
     }
   }
-  mark_backtrace ();
 #endif
 
 #ifdef HAVE_WINDOW_SYSTEM
@@ -5486,7 +5474,6 @@
       malloc_probe (swept);
     }
 
-  backtrace_list = backtrace.next;
   return retval;
 }
 

=== modified file 'src/data.c'
--- a/src/data.c        2013-04-02 01:54:56 +0000
+++ b/src/data.c        2013-06-03 09:01:53 +0000
@@ -1069,40 +1069,6 @@
   return newval;
 }
 
-/* Return true if SYMBOL currently has a let-binding
-   which was made in the buffer that is now current.  */
-
-static bool
-let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
-{
-  struct specbinding *p;
-
-  for (p = specpdl_ptr; p > specpdl; )
-    if ((--p)->func == NULL
-       && CONSP (p->symbol))
-      {
-       struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol));
-       eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS);
-       if (symbol == let_bound_symbol
-           && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer)
-         return 1;
-      }
-
-  return 0;
-}
-
-static bool
-let_shadows_global_binding_p (Lisp_Object symbol)
-{
-  struct specbinding *p;
-
-  for (p = specpdl_ptr; p > specpdl; )
-    if ((--p)->func == NULL && EQ (p->symbol, symbol))
-      return 1;
-
-  return 0;
-}
-
 /* Store the value NEWVAL into SYMBOL.
    If buffer/frame-locality is an issue, WHERE specifies which context to use.
    (nil stands for the current buffer/frame).
@@ -1841,17 +1807,18 @@
        XSETBUFFER (tmp, buf);
        XSETSYMBOL (variable, sym); /* Update in case of aliasing.  */
 
-       for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR 
(tail))
-         {
-           elt = XCAR (tail);
-           if (EQ (variable, XCAR (elt)))
-             {
-               eassert (!blv->frame_local);
-               eassert (blv_found (blv) || !EQ (blv->where, tmp));
-               return Qt;
-             }
-         }
-       eassert (!blv_found (blv) || !EQ (blv->where, tmp));
+       if (EQ (blv->where, tmp)) /* The binding is already loaded.  */
+         return blv_found (blv) ? Qt : Qnil;
+       else
+         for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR 
(tail))
+           {
+             elt = XCAR (tail);
+             if (EQ (variable, XCAR (elt)))
+               {
+                 eassert (!blv->frame_local);
+                 return Qt;
+               }
+           }
        return Qnil;
       }
     case SYMBOL_FORWARDED:

=== modified file 'src/eval.c'
--- a/src/eval.c        2013-03-13 07:27:34 +0000
+++ b/src/eval.c        2013-06-03 09:01:53 +0000
@@ -32,8 +32,6 @@
 #include "xterm.h"
 #endif
 
-struct backtrace *backtrace_list;
-
 #if !BYTE_MARK_STACK
 static
 #endif
@@ -105,7 +103,7 @@
 
 /* The function from which the last `signal' was called.  Set in
    Fsignal.  */
-
+/* FIXME: We should probably get rid of this!  */
 Lisp_Object Vsignaling_function;
 
 /* If non-nil, Lisp code must not be run since some part of Emacs is
@@ -117,19 +115,36 @@
 static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
 static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
 
-/* Functions to set Lisp_Object slots of struct specbinding.  */
-
-static void
-set_specpdl_symbol (Lisp_Object symbol)
-{
-  specpdl_ptr->symbol = symbol;
-}
-
-static void
-set_specpdl_old_value (Lisp_Object oldval)
-{
-  specpdl_ptr->old_value = oldval;
-}
+/* Functions to modify slots of backtrace records.  */
+
+static void set_backtrace_args (struct specbinding *pdl, Lisp_Object *args)
+{ eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.args = args; }
+
+static void set_backtrace_nargs (struct specbinding *pdl, ptrdiff_t n)
+{ eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.nargs = n; }
+
+void set_backtrace_debug_on_exit (struct specbinding *pdl, bool doe)
+{ eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.debug_on_exit = doe; }
+
+/* Helper functions to scan the backtrace.  */
+
+LISP_INLINE bool backtrace_p (struct specbinding *pdl)
+{ return pdl >= specpdl; }
+LISP_INLINE struct specbinding *backtrace_top (void)
+{
+  struct specbinding *pdl = specpdl_ptr - 1;
+  while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE)     \
+    pdl--;
+  return pdl;
+}
+LISP_INLINE struct specbinding *backtrace_next (struct specbinding *pdl)
+{
+  pdl--;
+  while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE)
+    pdl--;
+  return pdl;
+}
+
 
 void
 init_eval_once (void)
@@ -151,7 +166,6 @@
   specpdl_ptr = specpdl;
   catchlist = 0;
   handlerlist = 0;
-  backtrace_list = 0;
   Vquit_flag = Qnil;
   debug_on_next_call = 0;
   lisp_eval_depth = 0;
@@ -234,7 +248,7 @@
 do_debug_on_call (Lisp_Object code)
 {
   debug_on_next_call = 0;
-  backtrace_list->debug_on_exit = 1;
+  set_backtrace_debug_on_exit (specpdl_ptr - 1, true);
   call_debugger (Fcons (code, Qnil));
 }
 
@@ -530,9 +544,8 @@
     struct specbinding *p;
 
     for (p = specpdl_ptr; p > specpdl; )
-      if ((--p)->func == NULL
-         && (EQ (new_alias,
-                 CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol)))
+      if ((--p)->kind >= SPECPDL_LET
+         && (EQ (new_alias, specpdl_symbol (p))))
        error ("Don't know how to make a let-bound variable an alias");
   }
 
@@ -597,8 +610,9 @@
          struct specbinding *pdl = specpdl_ptr;
          while (pdl > specpdl)
            {
-             if (EQ ((--pdl)->symbol, sym) && !pdl->func
-                 && EQ (pdl->old_value, Qunbound))
+             if ((--pdl)->kind >= SPECPDL_LET
+                 && EQ (specpdl_symbol (pdl), sym)
+                 && EQ (specpdl_old_value (pdl), Qunbound))
                {
                  message_with_string
                    ("Warning: defvar ignored because %s is let-bound",
@@ -937,7 +951,7 @@
 
 /* Set up a catch, then call C function FUNC on argument ARG.
    FUNC should return a Lisp_Object.
-   This is how catches are done from within C code. */
+   This is how catches are done from within C code.  */
 
 Lisp_Object
 internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), 
Lisp_Object arg)
@@ -949,7 +963,6 @@
   c.next = catchlist;
   c.tag = tag;
   c.val = Qnil;
-  c.backlist = backtrace_list;
   c.handlerlist = handlerlist;
   c.lisp_eval_depth = lisp_eval_depth;
   c.pdlcount = SPECPDL_INDEX ();
@@ -1014,7 +1027,6 @@
 #ifdef DEBUG_GCPRO
   gcpro_level = gcprolist ? gcprolist->level + 1 : 0;
 #endif
-  backtrace_list = catch->backlist;
   lisp_eval_depth = catch->lisp_eval_depth;
 
   sys_longjmp (catch->jmp, 1);
@@ -1115,7 +1127,6 @@
 
   c.tag = Qnil;
   c.val = Qnil;
-  c.backlist = backtrace_list;
   c.handlerlist = handlerlist;
   c.lisp_eval_depth = lisp_eval_depth;
   c.pdlcount = SPECPDL_INDEX ();
@@ -1131,7 +1142,7 @@
 
       /* Note that this just undoes the binding of h.var; whoever
         longjumped to us unwound the stack to c.pdlcount before
-        throwing. */
+        throwing.  */
       unbind_to (c.pdlcount, Qnil);
       return val;
     }
@@ -1170,7 +1181,6 @@
 
   c.tag = Qnil;
   c.val = Qnil;
-  c.backlist = backtrace_list;
   c.handlerlist = handlerlist;
   c.lisp_eval_depth = lisp_eval_depth;
   c.pdlcount = SPECPDL_INDEX ();
@@ -1208,7 +1218,6 @@
 
   c.tag = Qnil;
   c.val = Qnil;
-  c.backlist = backtrace_list;
   c.handlerlist = handlerlist;
   c.lisp_eval_depth = lisp_eval_depth;
   c.pdlcount = SPECPDL_INDEX ();
@@ -1250,7 +1259,6 @@
 
   c.tag = Qnil;
   c.val = Qnil;
-  c.backlist = backtrace_list;
   c.handlerlist = handlerlist;
   c.lisp_eval_depth = lisp_eval_depth;
   c.pdlcount = SPECPDL_INDEX ();
@@ -1294,7 +1302,6 @@
 
   c.tag = Qnil;
   c.val = Qnil;
-  c.backlist = backtrace_list;
   c.handlerlist = handlerlist;
   c.lisp_eval_depth = lisp_eval_depth;
   c.pdlcount = SPECPDL_INDEX ();
@@ -1362,7 +1369,6 @@
     = (NILP (error_symbol) ? Fcar (data) : error_symbol);
   register Lisp_Object clause = Qnil;
   struct handler *h;
-  struct backtrace *bp;
 
   immediate_quit = 0;
   abort_on_gc = 0;
@@ -1398,13 +1404,13 @@
      too.  Don't do this when ERROR_SYMBOL is nil, because that
      is a memory-full error.  */
   Vsignaling_function = Qnil;
-  if (backtrace_list && !NILP (error_symbol))
+  if (!NILP (error_symbol))
     {
-      bp = backtrace_list->next;
-      if (bp && EQ (bp->function, Qerror))
-       bp = bp->next;
-      if (bp)
-       Vsignaling_function = bp->function;
+      struct specbinding *pdl = backtrace_next (backtrace_top ());
+      if (backtrace_p (pdl) && EQ (backtrace_function (pdl), Qerror))
+       pdl = backtrace_next (pdl);
+      if (backtrace_p (pdl))
+       Vsignaling_function = backtrace_function (pdl);
     }
 
   for (h = handlerlist; h; h = h->next)
@@ -1901,6 +1907,36 @@
   return unbind_to (count, eval_sub (form));
 }
 
+static void
+grow_specpdl (void)
+{
+  register ptrdiff_t count = SPECPDL_INDEX ();
+  ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX);
+  if (max_size <= specpdl_size)
+    {
+      if (max_specpdl_size < 400)
+       max_size = max_specpdl_size = 400;
+      if (max_size <= specpdl_size)
+       signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil);
+    }
+  specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl);
+  specpdl_ptr = specpdl + count;
+}
+
+LISP_INLINE void
+record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
+{
+  eassert (nargs >= UNEVALLED);
+  if (specpdl_ptr == specpdl + specpdl_size)
+    grow_specpdl ();
+  specpdl_ptr->kind = SPECPDL_BACKTRACE;
+  specpdl_ptr->v.bt.function = function;
+  specpdl_ptr->v.bt.args = args;
+  specpdl_ptr->v.bt.nargs = nargs;
+  specpdl_ptr->v.bt.debug_on_exit = false;
+  specpdl_ptr++;
+}
+
 /* Eval a sub-expression of the current expression (i.e. in the same
    lexical scope).  */
 Lisp_Object
@@ -1908,7 +1944,6 @@
 {
   Lisp_Object fun, val, original_fun, original_args;
   Lisp_Object funcar;
-  struct backtrace backtrace;
   struct gcpro gcpro1, gcpro2, gcpro3;
 
   if (SYMBOLP (form))
@@ -1946,12 +1981,8 @@
   original_fun = XCAR (form);
   original_args = XCDR (form);
 
-  backtrace.next = backtrace_list;
-  backtrace.function = original_fun; /* This also protects them from gc.  */
-  backtrace.args = &original_args;
-  backtrace.nargs = UNEVALLED;
-  backtrace.debug_on_exit = 0;
-  backtrace_list = &backtrace;
+  /* This also protects them from gc.  */
+  record_in_backtrace (original_fun, &original_args, UNEVALLED);
 
   if (debug_on_next_call)
     do_debug_on_call (Qt);
@@ -2005,8 +2036,8 @@
              gcpro3.nvars = argnum;
            }
 
-         backtrace.args = vals;
-         backtrace.nargs = XINT (numargs);
+         set_backtrace_args (specpdl_ptr - 1, vals);
+         set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs));
 
          val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
          UNGCPRO;
@@ -2027,8 +2058,8 @@
 
          UNGCPRO;
 
-         backtrace.args = argvals;
-         backtrace.nargs = XINT (numargs);
+         set_backtrace_args (specpdl_ptr - 1, argvals);
+         set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs));
 
          switch (i)
            {
@@ -2118,9 +2149,9 @@
   check_cons_list ();
 
   lisp_eval_depth--;
-  if (backtrace.debug_on_exit)
+  if (backtrace_debug_on_exit (specpdl_ptr - 1))
     val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
-  backtrace_list = backtrace.next;
+  specpdl_ptr--;
 
   return val;
 }
@@ -2600,7 +2631,6 @@
   ptrdiff_t numargs = nargs - 1;
   Lisp_Object lisp_numargs;
   Lisp_Object val;
-  struct backtrace backtrace;
   register Lisp_Object *internal_args;
   ptrdiff_t i;
 
@@ -2614,12 +2644,8 @@
        error ("Lisp nesting exceeds `max-lisp-eval-depth'");
     }
 
-  backtrace.next = backtrace_list;
-  backtrace.function = args[0];
-  backtrace.args = &args[1];   /* This also GCPROs them.  */
-  backtrace.nargs = nargs - 1;
-  backtrace.debug_on_exit = 0;
-  backtrace_list = &backtrace;
+  /* This also GCPROs them.  */
+  record_in_backtrace (args[0], &args[1], nargs - 1);
 
   /* Call GC after setting up the backtrace, so the latter GCPROs the args.  */
   maybe_gc ();
@@ -2744,9 +2770,9 @@
     }
   check_cons_list ();
   lisp_eval_depth--;
-  if (backtrace.debug_on_exit)
+  if (backtrace_debug_on_exit (specpdl_ptr - 1))
     val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
-  backtrace_list = backtrace.next;
+  specpdl_ptr--;
   return val;
 }
 
@@ -2778,15 +2804,17 @@
 
   UNGCPRO;
 
-  backtrace_list->args = arg_vector;
-  backtrace_list->nargs = i;
+  set_backtrace_args (specpdl_ptr - 1, arg_vector);
+  set_backtrace_nargs (specpdl_ptr - 1, i);
   tem = funcall_lambda (fun, numargs, arg_vector);
 
   /* Do the debug-on-exit now, while arg_vector still exists.  */
-  if (backtrace_list->debug_on_exit)
-    tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil)));
-  /* Don't do it again when we return to eval.  */
-  backtrace_list->debug_on_exit = 0;
+  if (backtrace_debug_on_exit (specpdl_ptr - 1))
+    {
+      /* Don't do it again when we return to eval.  */
+      set_backtrace_debug_on_exit (specpdl_ptr - 1, false);
+      tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil)));
+    }
   SAFE_FREE ();
   return tem;
 }
@@ -2936,20 +2964,38 @@
   return object;
 }
 
-static void
-grow_specpdl (void)
-{
-  register ptrdiff_t count = SPECPDL_INDEX ();
-  ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX);
-  if (max_size <= specpdl_size)
-    {
-      if (max_specpdl_size < 400)
-       max_size = max_specpdl_size = 400;
-      if (max_size <= specpdl_size)
-       signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil);
-    }
-  specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl);
-  specpdl_ptr = specpdl + count;
+/* Return true if SYMBOL currently has a let-binding
+   which was made in the buffer that is now current.  */
+
+bool
+let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
+{
+  struct specbinding *p;
+  Lisp_Object buf = Fcurrent_buffer ();
+
+  for (p = specpdl_ptr; p > specpdl; )
+    if ((--p)->kind > SPECPDL_LET)
+      {
+       struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p));
+       eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS);
+       if (symbol == let_bound_symbol
+           && EQ (specpdl_where (p), buf))
+         return 1;
+      }
+
+  return 0;
+}
+
+bool
+let_shadows_global_binding_p (Lisp_Object symbol)
+{
+  struct specbinding *p;
+
+  for (p = specpdl_ptr; p > specpdl; )
+    if ((--p)->kind >= SPECPDL_LET && EQ (specpdl_symbol (p), symbol))
+      return 1;
+
+  return 0;
 }
 
 /* `specpdl_ptr->symbol' is a field which describes which variable is
@@ -2985,9 +3031,9 @@
     case SYMBOL_PLAINVAL:
       /* The most common case is that of a non-constant symbol with a
         trivial value.  Make that as fast as we can.  */
-      set_specpdl_symbol (symbol);
-      set_specpdl_old_value (SYMBOL_VAL (sym));
-      specpdl_ptr->func = NULL;
+      specpdl_ptr->kind = SPECPDL_LET;
+      specpdl_ptr->v.let.symbol = symbol;
+      specpdl_ptr->v.let.old_value = SYMBOL_VAL (sym);
       ++specpdl_ptr;
       if (!sym->constant)
        SET_SYMBOL_VAL (sym, value);
@@ -3000,59 +3046,36 @@
     case SYMBOL_FORWARDED:
       {
        Lisp_Object ovalue = find_symbol_value (symbol);
-       specpdl_ptr->func = 0;
-       set_specpdl_old_value (ovalue);
+       specpdl_ptr->kind = SPECPDL_LET_LOCAL;
+       specpdl_ptr->v.let.symbol = symbol;
+       specpdl_ptr->v.let.old_value = ovalue;
+       specpdl_ptr->v.let.where = Fcurrent_buffer ();
 
        eassert (sym->redirect != SYMBOL_LOCALIZED
-                || (EQ (SYMBOL_BLV (sym)->where,
-                        SYMBOL_BLV (sym)->frame_local ?
-                        Fselected_frame () : Fcurrent_buffer ())));
-
-       if (sym->redirect == SYMBOL_LOCALIZED
-           || BUFFER_OBJFWDP (SYMBOL_FWD (sym)))
-         {
-           Lisp_Object where, cur_buf = Fcurrent_buffer ();
-
-           /* For a local variable, record both the symbol and which
-              buffer's or frame's value we are saving.  */
-           if (!NILP (Flocal_variable_p (symbol, Qnil)))
-             {
-               eassert (sym->redirect != SYMBOL_LOCALIZED
-                        || (blv_found (SYMBOL_BLV (sym))
-                            && EQ (cur_buf, SYMBOL_BLV (sym)->where)));
-               where = cur_buf;
-             }
-           else if (sym->redirect == SYMBOL_LOCALIZED
-                    && blv_found (SYMBOL_BLV (sym)))
-             where = SYMBOL_BLV (sym)->where;
-           else
-             where = Qnil;
-
-           /* We're not using the `unused' slot in the specbinding
-              structure because this would mean we have to do more
-              work for simple variables.  */
-           /* FIXME: The third value `current_buffer' is only used in
-              let_shadows_buffer_binding_p which is itself only used
-              in set_internal for local_if_set.  */
-           eassert (NILP (where) || EQ (where, cur_buf));
-           set_specpdl_symbol (Fcons (symbol, Fcons (where, cur_buf)));
-
+                || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ())));
+
+       if (sym->redirect == SYMBOL_LOCALIZED)
+         {
+           if (!blv_found (SYMBOL_BLV (sym)))
+             specpdl_ptr->kind = SPECPDL_LET_DEFAULT;
+         }
+       else if (BUFFER_OBJFWDP (SYMBOL_FWD (sym)))
+         {
            /* If SYMBOL is a per-buffer variable which doesn't have a
               buffer-local value here, make the `let' change the global
               value by changing the value of SYMBOL in all buffers not
               having their own value.  This is consistent with what
               happens with other buffer-local variables.  */
-           if (NILP (where)
-               && sym->redirect == SYMBOL_FORWARDED)
+           if (NILP (Flocal_variable_p (symbol, Qnil)))
              {
-               eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym)));
+               specpdl_ptr->kind = SPECPDL_LET_DEFAULT;
                ++specpdl_ptr;
                Fset_default (symbol, value);
                return;
              }
          }
        else
-         set_specpdl_symbol (symbol);
+         specpdl_ptr->kind = SPECPDL_LET;
 
        specpdl_ptr++;
        set_internal (symbol, value, Qnil, 1);
@@ -3067,9 +3090,9 @@
 {
   if (specpdl_ptr == specpdl + specpdl_size)
     grow_specpdl ();
-  specpdl_ptr->func = function;
-  set_specpdl_symbol (Qnil);
-  set_specpdl_old_value (arg);
+  specpdl_ptr->kind = SPECPDL_UNWIND;
+  specpdl_ptr->v.unwind.func = function;
+  specpdl_ptr->v.unwind.arg = arg;
   specpdl_ptr++;
 }
 
@@ -3093,41 +3116,50 @@
       struct specbinding this_binding;
       this_binding = *--specpdl_ptr;
 
-      if (this_binding.func != 0)
-       (*this_binding.func) (this_binding.old_value);
-      /* If the symbol is a list, it is really (SYMBOL WHERE
-        . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
-        frame.  If WHERE is a buffer or frame, this indicates we
-        bound a variable that had a buffer-local or frame-local
-        binding.  WHERE nil means that the variable had the default
-        value when it was bound.  CURRENT-BUFFER is the buffer that
-        was current when the variable was bound.  */
-      else if (CONSP (this_binding.symbol))
+      switch (this_binding.kind)
        {
-         Lisp_Object symbol, where;
-
-         symbol = XCAR (this_binding.symbol);
-         where = XCAR (XCDR (this_binding.symbol));
-
-         if (NILP (where))
-           Fset_default (symbol, this_binding.old_value);
-         /* If `where' is non-nil, reset the value in the appropriate
-            local binding, but only if that binding still exists.  */
-         else if (BUFFERP (where)
-                  ? !NILP (Flocal_variable_p (symbol, where))
-                  : !NILP (Fassq (symbol, XFRAME (where)->param_alist)))
-           set_internal (symbol, this_binding.old_value, where, 1);
+       case SPECPDL_UNWIND:
+         (*specpdl_func (&this_binding)) (specpdl_arg (&this_binding));
+         break;
+       case SPECPDL_LET:
+         /* If variable has a trivial value (no forwarding), we can
+            just set it.  No need to check for constant symbols here,
+            since that was already done by specbind.  */
+         if (XSYMBOL (specpdl_symbol (&this_binding))->redirect
+             == SYMBOL_PLAINVAL)
+           SET_SYMBOL_VAL (XSYMBOL (specpdl_symbol (&this_binding)),
+                           specpdl_old_value (&this_binding));
+         else
+           /* NOTE: we only ever come here if make_local_foo was used for
+              the first time on this var within this let.  */
+           Fset_default (specpdl_symbol (&this_binding),
+                         specpdl_old_value (&this_binding));
+         break;
+       case SPECPDL_BACKTRACE:
+         break;
+       case SPECPDL_LET_LOCAL:
+       case SPECPDL_LET_DEFAULT:
+         { /* If the symbol is a list, it is really (SYMBOL WHERE
+            . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
+            frame.  If WHERE is a buffer or frame, this indicates we
+            bound a variable that had a buffer-local or frame-local
+            binding.  WHERE nil means that the variable had the default
+            value when it was bound.  CURRENT-BUFFER is the buffer that
+            was current when the variable was bound.  */
+           Lisp_Object symbol = specpdl_symbol (&this_binding);
+           Lisp_Object where = specpdl_where (&this_binding);
+           eassert (BUFFERP (where));
+
+           if (this_binding.kind == SPECPDL_LET_DEFAULT)
+             Fset_default (symbol, specpdl_old_value (&this_binding));
+           /* If this was a local binding, reset the value in the appropriate
+              buffer, but only if that buffer's binding still exists.  */
+           else if (!NILP (Flocal_variable_p (symbol, where)))
+             set_internal (symbol, specpdl_old_value (&this_binding),
+                           where, 1);
+         }
+         break;
        }
-      /* If variable has a trivial value (no forwarding), we can
-        just set it.  No need to check for constant symbols here,
-        since that was already done by specbind.  */
-      else if (XSYMBOL (this_binding.symbol)->redirect == SYMBOL_PLAINVAL)
-       SET_SYMBOL_VAL (XSYMBOL (this_binding.symbol),
-                       this_binding.old_value);
-      else
-       /* NOTE: we only ever come here if make_local_foo was used for
-          the first time on this var within this let.  */
-       Fset_default (this_binding.symbol, this_binding.old_value);
     }
 
   if (NILP (Vquit_flag) && !NILP (quitf))
@@ -3153,18 +3185,16 @@
 The debugger is entered when that frame exits, if the flag is non-nil.  */)
   (Lisp_Object level, Lisp_Object flag)
 {
-  register struct backtrace *backlist = backtrace_list;
+  struct specbinding *pdl = backtrace_top ();
   register EMACS_INT i;
 
   CHECK_NUMBER (level);
 
-  for (i = 0; backlist && i < XINT (level); i++)
-    {
-      backlist = backlist->next;
-    }
+  for (i = 0; backtrace_p (pdl) && i < XINT (level); i++)
+    pdl = backtrace_next (pdl);
 
-  if (backlist)
-    backlist->debug_on_exit = !NILP (flag);
+  if (backtrace_p (pdl))
+    set_backtrace_debug_on_exit (pdl, !NILP (flag));
 
   return flag;
 }
@@ -3174,58 +3204,41 @@
 Output stream used is value of `standard-output'.  */)
   (void)
 {
-  register struct backtrace *backlist = backtrace_list;
-  Lisp_Object tail;
+  struct specbinding *pdl = backtrace_top ();
   Lisp_Object tem;
-  struct gcpro gcpro1;
   Lisp_Object old_print_level = Vprint_level;
 
   if (NILP (Vprint_level))
     XSETFASTINT (Vprint_level, 8);
 
-  tail = Qnil;
-  GCPRO1 (tail);
-
-  while (backlist)
+  while (backtrace_p (pdl))
     {
-      write_string (backlist->debug_on_exit ? "* " : "  ", 2);
-      if (backlist->nargs == UNEVALLED)
+      write_string (backtrace_debug_on_exit (pdl) ? "* " : "  ", 2);
+      if (backtrace_nargs (pdl) == UNEVALLED)
        {
-         Fprin1 (Fcons (backlist->function, *backlist->args), Qnil);
+         Fprin1 (Fcons (backtrace_function (pdl), *backtrace_args (pdl)),
+                 Qnil);
          write_string ("\n", -1);
        }
       else
        {
-         tem = backlist->function;
+         tem = backtrace_function (pdl);
          Fprin1 (tem, Qnil);   /* This can QUIT.  */
          write_string ("(", -1);
-         if (backlist->nargs == MANY)
-           {                   /* FIXME: Can this happen?  */
-             bool later_arg = 0;
-             for (tail = *backlist->args; !NILP (tail); tail = Fcdr (tail))
-               {
-                 if (later_arg)
-                   write_string (" ", -1);
-                 Fprin1 (Fcar (tail), Qnil);
-                 later_arg = 1;
-               }
-           }
-         else
-           {
-             ptrdiff_t i;
-             for (i = 0; i < backlist->nargs; i++)
-               {
-                 if (i) write_string (" ", -1);
-                 Fprin1 (backlist->args[i], Qnil);
-               }
-           }
+         {
+           ptrdiff_t i;
+           for (i = 0; i < backtrace_nargs (pdl); i++)
+             {
+               if (i) write_string (" ", -1);
+               Fprin1 (backtrace_args (pdl)[i], Qnil);
+             }
+         }
          write_string (")\n", -1);
        }
-      backlist = backlist->next;
+      pdl = backtrace_next (pdl);
     }
 
   Vprint_level = old_print_level;
-  UNGCPRO;
   return Qnil;
 }
 
@@ -3241,53 +3254,84 @@
 If NFRAMES is more than the number of frames, the value is nil.  */)
   (Lisp_Object nframes)
 {
-  register struct backtrace *backlist = backtrace_list;
+  struct specbinding *pdl = backtrace_top ();
   register EMACS_INT i;
-  Lisp_Object tem;
 
   CHECK_NATNUM (nframes);
 
   /* Find the frame requested.  */
-  for (i = 0; backlist && i < XFASTINT (nframes); i++)
-    backlist = backlist->next;
+  for (i = 0; backtrace_p (pdl) && i < XFASTINT (nframes); i++)
+    pdl = backtrace_next (pdl);
 
-  if (!backlist)
+  if (!backtrace_p (pdl))
     return Qnil;
-  if (backlist->nargs == UNEVALLED)
-    return Fcons (Qnil, Fcons (backlist->function, *backlist->args));
+  if (backtrace_nargs (pdl) == UNEVALLED)
+    return Fcons (Qnil,
+                 Fcons (backtrace_function (pdl), *backtrace_args (pdl)));
   else
     {
-      if (backlist->nargs == MANY) /* FIXME: Can this happen?  */
-       tem = *backlist->args;
-      else
-       tem = Flist (backlist->nargs, backlist->args);
+      Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl));
 
-      return Fcons (Qt, Fcons (backlist->function, tem));
+      return Fcons (Qt, Fcons (backtrace_function (pdl), tem));
     }
 }
 
 
-#if BYTE_MARK_STACK
-void
-mark_backtrace (void)
-{
-  register struct backtrace *backlist;
-  ptrdiff_t i;
-
-  for (backlist = backtrace_list; backlist; backlist = backlist->next)
-    {
-      mark_object (backlist->function);
-
-      if (backlist->nargs == UNEVALLED
-         || backlist->nargs == MANY) /* FIXME: Can this happen?  */
-       i = 1;
+void
+mark_specpdl (void)
+{
+  struct specbinding *pdl;
+  for (pdl = specpdl; pdl != specpdl_ptr; pdl++)
+    {
+      switch (pdl->kind)
+       {
+       case SPECPDL_UNWIND:
+         mark_object (specpdl_arg (pdl));
+         break;
+       case SPECPDL_BACKTRACE:
+         {
+           ptrdiff_t nargs = backtrace_nargs (pdl);
+           mark_object (backtrace_function (pdl));
+           if (nargs == UNEVALLED)
+             nargs = 1;
+           while (nargs--)
+             mark_object (backtrace_args (pdl)[nargs]);
+         }
+         break;
+       case SPECPDL_LET_DEFAULT:
+       case SPECPDL_LET_LOCAL:
+         mark_object (specpdl_where (pdl));
+       case SPECPDL_LET:
+         mark_object (specpdl_symbol (pdl));
+         mark_object (specpdl_old_value (pdl));
+       }
+    }
+}
+
+void
+get_backtrace (Lisp_Object array)
+{
+  struct specbinding *pdl = backtrace_next (backtrace_top ());
+  ptrdiff_t i = 0, asize = ASIZE (array);
+
+  /* Copy the backtrace contents into working memory.  */
+  for (; i < asize; i++)
+    {
+      if (backtrace_p (pdl))
+       {
+         ASET (array, i, backtrace_function (pdl));
+         pdl = backtrace_next (pdl);
+       }
       else
-       i = backlist->nargs;
-      while (i--)
-       mark_object (backlist->args[i]);
+       ASET (array, i, Qnil);
     }
 }
-#endif
+
+Lisp_Object backtrace_top_function (void)
+{
+  struct specbinding *pdl = backtrace_top ();
+  return (backtrace_p (pdl) ? backtrace_function (pdl) : Qnil);
+}
 
 void
 syms_of_eval (void)

=== modified file 'src/lisp.h'
--- a/src/lisp.h        2013-05-15 18:54:49 +0000
+++ b/src/lisp.h        2013-06-03 09:01:53 +0000
@@ -73,6 +73,7 @@
     BITS_PER_SHORT     = CHAR_BIT * sizeof (short),
     BITS_PER_INT       = CHAR_BIT * sizeof (int),
     BITS_PER_LONG      = CHAR_BIT * sizeof (long int),
+    BITS_PER_PTRDIFF_T = CHAR_BIT * sizeof (ptrdiff_t),
     BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT)
   };
 
@@ -2176,12 +2177,24 @@
 #endif
 
 
+/* Elisp uses several stacks:
+   - the C stack.
+   - the bytecode stack: used internally by the bytecode interpreter.
+     Allocated from the C stack.
+   - The specpdl stack: keeps track of active unwind-protect and
+     dynamic-let-bindings.  Allocated from the `specpdl' array, a manually
+     managed stack.
+   - The catch stack: keeps track of active catch tags.
+     Allocated on the C stack.  This is where the setmp data is kept.
+   - The handler stack: keeps track of active condition-case handlers.
+     Allocated on the C stack.  Every entry there also uses an entry in
+     the catch stack.  */
+
 /* Structure for recording Lisp call stack for backtrace purposes.  */
 
 /* The special binding stack holds the outer values of variables while
    they are bound by a function application or a let form, stores the
-   code to be executed for Lisp unwind-protect forms, and stores the C
-   functions to be called for record_unwind_protect.
+   code to be executed for unwind-protect forms.
 
    If func is non-zero, undoing this binding applies func to old_value;
       This implements record_unwind_protect.
@@ -2194,35 +2207,77 @@
    which means having bound a local value while CURRENT-BUFFER was active.
    If WHERE is nil this means we saw the default value when binding SYMBOL.
    WHERE being a buffer or frame means we saw a buffer-local or frame-local
-   value.  Other values of WHERE mean an internal error.  */
+   value.  Other values of WHERE mean an internal error.
+
+   NOTE: The specbinding struct is defined here, because SPECPDL_INDEX is
+   used all over the place, needs to be fast, and needs to know the size of
+   struct specbinding.  But only eval.c should access it.  */
 
 typedef Lisp_Object (*specbinding_func) (Lisp_Object);
 
+enum specbind_tag {
+  SPECPDL_UNWIND,              /* An unwind_protect function.  */
+  SPECPDL_BACKTRACE,           /* An element of the backtrace.  */
+  SPECPDL_LET,                 /* A plain and simple dynamic let-binding.  */
+  /* Tags greater than SPECPDL_LET must be "subkinds" of LET.  */
+  SPECPDL_LET_LOCAL,           /* A buffer-local let-binding.  */
+  SPECPDL_LET_DEFAULT          /* A global binding for a localized var.  */
+};
+
 struct specbinding
   {
-    Lisp_Object symbol, old_value;
-    specbinding_func func;
-    Lisp_Object unused;                /* Dividing by 16 is faster than by 12. 
 */
+    enum specbind_tag kind;
+    union {
+      struct {
+       Lisp_Object arg;
+       specbinding_func func;
+      } unwind;
+      struct {
+       /* `where' is not used in the case of SPECPDL_LET.  */
+       Lisp_Object symbol, old_value, where;
+      } let;
+      struct {
+       Lisp_Object function;
+       Lisp_Object *args;
+       ptrdiff_t nargs : BITS_PER_PTRDIFF_T - 1;
+       bool debug_on_exit : 1;
+      } bt;
+    } v;
   };
 
+LISP_INLINE Lisp_Object specpdl_symbol (struct specbinding *pdl)
+{ eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.symbol; }
+
+LISP_INLINE Lisp_Object specpdl_old_value (struct specbinding *pdl)
+{ eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.old_value; }
+
+LISP_INLINE Lisp_Object specpdl_where (struct specbinding *pdl)
+{ eassert (pdl->kind > SPECPDL_LET); return pdl->v.let.where; }
+
+LISP_INLINE Lisp_Object specpdl_arg (struct specbinding *pdl)
+{ eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.arg; }
+
+LISP_INLINE specbinding_func specpdl_func (struct specbinding *pdl)
+{ eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.func; }
+
+LISP_INLINE Lisp_Object backtrace_function (struct specbinding *pdl)
+{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.function; }
+
+LISP_INLINE ptrdiff_t backtrace_nargs (struct specbinding *pdl)
+{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.nargs; }
+
+LISP_INLINE Lisp_Object *backtrace_args (struct specbinding *pdl)
+{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.args; }
+
+LISP_INLINE bool backtrace_debug_on_exit (struct specbinding *pdl)
+{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.debug_on_exit; }
+
 extern struct specbinding *specpdl;
 extern struct specbinding *specpdl_ptr;
 extern ptrdiff_t specpdl_size;
 
 #define SPECPDL_INDEX()        (specpdl_ptr - specpdl)
 
-struct backtrace
-{
-  struct backtrace *next;
-  Lisp_Object function;
-  Lisp_Object *args;   /* Points to vector of args.  */
-  ptrdiff_t nargs;     /* Length of vector.  */
-  /* Nonzero means call value of debugger when done with this operation.  */
-  unsigned int debug_on_exit : 1;
-};
-
-extern struct backtrace *backtrace_list;
-
 /* Everything needed to describe an active condition case.
 
    Members are volatile if their values need to survive _longjmp when
@@ -2277,9 +2332,10 @@
   Lisp_Object tag;
   Lisp_Object volatile val;
   struct catchtag *volatile next;
+#if 1 /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but they're defined later.  */
   struct gcpro *gcpro;
+#endif
   sys_jmp_buf jmp;
-  struct backtrace *backlist;
   struct handler *handlerlist;
   EMACS_INT lisp_eval_depth;
   ptrdiff_t volatile pdlcount;
@@ -3337,10 +3393,15 @@
 extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
 extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
 extern void init_eval (void);
-#if BYTE_MARK_STACK
-extern void mark_backtrace (void);
-#endif
 extern void syms_of_eval (void);
+extern void record_in_backtrace (Lisp_Object function,
+                                Lisp_Object *args, ptrdiff_t nargs);
+extern void mark_specpdl (void);
+extern void get_backtrace (Lisp_Object array);
+Lisp_Object backtrace_top_function (void);
+extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
+extern bool let_shadows_global_binding_p (Lisp_Object symbol);
+
 
 /* Defined in editfns.c.  */
 extern Lisp_Object Qfield;

=== modified file 'src/profiler.c'
--- a/src/profiler.c    2013-03-24 12:59:45 +0000
+++ b/src/profiler.c    2013-06-03 09:01:53 +0000
@@ -138,10 +138,8 @@
 static void
 record_backtrace (log_t *log, EMACS_INT count)
 {
-  struct backtrace *backlist = backtrace_list;
   Lisp_Object backtrace;
-  ptrdiff_t index, i = 0;
-  ptrdiff_t asize;
+  ptrdiff_t index;
 
   if (!INTEGERP (log->next_free))
     /* FIXME: transfer the evicted counts to a special entry rather
@@ -151,16 +149,7 @@
 
   /* Get a "working memory" vector.  */
   backtrace = HASH_KEY (log, index);
-  asize = ASIZE (backtrace);
-
-  /* Copy the backtrace contents into working memory.  */
-  for (; i < asize && backlist; i++, backlist = backlist->next)
-    /* FIXME: For closures we should ignore the environment.  */
-    ASET (backtrace, i, backlist->function);
-
-  /* Make sure that unused space of working memory is filled with nil.  */
-  for (; i < asize; i++)
-    ASET (backtrace, i, Qnil);
+  get_backtrace (backtrace);
 
   { /* We basically do a `gethash+puthash' here, except that we have to be
        careful to avoid memory allocation since we're in a signal
@@ -232,7 +221,7 @@
 static void
 handle_profiler_signal (int signal)
 {
-  if (backtrace_list && EQ (backtrace_list->function, Qautomatic_gc))
+  if (EQ (backtrace_top_function (), Qautomatic_gc))
     /* Special case the time-count inside GC because the hash-table
        code is not prepared to be used while the GC is running.
        More specifically it uses ASIZE at many places where it does

=== modified file 'src/xdisp.c'
--- a/src/xdisp.c       2013-05-27 16:54:33 +0000
+++ b/src/xdisp.c       2013-06-03 09:01:53 +0000
@@ -12846,7 +12846,6 @@
   struct frame *sf;
   int polling_stopped_here = 0;
   Lisp_Object tail, frame;
-  struct backtrace backtrace;
 
   /* Non-zero means redisplay has to consider all windows on all
      frames.  Zero means, only selected_window is considered.  */
@@ -12890,12 +12889,7 @@
   specbind (Qinhibit_free_realized_faces, Qnil);
 
   /* Record this function, so it appears on the profiler's backtraces.  */
-  backtrace.next = backtrace_list;
-  backtrace.function = Qredisplay_internal;
-  backtrace.args = &Qnil;
-  backtrace.nargs = 0;
-  backtrace.debug_on_exit = 0;
-  backtrace_list = &backtrace;
+  record_in_backtrace (Qredisplay_internal, &Qnil, 0);
 
   FOR_EACH_FRAME (tail, frame)
     XFRAME (frame)->already_hscrolled_p = 0;
@@ -13532,7 +13526,6 @@
 #endif /* HAVE_WINDOW_SYSTEM */
 
  end_of_redisplay:
-  backtrace_list = backtrace.next;
   unbind_to (count, Qnil);
   RESUME_POLLING;
 }


reply via email to

[Prev in Thread] Current Thread [Next in Thread]