X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7d47b580380358da3353e4f379f2313ec3411af1..bc86f573eecb9067dfb73c612309a909332bb15d:/src/eval.c diff --git a/src/eval.c b/src/eval.c index e8a3f947f9..079c7ecb6c 100644 --- a/src/eval.c +++ b/src/eval.c @@ -133,8 +133,9 @@ static Lisp_Object Ffetch_bytecode (Lisp_Object); void init_eval_once (void) { - specpdl_size = 50; - specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding)); + enum { size = 50 }; + specpdl = (struct specbinding *) xmalloc (size * sizeof (struct specbinding)); + specpdl_size = size; specpdl_ptr = specpdl; /* Don't forget to update docs (lispref node "Local Variables"). */ max_specpdl_size = 1300; /* 1000 is not enough for CEDET's c-by.el. */ @@ -192,7 +193,7 @@ call_debugger (Lisp_Object arg) if (lisp_eval_depth + 40 > max_lisp_eval_depth) max_lisp_eval_depth = lisp_eval_depth + 40; - if (SPECPDL_INDEX () + 100 > max_specpdl_size) + if (max_specpdl_size - 100 < SPECPDL_INDEX ()) max_specpdl_size = SPECPDL_INDEX () + 100; #ifdef HAVE_WINDOW_SYSTEM @@ -466,7 +467,7 @@ usage: (setq [SYM VAL]...) */) args_left = Fcdr (Fcdr (args_left)); } - while (!NILP(args_left)); + while (!NILP (args_left)); UNGCPRO; return val; @@ -474,6 +475,14 @@ usage: (setq [SYM VAL]...) */) DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0, doc: /* Return the argument, without evaluating it. `(quote x)' yields `x'. +Warning: `quote' does not construct its return value, but just returns +the value that was pre-constructed by the Lisp reader (see info node +`(elisp)Printed Representation'). +This means that '(a . b) is not identical to (cons 'a 'b): the former +does not cons. Quoting should be reserved for constants that will +never be modified by side-effects, unless you like self-modifying code. +See the common pitfall in info node `(elisp)Rearrangement' for an example +of unexpected results when a quoted object is modified. usage: (quote ARG) */) (Lisp_Object args) { @@ -1357,8 +1366,12 @@ A handler is applicable to an error if CONDITION-NAME is one of the error's condition names. If an error happens, the first applicable handler is run. -The car of a handler may be a list of condition names -instead of a single condition name. Then it handles all of them. +The car of a handler may be a list of condition names instead of a +single condition name; then it handles all of them. If the special +condition name `debug' is present in this list, it allows another +condition in the list to run the debugger if `debug-on-error' and the +other usual mechanisms says it should (otherwise, `condition-case' +suppresses the debugger). When a handler handles an error, control returns to the `condition-case' and it executes the handler's BODY... @@ -1461,13 +1474,6 @@ internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers, struct catchtag c; struct handler h; - /* Since Fsignal will close off all calls to x_catch_errors, - we will get the wrong results if some are not closed now. */ -#if HAVE_X_WINDOWS - if (x_catching_errors ()) - abort (); -#endif - c.tag = Qnil; c.val = Qnil; c.backlist = backtrace_list; @@ -1506,13 +1512,6 @@ internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg, struct catchtag c; struct handler h; - /* Since Fsignal will close off all calls to x_catch_errors, - we will get the wrong results if some are not closed now. */ -#if HAVE_X_WINDOWS - if (x_catching_errors ()) - abort (); -#endif - c.tag = Qnil; c.val = Qnil; c.backlist = backtrace_list; @@ -1555,13 +1554,6 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object), struct catchtag c; struct handler h; - /* Since Fsignal will close off all calls to x_catch_errors, - we will get the wrong results if some are not closed now. */ -#if HAVE_X_WINDOWS - if (x_catching_errors ()) - abort (); -#endif - c.tag = Qnil; c.val = Qnil; c.backlist = backtrace_list; @@ -1604,13 +1596,6 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), struct catchtag c; struct handler h; - /* Since Fsignal will close off all calls to x_catch_errors, - we will get the wrong results if some are not closed now. */ -#if HAVE_X_WINDOWS - if (x_catching_errors ()) - abort (); -#endif - c.tag = Qnil; c.val = Qnil; c.backlist = backtrace_list; @@ -1644,6 +1629,18 @@ static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object); static int maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data); +void +process_quit_flag (void) +{ + Lisp_Object flag = Vquit_flag; + Vquit_flag = Qnil; + if (EQ (flag, Qkill_emacs)) + Fkill_emacs (Qnil); + if (EQ (Vthrow_on_input, flag)) + Fthrow (Vthrow_on_input, Qt); + Fsignal (Qquit, Qnil); +} + DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. This function does not return. @@ -1727,6 +1724,10 @@ See also the function `condition-case'. */) && (!NILP (Vdebug_on_signal) /* If no handler is present now, try to run the debugger. */ || NILP (clause) + /* A `debug' symbol in the handler list disables the normal + suppression of the debugger. */ + || (CONSP (clause) && CONSP (XCAR (clause)) + && !NILP (Fmemq (Qdebug, XCAR (clause)))) /* Special handler that means "print a message and run debugger if requested". */ || EQ (h->handler, Qerror))) @@ -1968,37 +1969,13 @@ void verror (const char *m, va_list ap) { char buf[4000]; - size_t size = sizeof buf; - size_t size_max = STRING_BYTES_BOUND + 1; - size_t mlen = strlen (m); + ptrdiff_t size = sizeof buf; + ptrdiff_t size_max = STRING_BYTES_BOUND + 1; char *buffer = buf; - size_t used; + ptrdiff_t used; Lisp_Object string; - while (1) - { - va_list ap_copy; - va_copy (ap_copy, ap); - used = doprnt (buffer, size, m, m + mlen, ap_copy); - va_end (ap_copy); - - /* Note: the -1 below is because `doprnt' returns the number of bytes - excluding the terminating null byte, and it always terminates with a - null byte, even when producing a truncated message. */ - if (used < size - 1) - break; - if (size <= size_max / 2) - size *= 2; - else if (size < size_max) - size = size_max; - else - break; /* and leave the message truncated */ - - if (buffer != buf) - xfree (buffer); - buffer = (char *) xmalloc (size); - } - + used = evxprintf (&buffer, &size, buf, size_max, m, ap); string = make_string (buffer, used); if (buffer != buf) xfree (buffer); @@ -3162,7 +3139,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, shouldn't bind any arguments, instead just call the byte-code interpreter directly; it will push arguments as necessary. - Byte-code objects with either a non-existant, or a nil value for + Byte-code objects with either a non-existent, or a nil value for the `push args' slot (the default), have dynamically-bound arguments, and use the argument-binding code below instead (as do all interpreted functions, even lexically bound ones). */ @@ -3274,17 +3251,21 @@ static void grow_specpdl (void) { register int count = SPECPDL_INDEX (); - if (specpdl_size >= max_specpdl_size) + int max_size = + min (max_specpdl_size, + min (max (PTRDIFF_MAX, SIZE_MAX) / sizeof (struct specbinding), + INT_MAX)); + int size; + if (max_size <= specpdl_size) { if (max_specpdl_size < 400) - max_specpdl_size = 400; - if (specpdl_size >= max_specpdl_size) + max_size = max_specpdl_size = 400; + if (max_size <= specpdl_size) signal_error ("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)); + size = specpdl_size < max_size / 2 ? 2 * specpdl_size : max_size; + specpdl = xnrealloc (specpdl, size, sizeof *specpdl); + specpdl_size = size; specpdl_ptr = specpdl + count; } @@ -3764,7 +3745,7 @@ When lexical binding is not being used, this variable is nil. A value of `(t)' indicates an empty environment, otherwise it is an alist of active lexical bindings. */); Vinternal_interpreter_environment = Qnil; - /* Don't export this variable to Elisp, so noone can mess with it + /* Don't export this variable to Elisp, so no one can mess with it (Just imagine if someone makes it buffer-local). */ Funintern (Qinternal_interpreter_environment, Qnil);