1 files changed, 154 insertions, 64 deletions

diff --git a/src/eval.c b/src/eval.c
index 37ea81ba1cb..451a7b0cc28 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -76,17 +76,19 @@ Lisp_Object Vrun_hooks;
 
 Lisp_Object Vautoload_queue;
 
-/* Current number of specbindings allocated in specpdl.  */
+/* Current number of specbindings allocated in specpdl, not counting
+   the dummy entry specpdl[-1].  */
 
 /* ptrdiff_t specpdl_size; */
 
-/* Pointer to beginning of specpdl.  */
+/* Pointer to beginning of specpdl.  A dummy entry specpdl[-1] exists
+   only so that its address can be taken.  */
 
-/* struct specbinding *specpdl; */
+/* union specbinding *specpdl; */
 
 /* Pointer to first unused element in specpdl.  */
 
-/* struct specbinding *specpdl_ptr; */
+/* union specbinding *specpdl_ptr; */
 
 /* Depth in Lisp evaluations and function calls.  */
 
@@ -115,40 +117,120 @@ Lisp_Object inhibit_lisp_code;
 static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
 static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
 
+static Lisp_Object
+specpdl_symbol (union specbinding *pdl)
+{
+  eassert (pdl->kind >= SPECPDL_LET);
+  return pdl->let.symbol;
+}
+
+static Lisp_Object
+specpdl_old_value (union specbinding *pdl)
+{
+  eassert (pdl->kind >= SPECPDL_LET);
+  return pdl->let.old_value;
+}
+
+static Lisp_Object
+specpdl_where (union specbinding *pdl)
+{
+  eassert (pdl->kind > SPECPDL_LET);
+  return pdl->let.where;
+}
+
+static Lisp_Object
+specpdl_saved_value (union specbinding *pdl)
+{
+  eassert (pdl->kind >= SPECPDL_LET);
+  return pdl->let.saved_value;
+}
+
+static Lisp_Object
+specpdl_arg (union specbinding *pdl)
+{
+  eassert (pdl->kind == SPECPDL_UNWIND);
+  return pdl->unwind.arg;
+}
+
+static specbinding_func
+specpdl_func (union specbinding *pdl)
+{
+  eassert (pdl->kind == SPECPDL_UNWIND);
+  return pdl->unwind.func;
+}
+
+static Lisp_Object
+backtrace_function (union specbinding *pdl)
+{
+  eassert (pdl->kind == SPECPDL_BACKTRACE);
+  return pdl->bt.function;
+}
+
+static ptrdiff_t
+backtrace_nargs (union specbinding *pdl)
+{
+  eassert (pdl->kind == SPECPDL_BACKTRACE);
+  return pdl->bt.nargs;
+}
+
+static Lisp_Object *
+backtrace_args (union specbinding *pdl)
+{
+  eassert (pdl->kind == SPECPDL_BACKTRACE);
+  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
-set_backtrace_args (struct specbinding *pdl, Lisp_Object *args)
-{ eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.args = args; }
+set_backtrace_args (union specbinding *pdl, Lisp_Object *args)
+{
+  eassert (pdl->kind == SPECPDL_BACKTRACE);
+  pdl->bt.args = args;
+}
 
 static void
-set_backtrace_nargs (struct specbinding *pdl, ptrdiff_t n)
-{ eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.nargs = n; }
+set_backtrace_nargs (union specbinding *pdl, ptrdiff_t n)
+{
+  eassert (pdl->kind == SPECPDL_BACKTRACE);
+  pdl->bt.nargs = n;
+}
 
 static void
-set_backtrace_debug_on_exit (struct specbinding *pdl, bool doe)
-{ eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.debug_on_exit = doe; }
+set_backtrace_debug_on_exit (union specbinding *pdl, bool doe)
+{
+  eassert (pdl->kind == SPECPDL_BACKTRACE);
+  pdl->bt.debug_on_exit = doe;
+}
 
 /* Helper functions to scan the backtrace.  */
 
-bool backtrace_p (struct specbinding *) EXTERNALLY_VISIBLE;
-struct specbinding *backtrace_top (void) EXTERNALLY_VISIBLE;
-struct specbinding *backtrace_next (struct specbinding *pdl) EXTERNALLY_VISIBLE;
+bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE;
+union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE;
+union specbinding *backtrace_next (union specbinding *pdl) EXTERNALLY_VISIBLE;
 
-bool backtrace_p (struct specbinding *pdl)
+bool
+backtrace_p (union specbinding *pdl)
 { return pdl >= specpdl; }
 
-struct specbinding *
+union specbinding *
 backtrace_top (void)
 {
-  struct specbinding *pdl = specpdl_ptr - 1;
+  union specbinding *pdl = specpdl_ptr - 1;
   while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE)
     pdl--;
   return pdl;
 }
 
