emacs: src/eval.c comparison

comparison src/eval.c @ 90199:bb71c6cf2009

Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-67 Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 447-458) - Update from CVS - Update from CVS: lisp/subr.el (add-to-ordered-list): Doc fix. - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 83-85) - Merge from emacs--cvs-trunk--0 - Update from CVS

author	Miles Bader <miles@gnu.org>
date	Thu, 30 Jun 2005 00:31:46 +0000
parents	b7da78284d4c 090fb73237c3
children	f9a65d7ebd29

comparison

equal deleted inserted replaced

-:97f6c3a96df1
+:bb71c6cf2009
 #endif
 /* This is less than the initial value of num_nonmacro_input_events.  */
 when_entered_debugger = -1;
 }
+/* unwind-protect function used by call_debugger.  */
+static Lisp_Object
+restore_stack_limits (data)
+Lisp_Object data;
+{
+max_specpdl_size = XINT (XCAR (data));
+max_lisp_eval_depth = XINT (XCDR (data));
+}
+/* Call the Lisp debugger, giving it argument ARG.  */
 Lisp_Object
 call_debugger (arg)
 Lisp_Object arg;
 {
 int debug_while_redisplaying;
 int count = SPECPDL_INDEX ();
 Lisp_Object val;
+int old_max = max_specpdl_size;
-if (lisp_eval_depth + 20 > max_lisp_eval_depth)
-max_lisp_eval_depth = lisp_eval_depth + 20;
+/* Temporarily bump up the stack limits,
+so the debugger won't run out of stack.  */
-if (specpdl_size + 40 > max_specpdl_size)
-max_specpdl_size = specpdl_size + 40;
+max_specpdl_size += 1;
+record_unwind_protect (restore_stack_limits,
+			 Fcons (make_number (old_max),
+				make_number (max_lisp_eval_depth)));
+max_specpdl_size = old_max;
+if (lisp_eval_depth + 40 > max_lisp_eval_depth)
+max_lisp_eval_depth = lisp_eval_depth + 40;
+if (SPECPDL_INDEX () + 100 > max_specpdl_size)
+max_specpdl_size = SPECPDL_INDEX () + 100;
 #ifdef HAVE_X_WINDOWS
 if (display_hourglass_p)
 cancel_hourglass ();
 #endif
 debug_while_redisplaying = redisplaying_p;
 redisplaying_p = 0;
 specbind (intern ("debugger-may-continue"),
 	    debug_while_redisplaying ? Qnil : Qt);
 specbind (Qinhibit_redisplay, Qnil);
+specbind (Qdebug_on_error, Qnil);
 #if 0 /* Binding this prevents execution of Lisp code during
 	 redisplay, which necessarily leads to display problems.  */
 specbind (Qinhibit_eval_during_redisplay, Qt);
 #endif
 Lisp_Object args;
 {
 register Lisp_Object sym, tem, tail;
 sym = Fcar (args);
+if (SYMBOL_CONSTANT_P (sym))
+error ("Constant symbol `%s' specified in defvar",
+SDATA (SYMBOL_NAME (sym)));
 tail = Fcdr (args);
 if (!NILP (Fcdr (Fcdr (tail))))
 error ("Too many arguments");
 tem = Fdefault_boundp (sym);
 }
 LOADHIST_ATTACH (sym);
 return sym;
 }
+/* Error handler used in Fuser_variable_p.  */
+static Lisp_Object
+user_variable_p_eh (ignore)
+Lisp_Object ignore;
+{
+return Qnil;
+}
 DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0,
