X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/0e51f7172bd1ab8b9c1bb52598afb5017e19b9c3..f0ecbca80a004824d74ca9bc8b77cc94b2489b34:/src/eval.c diff --git a/src/eval.c b/src/eval.c index 94039b31e1..c6bf2ccef1 100644 --- a/src/eval.c +++ b/src/eval.c @@ -90,7 +90,7 @@ Lisp_Object Vautoload_queue; /* Current number of specbindings allocated in specpdl. */ -EMACS_INT specpdl_size; +ptrdiff_t specpdl_size; /* Pointer to beginning of specpdl. */ @@ -111,7 +111,7 @@ static EMACS_INT lisp_eval_depth; signal the error instead of entering an infinite loop of debugger invocations. */ -static int when_entered_debugger; +static EMACS_INT when_entered_debugger; /* The function from which the last `signal' was called. Set in Fsignal. */ @@ -177,7 +177,7 @@ static Lisp_Object call_debugger (Lisp_Object arg) { int debug_while_redisplaying; - int count = SPECPDL_INDEX (); + ptrdiff_t count = SPECPDL_INDEX (); Lisp_Object val; EMACS_INT old_max = max_specpdl_size; @@ -373,23 +373,14 @@ usage: (prog1 FIRST BODY...) */) Lisp_Object val; register Lisp_Object args_left; struct gcpro gcpro1, gcpro2; - register int argnum = 0; - - if (NILP (args)) - return Qnil; args_left = args; val = Qnil; GCPRO2 (args, val); - do - { - Lisp_Object tem = eval_sub (XCAR (args_left)); - if (!(argnum++)) - val = tem; - args_left = XCDR (args_left); - } - while (CONSP (args_left)); + val = eval_sub (XCAR (args_left)); + while (CONSP (args_left = XCDR (args_left))) + eval_sub (XCAR (args_left)); UNGCPRO; return val; @@ -402,31 +393,12 @@ remaining args, whose values are discarded. usage: (prog2 FORM1 FORM2 BODY...) */) (Lisp_Object args) { - Lisp_Object val; - register Lisp_Object args_left; - struct gcpro gcpro1, gcpro2; - register int argnum = -1; - - val = Qnil; - - if (NILP (args)) - return Qnil; - - args_left = args; - val = Qnil; - GCPRO2 (args, val); - - do - { - Lisp_Object tem = eval_sub (XCAR (args_left)); - if (!(argnum++)) - val = tem; - args_left = XCDR (args_left); - } - while (CONSP (args_left)); + struct gcpro gcpro1; + GCPRO1 (args); + eval_sub (XCAR (args)); UNGCPRO; - return val; + return Fprog1 (XCDR (args)); } DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0, @@ -467,7 +439,7 @@ usage: (setq [SYM VAL]...) */) args_left = Fcdr (Fcdr (args_left)); } - while (!NILP(args_left)); + while (!NILP (args_left)); UNGCPRO; return val; @@ -475,6 +447,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) { @@ -750,8 +730,8 @@ The return value is BASE-VARIABLE. */) { struct specbinding *p; - for (p = specpdl_ptr - 1; p >= specpdl; p--) - if (p->func == NULL + for (p = specpdl_ptr; p > specpdl; ) + if ((--p)->func == NULL && (EQ (new_alias, CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol))) error ("Don't know how to make a let-bound variable an alias"); @@ -825,9 +805,9 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) { /* Check if there is really a global binding rather than just a let binding that shadows the global unboundness of the var. */ volatile struct specbinding *pdl = specpdl_ptr; - while (--pdl >= specpdl) + while (pdl > specpdl) { - if (EQ (pdl->symbol, sym) && !pdl->func + if (EQ ((--pdl)->symbol, sym) && !pdl->func && EQ (pdl->old_value, Qunbound)) { message_with_string ("Warning: defvar ignored because %s is let-bound", @@ -975,7 +955,7 @@ usage: (let* VARLIST BODY...) */) (Lisp_Object args) { Lisp_Object varlist, var, val, elt, lexenv; - int count = SPECPDL_INDEX (); + ptrdiff_t count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3; GCPRO3 (args, elt, varlist); @@ -1038,7 +1018,7 @@ usage: (let VARLIST BODY...) */) { Lisp_Object *temps, tem, lexenv; register Lisp_Object elt, varlist; - int count = SPECPDL_INDEX (); + ptrdiff_t count = SPECPDL_INDEX (); ptrdiff_t argnum; struct gcpro gcpro1, gcpro2; USE_SAFE_ALLOCA; @@ -1341,7 +1321,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */) (Lisp_Object args) { Lisp_Object val; - int count = SPECPDL_INDEX (); + ptrdiff_t count = SPECPDL_INDEX (); record_unwind_protect (Fprogn, Fcdr (args)); val = eval_sub (Fcar (args)); @@ -1358,8 +1338,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... @@ -1462,13 +1446,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; @@ -1507,13 +1484,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; @@ -1556,13 +1526,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; @@ -1605,13 +1568,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; @@ -1728,6 +1684,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))) @@ -1971,35 +1931,11 @@ verror (const char *m, va_list ap) char buf[4000]; ptrdiff_t size = sizeof buf; ptrdiff_t size_max = STRING_BYTES_BOUND + 1; - char const *m_end = m + strlen (m); char *buffer = buf; ptrdiff_t used; Lisp_Object string; - while (1) - { - va_list ap_copy; - va_copy (ap_copy, ap); - used = doprnt (buffer, size, m, m_end, 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); @@ -2159,7 +2095,7 @@ un_autoload (Lisp_Object oldqueue) void do_autoload (Lisp_Object fundef, Lisp_Object funname) { - int count = SPECPDL_INDEX (); + ptrdiff_t count = SPECPDL_INDEX (); Lisp_Object fun; struct gcpro gcpro1, gcpro2, gcpro3; @@ -2206,7 +2142,7 @@ DEFUN ("eval", Feval, Seval, 1, 2, 0, If LEXICAL is t, evaluate using lexical scoping. */) (Lisp_Object form, Lisp_Object lexical) { - int count = SPECPDL_INDEX (); + ptrdiff_t count = SPECPDL_INDEX (); specbind (Qinternal_interpreter_environment, NILP (lexical) ? Qnil : Fcons (Qt, Qnil)); return unbind_to (count, eval_sub (form)); @@ -2440,7 +2376,8 @@ Thus, (apply '+ 1 2 '(3 4)) returns 10. usage: (apply FUNCTION &rest ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t i, numargs; + ptrdiff_t i; + EMACS_INT numargs; register Lisp_Object spread_arg; register Lisp_Object *funcall_args; Lisp_Object fun, retval; @@ -3090,7 +3027,8 @@ static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args) { Lisp_Object args_left; - ptrdiff_t i, numargs; + ptrdiff_t i; + EMACS_INT numargs; register Lisp_Object *arg_vector; struct gcpro gcpro1, gcpro2, gcpro3; register Lisp_Object tem; @@ -3135,7 +3073,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, register Lisp_Object *arg_vector) { Lisp_Object val, syms_left, next, lexenv; - int count = SPECPDL_INDEX (); + ptrdiff_t count = SPECPDL_INDEX (); ptrdiff_t i; int optional, rest; @@ -3274,12 +3212,8 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, static void grow_specpdl (void) { - register int count = SPECPDL_INDEX (); - int max_size = - min (max_specpdl_size, - min (max (PTRDIFF_MAX, SIZE_MAX) / sizeof (struct specbinding), - INT_MAX)); - int size; + 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) @@ -3287,9 +3221,7 @@ grow_specpdl (void) if (max_size <= specpdl_size) signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil); } - size = specpdl_size < max_size / 2 ? 2 * specpdl_size : max_size; - specpdl = xnrealloc (specpdl, size, sizeof *specpdl); - specpdl_size = size; + specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl); specpdl_ptr = specpdl + count; } @@ -3419,7 +3351,7 @@ record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) } Lisp_Object -unbind_to (int count, Lisp_Object value) +unbind_to (ptrdiff_t count, Lisp_Object value) { Lisp_Object quitf = Vquit_flag; struct gcpro gcpro1, gcpro2; @@ -3499,7 +3431,7 @@ 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; - register int i; + register EMACS_INT i; CHECK_NUMBER (level);