X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d7a89815b6d69c3b1793d34bcad8bf0aa21d48c8..5c3534ffdcce41b1aab7bd158cf07224446caa9d:/src/eval.c
diff --git a/src/eval.c b/src/eval.c
index b98b224e62..fe6460d53b 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1,14 +1,14 @@
/* Evaluator for GNU Emacs Lisp interpreter.
-Copyright (C) 1985-1987, 1993-1995, 1999-2015 Free Software Foundation,
+Copyright (C) 1985-1987, 1993-1995, 1999-2016 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -33,11 +33,6 @@ along with GNU Emacs. If not, see . */
struct handler *handlerlist;
-#ifdef DEBUG_GCPRO
-/* Count levels of GCPRO to detect failure to UNGCPRO. */
-int gcpro_level;
-#endif
-
/* Non-nil means record all fset's and provide's, to be undone
if the file being autoloaded is not fully loaded.
They are recorded by being consed onto the front of Vautoload_queue:
@@ -66,7 +61,7 @@ union specbinding *specpdl_ptr;
/* Depth in Lisp evaluations and function calls. */
-EMACS_INT lisp_eval_depth;
+static EMACS_INT lisp_eval_depth;
/* The value of num_nonmacro_input_events as of the last time we
started to enter the debugger. If we decide to enter the debugger
@@ -200,6 +195,12 @@ backtrace_next (union specbinding *pdl)
return pdl;
}
+/* Return a pointer to somewhere near the top of the C stack. */
+void *
+near_C_stack_top (void)
+{
+ return backtrace_args (backtrace_top ());
+}
void
init_eval_once (void)
@@ -210,7 +211,7 @@ init_eval_once (void)
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;
+ max_lisp_eval_depth = 800;
Vrun_hooks = Qnil;
}
@@ -220,13 +221,13 @@ static struct handler handlerlist_sentinel;
void
init_eval (void)
{
+ byte_stack_list = 0;
specpdl_ptr = specpdl;
{ /* Put a dummy catcher at top-level so that handlerlist is never NULL.
This is important since handlerlist->nextfree holds the freelist
which would otherwise leak every time we unwind back to top-level. */
- struct handler *c;
handlerlist = handlerlist_sentinel.nextfree = &handlerlist_sentinel;
- PUSH_HANDLER (c, Qunbound, CATCHER);
+ struct handler *c = push_handler (Qunbound, CATCHER);
eassert (c == &handlerlist_sentinel);
handlerlist_sentinel.nextfree = NULL;
handlerlist_sentinel.next = NULL;
@@ -234,9 +235,6 @@ init_eval (void)
Vquit_flag = Qnil;
debug_on_next_call = 0;
lisp_eval_depth = 0;
-#ifdef DEBUG_GCPRO
- gcpro_level = 0;
-#endif
/* This is less than the initial value of num_nonmacro_input_events. */
when_entered_debugger = -1;
}
@@ -336,10 +334,7 @@ If all args return nil, return nil.
usage: (or CONDITIONS...) */)
(Lisp_Object args)
{
- register Lisp_Object val = Qnil;
- struct gcpro gcpro1;
-
- GCPRO1 (args);
+ Lisp_Object val = Qnil;
while (CONSP (args))
{
@@ -349,7 +344,6 @@ usage: (or CONDITIONS...) */)
args = XCDR (args);
}
- UNGCPRO;
return val;
}
@@ -360,10 +354,7 @@ If no arg yields nil, return the last arg's value.
usage: (and CONDITIONS...) */)
(Lisp_Object args)
{
- register Lisp_Object val = Qt;
- struct gcpro gcpro1;
-
- GCPRO1 (args);
+ Lisp_Object val = Qt;
while (CONSP (args))
{
@@ -373,7 +364,6 @@ usage: (and CONDITIONS...) */)
args = XCDR (args);
}
- UNGCPRO;
return val;
}
@@ -386,11 +376,8 @@ usage: (if COND THEN ELSE...) */)
(Lisp_Object args)
{
Lisp_Object cond;
- struct gcpro gcpro1;
- GCPRO1 (args);
cond = eval_sub (XCAR (args));
- UNGCPRO;
if (!NILP (cond))
return eval_sub (Fcar (XCDR (args)));
@@ -410,9 +397,7 @@ usage: (cond CLAUSES...) */)
(Lisp_Object args)
{
Lisp_Object val = args;
- struct gcpro gcpro1;
- GCPRO1 (args);
while (CONSP (args))
{
Lisp_Object clause = XCAR (args);
@@ -425,7 +410,6 @@ usage: (cond CLAUSES...) */)
}
args = XCDR (args);
}
- UNGCPRO;
return val;
}
@@ -436,9 +420,6 @@ usage: (progn BODY...) */)
(Lisp_Object body)
{
Lisp_Object val = Qnil;
- struct gcpro gcpro1;
-
- GCPRO1 (body);
while (CONSP (body))
{
@@ -446,7 +427,6 @@ usage: (progn BODY...) */)
body = XCDR (body);
}
- UNGCPRO;
return val;
}
@@ -468,17 +448,14 @@ usage: (prog1 FIRST BODY...) */)
{
Lisp_Object val;
Lisp_Object args_left;
- struct gcpro gcpro1, gcpro2;
args_left = args;
val = args;
- GCPRO2 (args, val);
val = eval_sub (XCAR (args_left));
while (CONSP (args_left = XCDR (args_left)))
eval_sub (XCAR (args_left));
- UNGCPRO;
return val;
}
@@ -489,11 +466,7 @@ remaining args, whose values are discarded.
usage: (prog2 FORM1 FORM2 BODY...) */)
(Lisp_Object args)
{
- struct gcpro gcpro1;
-
- GCPRO1 (args);
eval_sub (XCAR (args));
- UNGCPRO;
return Fprog1 (XCDR (args));
}
@@ -514,8 +487,10 @@ usage: (setq [SYM VAL]...) */)
if (CONSP (args))
{
Lisp_Object args_left = args;
- struct gcpro gcpro1;
- GCPRO1 (args);
+ Lisp_Object numargs = Flength (args);
+
+ if (XINT (numargs) & 1)
+ xsignal2 (Qwrong_number_of_arguments, Qsetq, numargs);
do
{
@@ -535,8 +510,6 @@ usage: (setq [SYM VAL]...) */)
args_left = Fcdr (XCDR (args_left));
}
while (CONSP (args_left));
-
- UNGCPRO;
}
return val;
@@ -547,7 +520,7 @@ DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0,
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
+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
@@ -575,10 +548,23 @@ usage: (function ARG) */)
if (!NILP (Vinternal_interpreter_environment)
&& CONSP (quoted)
&& EQ (XCAR (quoted), Qlambda))
- /* This is a lambda expression within a lexical environment;
- return an interpreted closure instead of a simple lambda. */
- return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment,
- XCDR (quoted)));
+ { /* This is a lambda expression within a lexical environment;
+ return an interpreted closure instead of a simple lambda. */
+ Lisp_Object cdr = XCDR (quoted);
+ Lisp_Object tmp = cdr;
+ if (CONSP (tmp)
+ && (tmp = XCDR (tmp), CONSP (tmp))
+ && (tmp = XCAR (tmp), CONSP (tmp))
+ && (EQ (QCdocumentation, XCAR (tmp))))
+ { /* Handle the special (:documentation