-doc: /* Returns t if VARIABLE is intended to be set and modified by users.
+doc: /* Return t if VARIABLE is intended to be set and modified by users.
 \(The alternative is a variable used internally in a Lisp program.)
-Determined by whether the first character of the documentation
+A variable is a user variable if
-for the variable is `*' or if the variable is customizable (has a non-nil
+\(1) the first character of its documentation is `*', or
-value of `standard-value' or of `custom-autoload' on its property list).  */)
+\(2) it is customizable (its property list contains a non-nil value
+of `standard-value' or `custom-autoload'), or
+\(3) it is an alias for another user variable.
+Return nil if VARIABLE is an alias and there is a loop in the
+chain of symbols.  */)
 (variable)
 Lisp_Object variable;
 {
 Lisp_Object documentation;
 if (!SYMBOLP (variable))
 return Qnil;
-documentation = Fget (variable, Qvariable_documentation);
+/* If indirect and there's an alias loop, don't check anything else.  */
-if (INTEGERP (documentation) && XINT (documentation) < 0)
+if (XSYMBOL (variable)->indirect_variable
-return Qt;
+&& NILP (internal_condition_case_1 (indirect_variable, variable,
-if (STRINGP (documentation)
+Qt, user_variable_p_eh)))
-&& ((unsigned char) SREF (documentation, 0) == '*'))
+return Qnil;
-return Qt;
-/* If it is (STRING . INTEGER), a negative integer means a user variable.  */
+while (1)
-if (CONSP (documentation)
+{
-&& STRINGP (XCAR (documentation))
+documentation = Fget (variable, Qvariable_documentation);
-&& INTEGERP (XCDR (documentation))
+if (INTEGERP (documentation) && XINT (documentation) < 0)
-&& XINT (XCDR (documentation)) < 0)
+return Qt;
-return Qt;
+if (STRINGP (documentation)
-/* Customizable?  See `custom-variable-p'. */
+&& ((unsigned char) SREF (documentation, 0) == '*'))
-if ((!NILP (Fget (variable, intern ("standard-value"))))
+return Qt;
-|| (!NILP (Fget (variable, intern ("custom-autoload")))))
+/* If it is (STRING . INTEGER), a negative integer means a user variable.  */
-return Qt;
+if (CONSP (documentation)
-return Qnil;
+&& STRINGP (XCAR (documentation))
+&& INTEGERP (XCDR (documentation))
+&& XINT (XCDR (documentation)) < 0)
+return Qt;
+/* Customizable?  See `custom-variable-p'.  */
+if ((!NILP (Fget (variable, intern ("standard-value"))))
+|| (!NILP (Fget (variable, intern ("custom-autoload")))))
+return Qt;
+if (!XSYMBOL (variable)->indirect_variable)
+return Qnil;
+/* An indirect variable?  Let's follow the chain.  */
+variable = XSYMBOL (variable)->value;
+}
 }
 DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,
 doc: /* Bind variables according to VARLIST then eval BODY.
 The value of the last form in BODY is returned.
 #endif
 /* This hook is used by edebug.  */
 if (! NILP (Vsignal_hook_function)
 && ! NILP (error_symbol))