-struct specbinding *
-backtrace_next (struct specbinding *pdl)
+union specbinding *
+backtrace_next (union specbinding *pdl)
 {
   pdl--;
   while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE)
@@ -161,9 +243,9 @@ void
 init_eval_once (void)
 {
   enum { size = 50 };
-  specpdl = xmalloc (size * sizeof *specpdl);
+  union specbinding *pdlvec = xmalloc ((size + 1) * sizeof *specpdl);
   specpdl_size = size;
-  specpdl_ptr = specpdl;
+  specpdl = specpdl_ptr = pdlvec + 1;
   /* Don't forget to update docs (lispref node "Local Variables").  */
   max_specpdl_size = 1300; /* 1000 is not enough for CEDET's c-by.el.  */
   max_lisp_eval_depth = 600;
@@ -565,7 +647,7 @@ The return value is BASE-VARIABLE.  */)
     set_internal (base_variable, find_symbol_value (new_alias), Qnil, 1);
 
   {
-    struct specbinding *p;
+    union specbinding *p;
 
     for (p = specpdl_ptr; p > specpdl; )
       if ((--p)->kind >= SPECPDL_LET
@@ -631,7 +713,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
       else
 	{ /* Check if there is really a global binding rather than just a let
 	     binding that shadows the global unboundness of the var.  */
-	  struct specbinding *pdl = specpdl_ptr;
+	  union specbinding *pdl = specpdl_ptr;
 	  while (pdl > specpdl)
 	    {
 	      if ((--pdl)->kind >= SPECPDL_LET
@@ -1430,7 +1512,7 @@ See also the function `condition-case'.  */)
   Vsignaling_function = Qnil;
   if (!NILP (error_symbol))
     {
-      struct specbinding *pdl = backtrace_next (backtrace_top ());
+      union specbinding *pdl = backtrace_next (backtrace_top ());
       if (backtrace_p (pdl) && EQ (backtrace_function (pdl), Qerror))
 	pdl = backtrace_next (pdl);
       if (backtrace_p (pdl))
@@ -1934,8 +2016,10 @@ If LEXICAL is t, evaluate using lexical scoping.  */)
 static void
 grow_specpdl (void)
 {
-  register ptrdiff_t count = SPECPDL_INDEX ();
-  ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX);
+  ptrdiff_t count = SPECPDL_INDEX ();
+  ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000);
+  union specbinding *pdlvec = specpdl - 1;
+  ptrdiff_t pdlvecsize = specpdl_size + 1;
   if (max_size <= specpdl_size)
     {
       if (max_specpdl_size < 400)
@@ -1943,7 +2027,9 @@ grow_specpdl (void)
       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);
+  pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl);
+  specpdl = pdlvec + 1;
+  specpdl_size = pdlvecsize - 1;
   specpdl_ptr = specpdl + count;
 }
 
@@ -1953,11 +2039,11 @@ 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->bt.kind = SPECPDL_BACKTRACE;
+  specpdl_ptr->bt.debug_on_exit = false;
+  specpdl_ptr->bt.function = function;
+  specpdl_ptr->bt.args = args;
+  specpdl_ptr->bt.nargs = nargs;
   specpdl_ptr++;
 }
 
@@ -2994,7 +3080,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
 bool
 let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
 {
-  struct specbinding *p;
+  union specbinding *p;
   Lisp_Object buf = Fcurrent_buffer ();
 
   for (p = specpdl_ptr; p > specpdl; )
@@ -3013,7 +3099,7 @@ let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
 bool
 let_shadows_global_binding_p (Lisp_Object symbol)
 {
-  struct specbinding *p;
+  union specbinding *p;
 
   for (p = specpdl_ptr; p > specpdl; )
     if ((--p)->kind >= SPECPDL_LET && EQ (specpdl_symbol (p), symbol))
@@ -3023,7 +3109,7 @@ let_shadows_global_binding_p (Lisp_Object symbol)
 }
 
 static Lisp_Object
-binding_symbol (struct specbinding *bind)
+binding_symbol (union specbinding *bind)
 {
   if (!CONSP (specpdl_symbol (bind)))
     return specpdl_symbol (bind);
@@ -3031,7 +3117,7 @@ binding_symbol (struct specbinding *bind)
 }
 
 void
-do_specbind (struct Lisp_Symbol *sym, struct specbinding *bind,
+do_specbind (struct Lisp_Symbol *sym, union specbinding *bind,
 	     Lisp_Object value)
 {
   switch (sym->redirect)
@@ -3101,10 +3187,10 @@ specbind (Lisp_Object symbol, Lisp_Object value)
     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.  */
-      specpdl_ptr->kind = SPECPDL_LET;
-      specpdl_ptr->v.let.symbol = symbol;
-      specpdl_ptr->v.let.old_value = SYMBOL_VAL (sym);
-      specpdl_ptr->v.let.saved_value = Qnil;
+      specpdl_ptr->let.kind = SPECPDL_LET;
+      specpdl_ptr->let.symbol = symbol;
+      specpdl_ptr->let.old_value = SYMBOL_VAL (sym);
+      specpdl_ptr->let.saved_value = Qnil;
       ++specpdl_ptr;
       do_specbind (sym, specpdl_ptr - 1, value);
       break;
@@ -3114,11 +3200,11 @@ specbind (Lisp_Object symbol, Lisp_Object value)
     case SYMBOL_FORWARDED:
       {
 	Lisp_Object ovalue = find_symbol_value (symbol);
-	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 ();
-	specpdl_ptr->v.let.saved_value = Qnil;
+	specpdl_ptr->let.kind = SPECPDL_LET_LOCAL;
+	specpdl_ptr->let.symbol = symbol;
+	specpdl_ptr->let.old_value = ovalue;
+	specpdl_ptr->let.where = Fcurrent_buffer ();
+	specpdl_ptr->let.saved_value = Qnil;
 
 	eassert (sym->redirect != SYMBOL_LOCALIZED
 		 || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ())));
@@ -3126,7 +3212,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
 	if (sym->redirect == SYMBOL_LOCALIZED)
 	  {
 	    if (!blv_found (SYMBOL_BLV (sym)))
-	      specpdl_ptr->kind = SPECPDL_LET_DEFAULT;
+	      specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
 	  }
 	else if (BUFFER_OBJFWDP (SYMBOL_FWD (sym)))
 	  {
@@ -3137,14 +3223,14 @@ specbind (Lisp_Object symbol, Lisp_Object value)
 	       happens with other buffer-local variables.  */
 	    if (NILP (Flocal_variable_p (symbol, Qnil)))
 	      {
-		specpdl_ptr->kind = SPECPDL_LET_DEFAULT;
+		specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
 		++specpdl_ptr;
 		do_specbind (sym, specpdl_ptr - 1, value);
 		return;
 	      }
 	  }
 	else
-	  specpdl_ptr->kind = SPECPDL_LET;
+	  specpdl_ptr->let.kind = SPECPDL_LET;
 
 	specpdl_ptr++;
 	do_specbind (sym, specpdl_ptr - 1, value);
@@ -3159,16 +3245,16 @@ record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
 {
   if (specpdl_ptr == specpdl + specpdl_size)
     grow_specpdl ();
-  specpdl_ptr->kind = SPECPDL_UNWIND;
-  specpdl_ptr->v.unwind.func = function;
-  specpdl_ptr->v.unwind.arg = arg;
+  specpdl_ptr->unwind.kind = SPECPDL_UNWIND;
+  specpdl_ptr->unwind.func = function;
+  specpdl_ptr->unwind.arg = arg;
   specpdl_ptr++;
 }
 
 void
 rebind_for_thread_switch (void)
 {
-  struct specbinding *bind;
+  union specbinding *bind;
 
   for (bind = specpdl; bind != specpdl_ptr; ++bind)
     {
@@ -3176,20 +3262,20 @@ rebind_for_thread_switch (void)
 	{
 	  Lisp_Object value = specpdl_saved_value (bind);
 
-	  bind->v.let.saved_value = Qnil;
+	  bind->let.saved_value = Qnil;
 	  do_specbind (XSYMBOL (binding_symbol (bind)), bind, value);
 	}
     }
 }
 
 static void
-do_one_unbind (struct specbinding *this_binding, int unwinding)
+do_one_unbind (union specbinding *this_binding, int unwinding)
 {
   eassert (unwinding || this_binding->kind >= SPECPDL_LET);
   switch (this_binding->kind)
     {
     case SPECPDL_UNWIND:
-      (*specpdl_func (this_binding)) (specpdl_arg (this_binding));
+      specpdl_func (this_binding) (specpdl_arg (this_binding));
       break;
     case SPECPDL_LET:
       /* If variable has a trivial value (no forwarding), we can
@@ -3249,7 +3335,7 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
 	 the same entry again, and we copy the binding first
 	 in case more bindings are made during some of the code we run.  */
 
-      struct specbinding this_binding;
+      union specbinding this_binding;
       this_binding = *--specpdl_ptr;
 
       do_one_unbind (&this_binding, 1);
@@ -3265,13 +3351,13 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
 void
 unbind_for_thread_switch (void)
 {
-  struct specbinding *bind;
+  union specbinding *bind;
 
   for (bind = specpdl_ptr; bind != specpdl; --bind)
     {
       if (bind->kind >= SPECPDL_LET)
 	{
-	  bind->v.let.saved_value = find_symbol_value (binding_symbol (bind));
+	  bind->let.saved_value = find_symbol_value (binding_symbol (bind));
 	  do_one_unbind (bind, 0);
 	}
     }
@@ -3293,7 +3379,7 @@ DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
 The debugger is entered when that frame exits, if the flag is non-nil.  */)
   (Lisp_Object level, Lisp_Object flag)
 {
-  struct specbinding *pdl = backtrace_top ();
+  union specbinding *pdl = backtrace_top ();
   register EMACS_INT i;
 
   CHECK_NUMBER (level);
@@ -3312,7 +3398,7 @@ DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
 Output stream used is value of `standard-output'.  */)
   (void)
 {
-  struct specbinding *pdl = backtrace_top ();
+  union specbinding *pdl = backtrace_top ();
   Lisp_Object tem;
   Lisp_Object old_print_level = Vprint_level;
 
@@ -3362,7 +3448,7 @@ or a lambda expression for macro calls.
 If NFRAMES is more than the number of frames, the value is nil.  */)
   (Lisp_Object nframes)
 {
-  struct specbinding *pdl = backtrace_top ();
+  union specbinding *pdl = backtrace_top ();
   register EMACS_INT i;
 
   CHECK_NATNUM (nframes);
@@ -3386,9 +3472,9 @@ If NFRAMES is more than the number of frames, the value is nil.  */)
 
 
 void
-mark_specpdl (struct specbinding *first, struct specbinding *ptr)
+mark_specpdl (union specbinding *first, union specbinding *ptr)
 {
-  struct specbinding *pdl;
+  union specbinding *pdl;
   for (pdl = first; pdl != ptr; pdl++)
     {
       switch (pdl->kind)
@@ -3396,6 +3482,7 @@ mark_specpdl (struct specbinding *first, struct specbinding *ptr)
 	case SPECPDL_UNWIND:
 	  mark_object (specpdl_arg (pdl));
 	  break;
+
 	case SPECPDL_BACKTRACE:
 	  {
 	    ptrdiff_t nargs = backtrace_nargs (pdl);
@@ -3406,13 +3493,16 @@ mark_specpdl (struct specbinding *first, struct specbinding *ptr)
 	      mark_object (backtrace_args (pdl)[nargs]);
 	  }
 	  break;
+
 	case SPECPDL_LET_DEFAULT:
 	case SPECPDL_LET_LOCAL:
 	  mark_object (specpdl_where (pdl));
+	  /* Fall through.  */
 	case SPECPDL_LET:
 	  mark_object (specpdl_symbol (pdl));
 	  mark_object (specpdl_old_value (pdl));
 	  mark_object (specpdl_saved_value (pdl));
+	  break;
 	}
     }
 }
@@ -3420,7 +3510,7 @@ mark_specpdl (struct specbinding *first, struct specbinding *ptr)
 void
 get_backtrace (Lisp_Object array)
 {
-  struct specbinding *pdl = backtrace_next (backtrace_top ());
+  union specbinding *pdl = backtrace_next (backtrace_top ());
   ptrdiff_t i = 0, asize = ASIZE (array);
 
   /* Copy the backtrace contents into working memory.  */
@@ -3438,7 +3528,7 @@ get_backtrace (Lisp_Object array)
 
 Lisp_Object backtrace_top_function (void)
 {
-  struct specbinding *pdl = backtrace_top ();
+  union specbinding *pdl = backtrace_top ();
   return (backtrace_p (pdl) ? backtrace_function (pdl) : Qnil);
 }