-call2 (Vsignal_hook_function, error_symbol, data);
+{
+/* Edebug takes care of restoring these variables when it exits.  */
+if (lisp_eval_depth + 20 > max_lisp_eval_depth)
+	max_lisp_eval_depth = lisp_eval_depth + 20;
+if (SPECPDL_INDEX () + 40 > max_specpdl_size)
+	max_specpdl_size = SPECPDL_INDEX () + 40;
+call2 (Vsignal_hook_function, error_symbol, data);
+}
 conditions = Fget (real_error_symbol, Qerror_conditions);
 /* Remember from where signal was called.  Skip over the frame for
 `signal' itself.  If a frame for `error' follows, skip that,
 for (; handlerlist; handlerlist = handlerlist->next)
 {
 register Lisp_Object clause;
-if (lisp_eval_depth + 20 > max_lisp_eval_depth)
-	max_lisp_eval_depth = lisp_eval_depth + 20;
-if (specpdl_size + 40 > max_specpdl_size)
-	max_specpdl_size = specpdl_size + 40;
 clause = find_handler_clause (handlerlist->handler, conditions,
 				    error_symbol, data, &debugger_value);
 if (EQ (clause, Qlambda))
 	{
 There are two ways to pass SIG and DATA:
 = SIG is the error symbol, and DATA is the rest of the data.
 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
 This is for memory-full errors only.
-Store value returned from debugger into *DEBUGGER_VALUE_PTR.  */
+Store value returned from debugger into *DEBUGGER_VALUE_PTR.
+We need to increase max_specpdl_size temporarily around
+anything we do that can push on the specpdl, so as not to get
+a second error here in case we're handling specpdl overflow.  */
 static Lisp_Object
 find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
 Lisp_Object handlers, conditions, sig, data;
 Lisp_Object *debugger_value_ptr;
 and run the debugger if that is enabled.  */
 if (EQ (handlers, Qerror)
 || !NILP (Vdebug_on_signal)) /* This says call debugger even if
 				      there is a handler.  */
 {
-int count = SPECPDL_INDEX ();
 int debugger_called = 0;
 Lisp_Object sig_symbol, combined_data;
 /* This is set to 1 if we are handling a memory-full error,
 	 because these must not run the debugger.
 	 (There is no room in memory to do that!)  */
 	  sig_symbol = sig;
 	}
 if (wants_debugger (Vstack_trace_on_error, conditions))
 	{
+	  max_specpdl_size++;
 #ifdef PROTOTYPES
 	  internal_with_output_to_temp_buffer ("*Backtrace*",
 					       (Lisp_Object (*) (Lisp_Object)) Fbacktrace,
 					       Qnil);
 #else
 	  internal_with_output_to_temp_buffer ("*Backtrace*",
 					       Fbacktrace, Qnil);
 #endif
+	  max_specpdl_size--;
 	}
 if (! no_debugger
 	  && (EQ (sig_symbol, Qquit)
 	      ? debug_on_quit
 	      : wants_debugger (Vdebug_on_error, conditions))
 	  && ! skip_debugger (conditions, combined_data)
 	  && when_entered_debugger < num_nonmacro_input_events)
 	{
-	  specbind (Qdebug_on_error, Qnil);
 	  *debugger_value_ptr
 	    = call_debugger (Fcons (Qerror,
 				    Fcons (combined_data, Qnil)));
 	  debugger_called = 1;
 	}
 /* If there is no handler, return saying whether we ran the debugger.  */
 if (EQ (handlers, Qerror))
 	{
 	  if (debugger_called)
-	    return unbind_to (count, Qlambda);
+	    return Qlambda;
 	  return Qt;
 	}
 }
 for (h = handlers; CONSP (h); h = Fcdr (h))
 {
 if (specpdl_size >= max_specpdl_size)
 {
 if (max_specpdl_size < 400)
 	max_specpdl_size = 400;
 if (specpdl_size >= max_specpdl_size)
-	{
+	Fsignal (Qerror,
-	  if (!NILP (Vdebug_on_error))
+		 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil));
-	    /* Leave room for some specpdl in the debugger.  */
-	    max_specpdl_size = specpdl_size + 100;
-	  Fsignal (Qerror,
-		   Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil));
-	}
 }
 specpdl_size *= 2;
 if (specpdl_size > max_specpdl_size)
 specpdl_size = max_specpdl_size;
 specpdl = (struct specbinding *) xrealloc (specpdl, specpdl_size * sizeof (struct specbinding));
 void
 syms_of_eval ()
 {
 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size,
 	      doc: /* *Limit on number of Lisp variable bindings & unwind-protects.
-If Lisp code tries to make more than this many at once,
+If Lisp code tries to increase the total number past this amount,
 an error is signaled.
 You can safely use a value considerably larger than the default value,
 if that proves inconveniently small.  However, if you increase it too far,
 Emacs could run out of memory trying to make the stack bigger.  */);

Mercurial > emacs

comparison src/eval.c @ 90199:bb71c6cf2009