aboutsummaryrefslogtreecommitdiffstats
path: root/src/eval.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/eval.c')
-rw-r--r--src/eval.c933
1 files changed, 303 insertions, 630 deletions
diff --git a/src/eval.c b/src/eval.c
index 079c7ecb6c2..34b20f6fc8e 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1,5 +1,5 @@
1/* Evaluator for GNU Emacs Lisp interpreter. 1/* Evaluator for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985-1987, 1993-1995, 1999-2011 Free Software Foundation, Inc. 2 Copyright (C) 1985-1987, 1993-1995, 1999-2012 Free Software Foundation, Inc.
3 3
4This file is part of GNU Emacs. 4This file is part of GNU Emacs.
5 5
@@ -19,7 +19,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19 19
20#include <config.h> 20#include <config.h>
21#include <limits.h> 21#include <limits.h>
22#include <setjmp.h>
23#include <stdio.h> 22#include <stdio.h>
24#include "lisp.h" 23#include "lisp.h"
25#include "blockinput.h" 24#include "blockinput.h"
@@ -32,17 +31,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
32#include "xterm.h" 31#include "xterm.h"
33#endif 32#endif
34 33
35struct backtrace 34struct backtrace *backtrace_list;
36{
37 struct backtrace *next;
38 Lisp_Object *function;
39 Lisp_Object *args; /* Points to vector of args. */
40 ptrdiff_t nargs; /* Length of vector. */
41 /* Nonzero means call value of debugger when done with this operation. */
42 unsigned int debug_on_exit : 1;
43};
44
45static struct backtrace *backtrace_list;
46 35
47#if !BYTE_MARK_STACK 36#if !BYTE_MARK_STACK
48static 37static
@@ -65,11 +54,11 @@ struct handler *handlerlist;
65int gcpro_level; 54int gcpro_level;
66#endif 55#endif
67 56
68Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun; 57Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp;
69Lisp_Object Qinhibit_quit; 58Lisp_Object Qinhibit_quit;
70Lisp_Object Qand_rest; 59Lisp_Object Qand_rest;
71static Lisp_Object Qand_optional; 60static Lisp_Object Qand_optional;
72static Lisp_Object Qdebug_on_error; 61static Lisp_Object Qinhibit_debugger;
73static Lisp_Object Qdeclare; 62static Lisp_Object Qdeclare;
74Lisp_Object Qinternal_interpreter_environment, Qclosure; 63Lisp_Object Qinternal_interpreter_environment, Qclosure;
75 64
@@ -90,7 +79,7 @@ Lisp_Object Vautoload_queue;
90 79
91/* Current number of specbindings allocated in specpdl. */ 80/* Current number of specbindings allocated in specpdl. */
92 81
93EMACS_INT specpdl_size; 82ptrdiff_t specpdl_size;
94 83
95/* Pointer to beginning of specpdl. */ 84/* Pointer to beginning of specpdl. */
96 85
@@ -111,30 +100,41 @@ static EMACS_INT lisp_eval_depth;
111 signal the error instead of entering an infinite loop of debugger 100 signal the error instead of entering an infinite loop of debugger
112 invocations. */ 101 invocations. */
113 102
114static int when_entered_debugger; 103static EMACS_INT when_entered_debugger;
115 104
116/* The function from which the last `signal' was called. Set in 105/* The function from which the last `signal' was called. Set in
117 Fsignal. */ 106 Fsignal. */
118 107
119Lisp_Object Vsignaling_function; 108Lisp_Object Vsignaling_function;
120 109
121/* Set to non-zero while processing X events. Checked in Feval to 110/* If non-nil, Lisp code must not be run since some part of Emacs is
122 make sure the Lisp interpreter isn't called from a signal handler, 111 in an inconsistent state. Currently, x-create-frame uses this to
123 which is unsafe because the interpreter isn't reentrant. */ 112 avoid triggering window-configuration-change-hook while the new
124 113 frame is half-initialized. */
125int handling_signal; 114Lisp_Object inhibit_lisp_code;
126 115
127static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); 116static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
128static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
129static int interactive_p (int);
130static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); 117static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
131static Lisp_Object Ffetch_bytecode (Lisp_Object); 118
132 119/* Functions to set Lisp_Object slots of struct specbinding. */
120
121static void
122set_specpdl_symbol (Lisp_Object symbol)
123{
124 specpdl_ptr->symbol = symbol;
125}
126
127static void
128set_specpdl_old_value (Lisp_Object oldval)
129{
130 specpdl_ptr->old_value = oldval;
131}
132
133void 133void
134init_eval_once (void) 134init_eval_once (void)
135{ 135{
136 enum { size = 50 }; 136 enum { size = 50 };
137 specpdl = (struct specbinding *) xmalloc (size * sizeof (struct specbinding)); 137 specpdl = xmalloc (size * sizeof *specpdl);
138 specpdl_size = size; 138 specpdl_size = size;
139 specpdl_ptr = specpdl; 139 specpdl_ptr = specpdl;
140 /* Don't forget to update docs (lispref node "Local Variables"). */ 140 /* Don't forget to update docs (lispref node "Local Variables"). */
@@ -173,11 +173,11 @@ restore_stack_limits (Lisp_Object data)
173 173
174/* Call the Lisp debugger, giving it argument ARG. */ 174/* Call the Lisp debugger, giving it argument ARG. */
175 175
176static Lisp_Object 176Lisp_Object
177call_debugger (Lisp_Object arg) 177call_debugger (Lisp_Object arg)
178{ 178{
179 int debug_while_redisplaying; 179 bool debug_while_redisplaying;
180 int count = SPECPDL_INDEX (); 180 ptrdiff_t count = SPECPDL_INDEX ();
181 Lisp_Object val; 181 Lisp_Object val;
182 EMACS_INT old_max = max_specpdl_size; 182 EMACS_INT old_max = max_specpdl_size;
183 183
@@ -211,7 +211,7 @@ call_debugger (Lisp_Object arg)
211 specbind (intern ("debugger-may-continue"), 211 specbind (intern ("debugger-may-continue"),
212 debug_while_redisplaying ? Qnil : Qt); 212 debug_while_redisplaying ? Qnil : Qt);
213 specbind (Qinhibit_redisplay, Qnil); 213 specbind (Qinhibit_redisplay, Qnil);
214 specbind (Qdebug_on_error, Qnil); 214 specbind (Qinhibit_debugger, Qt);
215 215
216#if 0 /* Binding this prevents execution of Lisp code during 216#if 0 /* Binding this prevents execution of Lisp code during
217 redisplay, which necessarily leads to display problems. */ 217 redisplay, which necessarily leads to display problems. */
@@ -373,23 +373,14 @@ usage: (prog1 FIRST BODY...) */)
373 Lisp_Object val; 373 Lisp_Object val;
374 register Lisp_Object args_left; 374 register Lisp_Object args_left;
375 struct gcpro gcpro1, gcpro2; 375 struct gcpro gcpro1, gcpro2;
376 register int argnum = 0;
377
378 if (NILP (args))
379 return Qnil;
380 376
381 args_left = args; 377 args_left = args;
382 val = Qnil; 378 val = Qnil;
383 GCPRO2 (args, val); 379 GCPRO2 (args, val);
384 380
385 do 381 val = eval_sub (XCAR (args_left));
386 { 382 while (CONSP (args_left = XCDR (args_left)))
387 Lisp_Object tem = eval_sub (XCAR (args_left)); 383 eval_sub (XCAR (args_left));
388 if (!(argnum++))
389 val = tem;
390 args_left = XCDR (args_left);
391 }
392 while (CONSP (args_left));
393 384
394 UNGCPRO; 385 UNGCPRO;
395 return val; 386 return val;
@@ -402,31 +393,12 @@ remaining args, whose values are discarded.
402usage: (prog2 FORM1 FORM2 BODY...) */) 393usage: (prog2 FORM1 FORM2 BODY...) */)
403 (Lisp_Object args) 394 (Lisp_Object args)
404{ 395{
405 Lisp_Object val; 396 struct gcpro gcpro1;
406 register Lisp_Object args_left;
407 struct gcpro gcpro1, gcpro2;
408 register int argnum = -1;
409
410 val = Qnil;
411
412 if (NILP (args))
413 return Qnil;
414
415 args_left = args;
416 val = Qnil;
417 GCPRO2 (args, val);
418
419 do
420 {
421 Lisp_Object tem = eval_sub (XCAR (args_left));
422 if (!(argnum++))
423 val = tem;
424 args_left = XCDR (args_left);
425 }
426 while (CONSP (args_left));
427 397
398 GCPRO1 (args);
399 eval_sub (XCAR (args));
428 UNGCPRO; 400 UNGCPRO;
429 return val; 401 return Fprog1 (XCDR (args));
430} 402}
431 403
432DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0, 404DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0,
@@ -516,208 +488,6 @@ usage: (function ARG) */)
516} 488}
517 489
518 490
519DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
520 doc: /* Return t if the containing function was run directly by user input.
521This means that the function was called with `call-interactively'
522\(which includes being called as the binding of a key)
523and input is currently coming from the keyboard (not a keyboard macro),
524and Emacs is not running in batch mode (`noninteractive' is nil).
525
526The only known proper use of `interactive-p' is in deciding whether to
527display a helpful message, or how to display it. If you're thinking
528of using it for any other purpose, it is quite likely that you're
529making a mistake. Think: what do you want to do when the command is
530called from a keyboard macro?
531
532To test whether your function was called with `call-interactively',
533either (i) add an extra optional argument and give it an `interactive'
534spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
535use `called-interactively-p'. */)
536 (void)
537{
538 return interactive_p (1) ? Qt : Qnil;
539}
540
541
542DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 1, 0,
543 doc: /* Return t if the containing function was called by `call-interactively'.
544If KIND is `interactive', then only return t if the call was made
545interactively by the user, i.e. not in `noninteractive' mode nor
546when `executing-kbd-macro'.
547If KIND is `any', on the other hand, it will return t for any kind of
548interactive call, including being called as the binding of a key, or
549from a keyboard macro, or in `noninteractive' mode.
550
551The only known proper use of `interactive' for KIND is in deciding
552whether to display a helpful message, or how to display it. If you're
553thinking of using it for any other purpose, it is quite likely that
554you're making a mistake. Think: what do you want to do when the
555command is called from a keyboard macro?
556
557This function is meant for implementing advice and other
558function-modifying features. Instead of using this, it is sometimes
559cleaner to give your function an extra optional argument whose
560`interactive' spec specifies non-nil unconditionally (\"p\" is a good
561way to do this), or via (not (or executing-kbd-macro noninteractive)). */)
562 (Lisp_Object kind)
563{
564 return ((INTERACTIVE || !EQ (kind, intern ("interactive")))
565 && interactive_p (1)) ? Qt : Qnil;
566}
567
568
569/* Return 1 if function in which this appears was called using
570 call-interactively.
571
572 EXCLUDE_SUBRS_P non-zero means always return 0 if the function
573 called is a built-in. */
574
575static int
576interactive_p (int exclude_subrs_p)
577{
578 struct backtrace *btp;
579 Lisp_Object fun;
580
581 btp = backtrace_list;
582
583 /* If this isn't a byte-compiled function, there may be a frame at
584 the top for Finteractive_p. If so, skip it. */
585 fun = Findirect_function (*btp->function, Qnil);
586 if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p
587 || XSUBR (fun) == &Scalled_interactively_p))
588 btp = btp->next;
589
590 /* If we're running an Emacs 18-style byte-compiled function, there
591 may be a frame for Fbytecode at the top level. In any version of
592 Emacs there can be Fbytecode frames for subexpressions evaluated
593 inside catch and condition-case. Skip past them.
594
595 If this isn't a byte-compiled function, then we may now be
596 looking at several frames for special forms. Skip past them. */
597 while (btp
598 && (EQ (*btp->function, Qbytecode)
599 || btp->nargs == UNEVALLED))
600 btp = btp->next;
601
602 /* `btp' now points at the frame of the innermost function that isn't
603 a special form, ignoring frames for Finteractive_p and/or
604 Fbytecode at the top. If this frame is for a built-in function
605 (such as load or eval-region) return nil. */
606 fun = Findirect_function (*btp->function, Qnil);
607 if (exclude_subrs_p && SUBRP (fun))
608 return 0;
609
610 /* `btp' points to the frame of a Lisp function that called interactive-p.
611 Return t if that function was called interactively. */
612 if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
613 return 1;
614 return 0;
615}
616
617
618DEFUN ("defun", Fdefun, Sdefun, 2, UNEVALLED, 0,
619 doc: /* Define NAME as a function.
620The definition is (lambda ARGLIST [DOCSTRING] BODY...).
621See also the function `interactive'.
622usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
623 (Lisp_Object args)
624{
625 register Lisp_Object fn_name;
626 register Lisp_Object defn;
627
628 fn_name = Fcar (args);
629 CHECK_SYMBOL (fn_name);
630 defn = Fcons (Qlambda, Fcdr (args));
631 if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */
632 defn = Ffunction (Fcons (defn, Qnil));
633 if (!NILP (Vpurify_flag))
634 defn = Fpurecopy (defn);
635 if (CONSP (XSYMBOL (fn_name)->function)
636 && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
637 LOADHIST_ATTACH (Fcons (Qt, fn_name));
638 Ffset (fn_name, defn);
639 LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
640 return fn_name;
641}
642
643DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0,
644 doc: /* Define NAME as a macro.
645The actual definition looks like
646 (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
647When the macro is called, as in (NAME ARGS...),
648the function (lambda ARGLIST BODY...) is applied to
649the list ARGS... as it appears in the expression,
650and the result should be a form to be evaluated instead of the original.
651
652DECL is a declaration, optional, which can specify how to indent
653calls to this macro, how Edebug should handle it, and which argument
654should be treated as documentation. It looks like this:
655 (declare SPECS...)
656The elements can look like this:
657 (indent INDENT)
658 Set NAME's `lisp-indent-function' property to INDENT.
659
660 (debug DEBUG)
661 Set NAME's `edebug-form-spec' property to DEBUG. (This is
662 equivalent to writing a `def-edebug-spec' for the macro.)
663
664 (doc-string ELT)
665 Set NAME's `doc-string-elt' property to ELT.
666
667usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
668 (Lisp_Object args)
669{
670 register Lisp_Object fn_name;
671 register Lisp_Object defn;
672 Lisp_Object lambda_list, doc, tail;
673
674 fn_name = Fcar (args);
675 CHECK_SYMBOL (fn_name);
676 lambda_list = Fcar (Fcdr (args));
677 tail = Fcdr (Fcdr (args));
678
679 doc = Qnil;
680 if (STRINGP (Fcar (tail)))
681 {
682 doc = XCAR (tail);
683 tail = XCDR (tail);
684 }
685
686 if (CONSP (Fcar (tail))
687 && EQ (Fcar (Fcar (tail)), Qdeclare))
688 {
689 if (!NILP (Vmacro_declaration_function))
690 {
691 struct gcpro gcpro1;
692 GCPRO1 (args);
693 call2 (Vmacro_declaration_function, fn_name, Fcar (tail));
694 UNGCPRO;
695 }
696
697 tail = Fcdr (tail);
698 }
699
700 if (NILP (doc))
701 tail = Fcons (lambda_list, tail);
702 else
703 tail = Fcons (lambda_list, Fcons (doc, tail));
704
705 defn = Fcons (Qlambda, tail);
706 if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */
707 defn = Ffunction (Fcons (defn, Qnil));
708 defn = Fcons (Qmacro, defn);
709
710 if (!NILP (Vpurify_flag))
711 defn = Fpurecopy (defn);
712 if (CONSP (XSYMBOL (fn_name)->function)
713 && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
714 LOADHIST_ATTACH (Fcons (Qt, fn_name));
715 Ffset (fn_name, defn);
716 LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
717 return fn_name;
718}
719
720
721DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, 491DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
722 doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE. 492 doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
723Aliased variables always have the same value; setting one sets the other. 493Aliased variables always have the same value; setting one sets the other.
@@ -758,8 +528,8 @@ The return value is BASE-VARIABLE. */)
758 { 528 {
759 struct specbinding *p; 529 struct specbinding *p;
760 530
761 for (p = specpdl_ptr - 1; p >= specpdl; p--) 531 for (p = specpdl_ptr; p > specpdl; )
762 if (p->func == NULL 532 if ((--p)->func == NULL
763 && (EQ (new_alias, 533 && (EQ (new_alias,
764 CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol))) 534 CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol)))
765 error ("Don't know how to make a let-bound variable an alias"); 535 error ("Don't know how to make a let-bound variable an alias");
@@ -780,17 +550,15 @@ The return value is BASE-VARIABLE. */)
780 550
781DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0, 551DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0,
782 doc: /* Define SYMBOL as a variable, and return SYMBOL. 552 doc: /* Define SYMBOL as a variable, and return SYMBOL.
783You are not required to define a variable in order to use it, 553You are not required to define a variable in order to use it, but
784but the definition can supply documentation and an initial value 554defining it lets you supply an initial value and documentation, which
785in a way that tags can recognize. 555can be referred to by the Emacs help facilities and other programming
786 556tools. The `defvar' form also declares the variable as \"special\",
787INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void. 557so that it is always dynamically bound even if `lexical-binding' is t.
788If SYMBOL is buffer-local, its default value is what is set; 558
789 buffer-local values are not affected. 559The optional argument INITVALUE is evaluated, and used to set SYMBOL,
790INITVALUE and DOCSTRING are optional. 560only if SYMBOL's value is void. If SYMBOL is buffer-local, its
791If DOCSTRING starts with *, this variable is identified as a user option. 561default value is what is set; buffer-local values are not affected.
792 This means that M-x set-variable recognizes it.
793 See also `user-variable-p'.
794If INITVALUE is missing, SYMBOL's value is not set. 562If INITVALUE is missing, SYMBOL's value is not set.
795 563
796If SYMBOL has a local binding, then this form affects the local 564If SYMBOL has a local binding, then this form affects the local
@@ -799,6 +567,11 @@ load a file defining variables, with this form or with `defconst' or
799`defcustom', you should always load that file _outside_ any bindings 567`defcustom', you should always load that file _outside_ any bindings
800for these variables. \(`defconst' and `defcustom' behave similarly in 568for these variables. \(`defconst' and `defcustom' behave similarly in
801this respect.) 569this respect.)
570
571The optional argument DOCSTRING is a documentation string for the
572variable.
573
574To define a user option, use `defcustom' instead of `defvar'.
802usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) 575usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
803 (Lisp_Object args) 576 (Lisp_Object args)
804{ 577{
@@ -815,31 +588,20 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
815 /* Do it before evaluating the initial value, for self-references. */ 588 /* Do it before evaluating the initial value, for self-references. */
816 XSYMBOL (sym)->declared_special = 1; 589 XSYMBOL (sym)->declared_special = 1;
817 590
818 if (SYMBOL_CONSTANT_P (sym))
819 {
820 /* For upward compatibility, allow (defvar :foo (quote :foo)). */
821 Lisp_Object tem1 = Fcar (tail);
822 if (! (CONSP (tem1)
823 && EQ (XCAR (tem1), Qquote)
824 && CONSP (XCDR (tem1))
825 && EQ (XCAR (XCDR (tem1)), sym)))
826 error ("Constant symbol `%s' specified in defvar",
827 SDATA (SYMBOL_NAME (sym)));
828 }
829
830 if (NILP (tem)) 591 if (NILP (tem))
831 Fset_default (sym, eval_sub (Fcar (tail))); 592 Fset_default (sym, eval_sub (Fcar (tail)));
832 else 593 else
833 { /* Check if there is really a global binding rather than just a let 594 { /* Check if there is really a global binding rather than just a let
834 binding that shadows the global unboundness of the var. */ 595 binding that shadows the global unboundness of the var. */
835 volatile struct specbinding *pdl = specpdl_ptr; 596 struct specbinding *pdl = specpdl_ptr;
836 while (--pdl >= specpdl) 597 while (pdl > specpdl)
837 { 598 {
838 if (EQ (pdl->symbol, sym) && !pdl->func 599 if (EQ ((--pdl)->symbol, sym) && !pdl->func
839 && EQ (pdl->old_value, Qunbound)) 600 && EQ (pdl->old_value, Qunbound))
840 { 601 {
841 message_with_string ("Warning: defvar ignored because %s is let-bound", 602 message_with_string
842 SYMBOL_NAME (sym), 1); 603 ("Warning: defvar ignored because %s is let-bound",
604 SYMBOL_NAME (sym), 1);
843 break; 605 break;
844 } 606 }
845 } 607 }
@@ -859,8 +621,8 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
859 /* A simple (defvar foo) with lexical scoping does "nothing" except 621 /* A simple (defvar foo) with lexical scoping does "nothing" except
860 declare that var to be dynamically scoped *locally* (i.e. within 622 declare that var to be dynamically scoped *locally* (i.e. within
861 the current file or let-block). */ 623 the current file or let-block). */
862 Vinternal_interpreter_environment = 624 Vinternal_interpreter_environment
863 Fcons (sym, Vinternal_interpreter_environment); 625 = Fcons (sym, Vinternal_interpreter_environment);
864 else 626 else
865 { 627 {
866 /* Simple (defvar <var>) should not count as a definition at all. 628 /* Simple (defvar <var>) should not count as a definition at all.
@@ -873,15 +635,19 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
873 635
874DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0, 636DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0,
875 doc: /* Define SYMBOL as a constant variable. 637 doc: /* Define SYMBOL as a constant variable.
876The intent is that neither programs nor users should ever change this value. 638This declares that neither programs nor users should ever change the
877Always sets the value of SYMBOL to the result of evalling INITVALUE. 639value. This constancy is not actually enforced by Emacs Lisp, but
878If SYMBOL is buffer-local, its default value is what is set; 640SYMBOL is marked as a special variable so that it is never lexically
879 buffer-local values are not affected. 641bound.
880DOCSTRING is optional. 642
881 643The `defconst' form always sets the value of SYMBOL to the result of
882If SYMBOL has a local binding, then this form sets the local binding's 644evalling INITVALUE. If SYMBOL is buffer-local, its default value is
883value. However, you should normally not make local bindings for 645what is set; buffer-local values are not affected. If SYMBOL has a
884variables defined with this form. 646local binding, then this form sets the local binding's value.
647However, you should normally not make local bindings for variables
648defined with this form.
649
650The optional DOCSTRING specifies the variable's documentation string.
885usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) 651usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
886 (Lisp_Object args) 652 (Lisp_Object args)
887{ 653{
@@ -908,70 +674,17 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
908 return sym; 674 return sym;
909} 675}
910 676
911/* Error handler used in Fuser_variable_p. */ 677/* Make SYMBOL lexically scoped. */
912static Lisp_Object 678DEFUN ("internal-make-var-non-special", Fmake_var_non_special,
913user_variable_p_eh (Lisp_Object ignore) 679 Smake_var_non_special, 1, 1, 0,
680 doc: /* Internal function. */)
681 (Lisp_Object symbol)
914{ 682{
683 CHECK_SYMBOL (symbol);
684 XSYMBOL (symbol)->declared_special = 0;
915 return Qnil; 685 return Qnil;
916} 686}
917 687
918static Lisp_Object
919lisp_indirect_variable (Lisp_Object sym)
920{
921 struct Lisp_Symbol *s = indirect_variable (XSYMBOL (sym));
922 XSETSYMBOL (sym, s);
923 return sym;
924}
925
926DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0,
927 doc: /* Return t if VARIABLE is intended to be set and modified by users.
928\(The alternative is a variable used internally in a Lisp program.)
929A variable is a user variable if
930\(1) the first character of its documentation is `*', or
931\(2) it is customizable (its property list contains a non-nil value
932 of `standard-value' or `custom-autoload'), or
933\(3) it is an alias for another user variable.
934Return nil if VARIABLE is an alias and there is a loop in the
935chain of symbols. */)
936 (Lisp_Object variable)
937{
938 Lisp_Object documentation;
939
940 if (!SYMBOLP (variable))
941 return Qnil;
942
943 /* If indirect and there's an alias loop, don't check anything else. */
944 if (XSYMBOL (variable)->redirect == SYMBOL_VARALIAS
945 && NILP (internal_condition_case_1 (lisp_indirect_variable, variable,
946 Qt, user_variable_p_eh)))
947 return Qnil;
948
949 while (1)
950 {
951 documentation = Fget (variable, Qvariable_documentation);
952 if (INTEGERP (documentation) && XINT (documentation) < 0)
953 return Qt;
954 if (STRINGP (documentation)
955 && ((unsigned char) SREF (documentation, 0) == '*'))
956 return Qt;
957 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
958 if (CONSP (documentation)
959 && STRINGP (XCAR (documentation))
960 && INTEGERP (XCDR (documentation))
961 && XINT (XCDR (documentation)) < 0)
962 return Qt;
963 /* Customizable? See `custom-variable-p'. */
964 if ((!NILP (Fget (variable, intern ("standard-value"))))
965 || (!NILP (Fget (variable, intern ("custom-autoload")))))
966 return Qt;
967
968 if (!(XSYMBOL (variable)->redirect == SYMBOL_VARALIAS))
969 return Qnil;
970
971 /* An indirect variable? Let's follow the chain. */
972 XSETSYMBOL (variable, SYMBOL_ALIAS (XSYMBOL (variable)));
973 }
974}
975 688
976DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0, 689DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,
977 doc: /* Bind variables according to VARLIST then eval BODY. 690 doc: /* Bind variables according to VARLIST then eval BODY.
@@ -983,7 +696,7 @@ usage: (let* VARLIST BODY...) */)
983 (Lisp_Object args) 696 (Lisp_Object args)
984{ 697{
985 Lisp_Object varlist, var, val, elt, lexenv; 698 Lisp_Object varlist, var, val, elt, lexenv;
986 int count = SPECPDL_INDEX (); 699 ptrdiff_t count = SPECPDL_INDEX ();
987 struct gcpro gcpro1, gcpro2, gcpro3; 700 struct gcpro gcpro1, gcpro2, gcpro3;
988 701
989 GCPRO3 (args, elt, varlist); 702 GCPRO3 (args, elt, varlist);
@@ -1046,7 +759,7 @@ usage: (let VARLIST BODY...) */)
1046{ 759{
1047 Lisp_Object *temps, tem, lexenv; 760 Lisp_Object *temps, tem, lexenv;
1048 register Lisp_Object elt, varlist; 761 register Lisp_Object elt, varlist;
1049 int count = SPECPDL_INDEX (); 762 ptrdiff_t count = SPECPDL_INDEX ();
1050 ptrdiff_t argnum; 763 ptrdiff_t argnum;
1051 struct gcpro gcpro1, gcpro2; 764 struct gcpro gcpro1, gcpro2;
1052 USE_SAFE_ALLOCA; 765 USE_SAFE_ALLOCA;
@@ -1162,7 +875,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
1162 if (NILP (tem)) 875 if (NILP (tem))
1163 { 876 {
1164 def = XSYMBOL (sym)->function; 877 def = XSYMBOL (sym)->function;
1165 if (!EQ (def, Qunbound)) 878 if (!NILP (def))
1166 continue; 879 continue;
1167 } 880 }
1168 break; 881 break;
@@ -1173,26 +886,14 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
1173 { 886 {
1174 /* SYM is not mentioned in ENVIRONMENT. 887 /* SYM is not mentioned in ENVIRONMENT.
1175 Look at its function definition. */ 888 Look at its function definition. */
1176 if (EQ (def, Qunbound) || !CONSP (def)) 889 struct gcpro gcpro1;
890 GCPRO1 (form);
891 def = Fautoload_do_load (def, sym, Qmacro);
892 UNGCPRO;
893 if (!CONSP (def))
1177 /* Not defined or definition not suitable. */ 894 /* Not defined or definition not suitable. */
1178 break; 895 break;
1179 if (EQ (XCAR (def), Qautoload)) 896 if (!EQ (XCAR (def), Qmacro))
1180 {
1181 /* Autoloading function: will it be a macro when loaded? */
1182 tem = Fnth (make_number (4), def);
1183 if (EQ (tem, Qt) || EQ (tem, Qmacro))
1184 /* Yes, load it and try again. */
1185 {
1186 struct gcpro gcpro1;
1187 GCPRO1 (form);
1188 do_autoload (def, sym);
1189 UNGCPRO;
1190 continue;
1191 }
1192 else
1193 break;
1194 }
1195 else if (!EQ (XCAR (def), Qmacro))
1196 break; 897 break;
1197 else expander = XCDR (def); 898 else expander = XCDR (def);
1198 } 899 }
@@ -1202,7 +903,13 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
1202 if (NILP (expander)) 903 if (NILP (expander))
1203 break; 904 break;
1204 } 905 }
1205 form = apply1 (expander, XCDR (form)); 906 {
907 Lisp_Object newform = apply1 (expander, XCDR (form));
908 if (EQ (form, newform))
909 break;
910 else
911 form = newform;
912 }
1206 } 913 }
1207 return form; 914 return form;
1208} 915}
@@ -1252,7 +959,7 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
1252 catchlist = &c; 959 catchlist = &c;
1253 960
1254 /* Call FUNC. */ 961 /* Call FUNC. */
1255 if (! _setjmp (c.jmp)) 962 if (! sys_setjmp (c.jmp))
1256 c.val = (*func) (arg); 963 c.val = (*func) (arg);
1257 964
1258 /* Throw works by a longjmp that comes right here. */ 965 /* Throw works by a longjmp that comes right here. */
@@ -1263,7 +970,7 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
1263/* Unwind the specbind, catch, and handler stacks back to CATCH, and 970/* Unwind the specbind, catch, and handler stacks back to CATCH, and
1264 jump to that CATCH, returning VALUE as the value of that catch. 971 jump to that CATCH, returning VALUE as the value of that catch.
1265 972
1266 This is the guts Fthrow and Fsignal; they differ only in the way 973 This is the guts of Fthrow and Fsignal; they differ only in the way
1267 they choose the catch tag to throw to. A catch tag for a 974 they choose the catch tag to throw to. A catch tag for a
1268 condition-case form has a TAG of Qnil. 975 condition-case form has a TAG of Qnil.
1269 976
@@ -1272,22 +979,21 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
1272 the handler stack as we go, so that the proper handlers are in 979 the handler stack as we go, so that the proper handlers are in
1273 effect for each unwind-protect clause we run. At the end, restore 980 effect for each unwind-protect clause we run. At the end, restore
1274 some static info saved in CATCH, and longjmp to the location 981 some static info saved in CATCH, and longjmp to the location
1275 specified in the 982 specified there.
1276 983
1277 This is used for correct unwinding in Fthrow and Fsignal. */ 984 This is used for correct unwinding in Fthrow and Fsignal. */
1278 985
1279static void 986static _Noreturn void
1280unwind_to_catch (struct catchtag *catch, Lisp_Object value) 987unwind_to_catch (struct catchtag *catch, Lisp_Object value)
1281{ 988{
1282 register int last_time; 989 bool last_time;
1283 990
1284 /* Save the value in the tag. */ 991 /* Save the value in the tag. */
1285 catch->val = value; 992 catch->val = value;
1286 993
1287 /* Restore certain special C variables. */ 994 /* Restore certain special C variables. */
1288 set_poll_suppress_count (catch->poll_suppress_count); 995 set_poll_suppress_count (catch->poll_suppress_count);
1289 UNBLOCK_INPUT_TO (catch->interrupt_input_blocked); 996 unblock_input_to (catch->interrupt_input_blocked);
1290 handling_signal = 0;
1291 immediate_quit = 0; 997 immediate_quit = 0;
1292 998
1293 do 999 do
@@ -1302,16 +1008,6 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value)
1302 } 1008 }
1303 while (! last_time); 1009 while (! last_time);
1304 1010
1305#if HAVE_X_WINDOWS
1306 /* If x_catch_errors was done, turn it off now.
1307 (First we give unbind_to a chance to do that.) */
1308#if 0 /* This would disable x_catch_errors after x_connection_closed.
1309 The catch must remain in effect during that delicate
1310 state. --lorentey */
1311 x_fully_uncatch_errors ();
1312#endif
1313#endif
1314
1315 byte_stack_list = catch->byte_stack; 1011 byte_stack_list = catch->byte_stack;
1316 gcprolist = catch->gcpro; 1012 gcprolist = catch->gcpro;
1317#ifdef DEBUG_GCPRO 1013#ifdef DEBUG_GCPRO
@@ -1320,7 +1016,7 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value)
1320 backtrace_list = catch->backlist; 1016 backtrace_list = catch->backlist;
1321 lisp_eval_depth = catch->lisp_eval_depth; 1017 lisp_eval_depth = catch->lisp_eval_depth;
1322 1018
1323 _longjmp (catch->jmp, 1); 1019 sys_longjmp (catch->jmp, 1);
1324} 1020}
1325 1021
1326DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0, 1022DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
@@ -1349,7 +1045,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1349 (Lisp_Object args) 1045 (Lisp_Object args)
1350{ 1046{
1351 Lisp_Object val; 1047 Lisp_Object val;
1352 int count = SPECPDL_INDEX (); 1048 ptrdiff_t count = SPECPDL_INDEX ();
1353 1049
1354 record_unwind_protect (Fprogn, Fcdr (args)); 1050 record_unwind_protect (Fprogn, Fcdr (args));
1355 val = eval_sub (Fcar (args)); 1051 val = eval_sub (Fcar (args));
@@ -1384,12 +1080,9 @@ See also the function `signal' for more info.
1384usage: (condition-case VAR BODYFORM &rest HANDLERS) */) 1080usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1385 (Lisp_Object args) 1081 (Lisp_Object args)
1386{ 1082{
1387 register Lisp_Object bodyform, handlers; 1083 Lisp_Object var = Fcar (args);
1388 volatile Lisp_Object var; 1084 Lisp_Object bodyform = Fcar (Fcdr (args));
1389 1085 Lisp_Object handlers = Fcdr (Fcdr (args));
1390 var = Fcar (args);
1391 bodyform = Fcar (Fcdr (args));
1392 handlers = Fcdr (Fcdr (args));
1393 1086
1394 return internal_lisp_condition_case (var, bodyform, handlers); 1087 return internal_lisp_condition_case (var, bodyform, handlers);
1395} 1088}
@@ -1429,7 +1122,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
1429 c.interrupt_input_blocked = interrupt_input_blocked; 1122 c.interrupt_input_blocked = interrupt_input_blocked;
1430 c.gcpro = gcprolist; 1123 c.gcpro = gcprolist;
1431 c.byte_stack = byte_stack_list; 1124 c.byte_stack = byte_stack_list;
1432 if (_setjmp (c.jmp)) 1125 if (sys_setjmp (c.jmp))
1433 { 1126 {
1434 if (!NILP (h.var)) 1127 if (!NILP (h.var))
1435 specbind (h.var, c.val); 1128 specbind (h.var, c.val);
@@ -1484,7 +1177,7 @@ internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers,
1484 c.interrupt_input_blocked = interrupt_input_blocked; 1177 c.interrupt_input_blocked = interrupt_input_blocked;
1485 c.gcpro = gcprolist; 1178 c.gcpro = gcprolist;
1486 c.byte_stack = byte_stack_list; 1179 c.byte_stack = byte_stack_list;
1487 if (_setjmp (c.jmp)) 1180 if (sys_setjmp (c.jmp))
1488 { 1181 {
1489 return (*hfun) (c.val); 1182 return (*hfun) (c.val);
1490 } 1183 }
@@ -1522,7 +1215,7 @@ internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg,
1522 c.interrupt_input_blocked = interrupt_input_blocked; 1215 c.interrupt_input_blocked = interrupt_input_blocked;
1523 c.gcpro = gcprolist; 1216 c.gcpro = gcprolist;
1524 c.byte_stack = byte_stack_list; 1217 c.byte_stack = byte_stack_list;
1525 if (_setjmp (c.jmp)) 1218 if (sys_setjmp (c.jmp))
1526 { 1219 {
1527 return (*hfun) (c.val); 1220 return (*hfun) (c.val);
1528 } 1221 }
@@ -1564,7 +1257,7 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object),
1564 c.interrupt_input_blocked = interrupt_input_blocked; 1257 c.interrupt_input_blocked = interrupt_input_blocked;
1565 c.gcpro = gcprolist; 1258 c.gcpro = gcprolist;
1566 c.byte_stack = byte_stack_list; 1259 c.byte_stack = byte_stack_list;
1567 if (_setjmp (c.jmp)) 1260 if (sys_setjmp (c.jmp))
1568 { 1261 {
1569 return (*hfun) (c.val); 1262 return (*hfun) (c.val);
1570 } 1263 }
@@ -1590,7 +1283,9 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
1590 ptrdiff_t nargs, 1283 ptrdiff_t nargs,
1591 Lisp_Object *args, 1284 Lisp_Object *args,
1592 Lisp_Object handlers, 1285 Lisp_Object handlers,
1593 Lisp_Object (*hfun) (Lisp_Object)) 1286 Lisp_Object (*hfun) (Lisp_Object err,
1287 ptrdiff_t nargs,
1288 Lisp_Object *args))
1594{ 1289{
1595 Lisp_Object val; 1290 Lisp_Object val;
1596 struct catchtag c; 1291 struct catchtag c;
@@ -1606,9 +1301,9 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
1606 c.interrupt_input_blocked = interrupt_input_blocked; 1301 c.interrupt_input_blocked = interrupt_input_blocked;
1607 c.gcpro = gcprolist; 1302 c.gcpro = gcprolist;
1608 c.byte_stack = byte_stack_list; 1303 c.byte_stack = byte_stack_list;
1609 if (_setjmp (c.jmp)) 1304 if (sys_setjmp (c.jmp))
1610 { 1305 {
1611 return (*hfun) (c.val); 1306 return (*hfun) (c.val, nargs, args);
1612 } 1307 }
1613 c.next = catchlist; 1308 c.next = catchlist;
1614 catchlist = &c; 1309 catchlist = &c;
@@ -1626,8 +1321,8 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
1626 1321
1627 1322
1628static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object); 1323static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object);
1629static int maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, 1324static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
1630 Lisp_Object data); 1325 Lisp_Object data);
1631 1326
1632void 1327void
1633process_quit_flag (void) 1328process_quit_flag (void)
@@ -1668,10 +1363,10 @@ See also the function `condition-case'. */)
1668 struct handler *h; 1363 struct handler *h;
1669 struct backtrace *bp; 1364 struct backtrace *bp;
1670 1365
1671 immediate_quit = handling_signal = 0; 1366 immediate_quit = 0;
1672 abort_on_gc = 0; 1367 abort_on_gc = 0;
1673 if (gc_in_progress || waiting_for_input) 1368 if (gc_in_progress || waiting_for_input)
1674 abort (); 1369 emacs_abort ();
1675 1370
1676#if 0 /* rms: I don't know why this was here, 1371#if 0 /* rms: I don't know why this was here,
1677 but it is surely wrong for an error that is handled. */ 1372 but it is surely wrong for an error that is handled. */
@@ -1705,10 +1400,10 @@ See also the function `condition-case'. */)
1705 if (backtrace_list && !NILP (error_symbol)) 1400 if (backtrace_list && !NILP (error_symbol))
1706 { 1401 {
1707 bp = backtrace_list->next; 1402 bp = backtrace_list->next;
1708 if (bp && bp->function && EQ (*bp->function, Qerror)) 1403 if (bp && EQ (bp->function, Qerror))
1709 bp = bp->next; 1404 bp = bp->next;
1710 if (bp && bp->function) 1405 if (bp)
1711 Vsignaling_function = *bp->function; 1406 Vsignaling_function = bp->function;
1712 } 1407 }
1713 1408
1714 for (h = handlerlist; h; h = h->next) 1409 for (h = handlerlist; h; h = h->next)
@@ -1719,7 +1414,7 @@ See also the function `condition-case'. */)
1719 } 1414 }
1720 1415
1721 if (/* Don't run the debugger for a memory-full error. 1416 if (/* Don't run the debugger for a memory-full error.
1722 (There is no room in memory to do that!) */ 1417 (There is no room in memory to do that!) */
1723 !NILP (error_symbol) 1418 !NILP (error_symbol)
1724 && (!NILP (Vdebug_on_signal) 1419 && (!NILP (Vdebug_on_signal)
1725 /* If no handler is present now, try to run the debugger. */ 1420 /* If no handler is present now, try to run the debugger. */
@@ -1732,7 +1427,7 @@ See also the function `condition-case'. */)
1732 if requested". */ 1427 if requested". */
1733 || EQ (h->handler, Qerror))) 1428 || EQ (h->handler, Qerror)))
1734 { 1429 {
1735 int debugger_called 1430 bool debugger_called
1736 = maybe_call_debugger (conditions, error_symbol, data); 1431 = maybe_call_debugger (conditions, error_symbol, data);
1737 /* We can't return values to code which signaled an error, but we 1432 /* We can't return values to code which signaled an error, but we
1738 can continue code which has signaled a quit. */ 1433 can continue code which has signaled a quit. */
@@ -1768,7 +1463,7 @@ void
1768xsignal (Lisp_Object error_symbol, Lisp_Object data) 1463xsignal (Lisp_Object error_symbol, Lisp_Object data)
1769{ 1464{
1770 Fsignal (error_symbol, data); 1465 Fsignal (error_symbol, data);
1771 abort (); 1466 emacs_abort ();
1772} 1467}
1773 1468
1774/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */ 1469/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
@@ -1826,10 +1521,10 @@ signal_error (const char *s, Lisp_Object arg)
1826} 1521}
1827 1522
1828 1523
1829/* Return nonzero if LIST is a non-nil atom or 1524/* Return true if LIST is a non-nil atom or
1830 a list containing one of CONDITIONS. */ 1525 a list containing one of CONDITIONS. */
1831 1526
1832static int 1527static bool
1833wants_debugger (Lisp_Object list, Lisp_Object conditions) 1528wants_debugger (Lisp_Object list, Lisp_Object conditions)
1834{ 1529{
1835 if (NILP (list)) 1530 if (NILP (list))
@@ -1849,15 +1544,15 @@ wants_debugger (Lisp_Object list, Lisp_Object conditions)
1849 return 0; 1544 return 0;
1850} 1545}
1851 1546
1852/* Return 1 if an error with condition-symbols CONDITIONS, 1547/* Return true if an error with condition-symbols CONDITIONS,
1853 and described by SIGNAL-DATA, should skip the debugger 1548 and described by SIGNAL-DATA, should skip the debugger
1854 according to debugger-ignored-errors. */ 1549 according to debugger-ignored-errors. */
1855 1550
1856static int 1551static bool
1857skip_debugger (Lisp_Object conditions, Lisp_Object data) 1552skip_debugger (Lisp_Object conditions, Lisp_Object data)
1858{ 1553{
1859 Lisp_Object tail; 1554 Lisp_Object tail;
1860 int first_string = 1; 1555 bool first_string = 1;
1861 Lisp_Object error_message; 1556 Lisp_Object error_message;
1862 1557
1863 error_message = Qnil; 1558 error_message = Qnil;
@@ -1892,7 +1587,7 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data)
1892 = SIG is the error symbol, and DATA is the rest of the data. 1587 = SIG is the error symbol, and DATA is the rest of the data.
1893 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA). 1588 = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
1894 This is for memory-full errors only. */ 1589 This is for memory-full errors only. */
1895static int 1590static bool
1896maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data) 1591maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
1897{ 1592{
1898 Lisp_Object combined_data; 1593 Lisp_Object combined_data;
@@ -1902,7 +1597,8 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
1902 if ( 1597 if (
1903 /* Don't try to run the debugger with interrupts blocked. 1598 /* Don't try to run the debugger with interrupts blocked.
1904 The editing loop would return anyway. */ 1599 The editing loop would return anyway. */
1905 ! INPUT_BLOCKED_P 1600 ! input_blocked_p ()
1601 && NILP (Vinhibit_debugger)
1906 /* Does user want to enter debugger for this kind of error? */ 1602 /* Does user want to enter debugger for this kind of error? */
1907 && (EQ (sig, Qquit) 1603 && (EQ (sig, Qquit)
1908 ? debug_on_quit 1604 ? debug_on_quit
@@ -2019,12 +1715,12 @@ then strings and vectors are not accepted. */)
2019 1715
2020 fun = function; 1716 fun = function;
2021 1717
2022 fun = indirect_function (fun); /* Check cycles. */ 1718 fun = indirect_function (fun); /* Check cycles. */
2023 if (NILP (fun) || EQ (fun, Qunbound)) 1719 if (NILP (fun))
2024 return Qnil; 1720 return Qnil;
2025 1721
2026 /* Check an `interactive-form' property if present, analogous to the 1722 /* Check an `interactive-form' property if present, analogous to the
2027 function-documentation property. */ 1723 function-documentation property. */
2028 fun = function; 1724 fun = function;
2029 while (SYMBOLP (fun)) 1725 while (SYMBOLP (fun))
2030 { 1726 {
@@ -2084,25 +1780,19 @@ this does nothing and returns nil. */)
2084 CHECK_STRING (file); 1780 CHECK_STRING (file);
2085 1781
2086 /* If function is defined and not as an autoload, don't override. */ 1782 /* If function is defined and not as an autoload, don't override. */
2087 if (!EQ (XSYMBOL (function)->function, Qunbound) 1783 if (!NILP (XSYMBOL (function)->function)
2088 && !(CONSP (XSYMBOL (function)->function) 1784 && !AUTOLOADP (XSYMBOL (function)->function))
2089 && EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
2090 return Qnil; 1785 return Qnil;
2091 1786
2092 if (NILP (Vpurify_flag)) 1787 if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0)))
2093 /* Only add entries after dumping, because the ones before are 1788 /* `read1' in lread.c has found the docstring starting with "\
2094 not useful and else we get loads of them from the loaddefs.el. */ 1789 and assumed the docstring will be provided by Snarf-documentation, so it
2095 LOADHIST_ATTACH (Fcons (Qautoload, function)); 1790 passed us 0 instead. But that leads to accidental sharing in purecopy's
2096 else 1791 hash-consing, so we use a (hopefully) unique integer instead. */
2097 /* We don't want the docstring in purespace (instead, 1792 docstring = make_number (XHASH (function));
2098 Snarf-documentation should (hopefully) overwrite it). 1793 return Fdefalias (function,
2099 We used to use 0 here, but that leads to accidental sharing in 1794 list5 (Qautoload, file, docstring, interactive, type),
2100 purecopy's hash-consing, so we use a (hopefully) unique integer 1795 Qnil);
2101 instead. */
2102 docstring = make_number (XPNTR (function));
2103 return Ffset (function,
2104 Fpurecopy (list5 (Qautoload, file, docstring,
2105 interactive, type)));
2106} 1796}
2107 1797
2108Lisp_Object 1798Lisp_Object
@@ -2132,22 +1822,35 @@ un_autoload (Lisp_Object oldqueue)
2132 FUNNAME is the symbol which is the function's name. 1822 FUNNAME is the symbol which is the function's name.
2133 FUNDEF is the autoload definition (a list). */ 1823 FUNDEF is the autoload definition (a list). */
2134 1824
2135void 1825DEFUN ("autoload-do-load", Fautoload_do_load, Sautoload_do_load, 1, 3, 0,
2136do_autoload (Lisp_Object fundef, Lisp_Object funname) 1826 doc: /* Load FUNDEF which should be an autoload.
1827If non-nil, FUNNAME should be the symbol whose function value is FUNDEF,
1828in which case the function returns the new autoloaded function value.
1829If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if
1830it is defines a macro. */)
1831 (Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only)
2137{ 1832{
2138 int count = SPECPDL_INDEX (); 1833 ptrdiff_t count = SPECPDL_INDEX ();
2139 Lisp_Object fun;
2140 struct gcpro gcpro1, gcpro2, gcpro3; 1834 struct gcpro gcpro1, gcpro2, gcpro3;
2141 1835
1836 if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef)))
1837 return fundef;
1838
1839 if (EQ (macro_only, Qmacro))
1840 {
1841 Lisp_Object kind = Fnth (make_number (4), fundef);
1842 if (! (EQ (kind, Qt) || EQ (kind, Qmacro)))
1843 return fundef;
1844 }
1845
2142 /* This is to make sure that loadup.el gives a clear picture 1846 /* This is to make sure that loadup.el gives a clear picture
2143 of what files are preloaded and when. */ 1847 of what files are preloaded and when. */
2144 if (! NILP (Vpurify_flag)) 1848 if (! NILP (Vpurify_flag))
2145 error ("Attempt to autoload %s while preparing to dump", 1849 error ("Attempt to autoload %s while preparing to dump",
2146 SDATA (SYMBOL_NAME (funname))); 1850 SDATA (SYMBOL_NAME (funname)));
2147 1851
2148 fun = funname;
2149 CHECK_SYMBOL (funname); 1852 CHECK_SYMBOL (funname);
2150 GCPRO3 (fun, funname, fundef); 1853 GCPRO3 (funname, fundef, macro_only);
2151 1854
2152 /* Preserve the match data. */ 1855 /* Preserve the match data. */
2153 record_unwind_save_match_data (); 1856 record_unwind_save_match_data ();
@@ -2162,18 +1865,28 @@ do_autoload (Lisp_Object fundef, Lisp_Object funname)
2162 The value saved here is to be restored into Vautoload_queue. */ 1865 The value saved here is to be restored into Vautoload_queue. */
2163 record_unwind_protect (un_autoload, Vautoload_queue); 1866 record_unwind_protect (un_autoload, Vautoload_queue);
2164 Vautoload_queue = Qt; 1867 Vautoload_queue = Qt;
2165 Fload (Fcar (Fcdr (fundef)), Qnil, Qt, Qnil, Qt); 1868 /* If `macro_only', assume this autoload to be a "best-effort",
1869 so don't signal an error if autoloading fails. */
1870 Fload (Fcar (Fcdr (fundef)), macro_only, Qt, Qnil, Qt);
2166 1871
2167 /* Once loading finishes, don't undo it. */ 1872 /* Once loading finishes, don't undo it. */
2168 Vautoload_queue = Qt; 1873 Vautoload_queue = Qt;
2169 unbind_to (count, Qnil); 1874 unbind_to (count, Qnil);
2170 1875
2171 fun = Findirect_function (fun, Qnil);
2172
2173 if (!NILP (Fequal (fun, fundef)))
2174 error ("Autoloading failed to define function %s",
2175 SDATA (SYMBOL_NAME (funname)));
2176 UNGCPRO; 1876 UNGCPRO;
1877
1878 if (NILP (funname))
1879 return Qnil;
1880 else
1881 {
1882 Lisp_Object fun = Findirect_function (funname, Qnil);
1883
1884 if (!NILP (Fequal (fun, fundef)))
1885 error ("Autoloading failed to define function %s",
1886 SDATA (SYMBOL_NAME (funname)));
1887 else
1888 return fun;
1889 }
2177} 1890}
2178 1891
2179 1892
@@ -2182,7 +1895,7 @@ DEFUN ("eval", Feval, Seval, 1, 2, 0,
2182If LEXICAL is t, evaluate using lexical scoping. */) 1895If LEXICAL is t, evaluate using lexical scoping. */)
2183 (Lisp_Object form, Lisp_Object lexical) 1896 (Lisp_Object form, Lisp_Object lexical)
2184{ 1897{
2185 int count = SPECPDL_INDEX (); 1898 ptrdiff_t count = SPECPDL_INDEX ();
2186 specbind (Qinternal_interpreter_environment, 1899 specbind (Qinternal_interpreter_environment,
2187 NILP (lexical) ? Qnil : Fcons (Qt, Qnil)); 1900 NILP (lexical) ? Qnil : Fcons (Qt, Qnil));
2188 return unbind_to (count, eval_sub (form)); 1901 return unbind_to (count, eval_sub (form));
@@ -2198,9 +1911,6 @@ eval_sub (Lisp_Object form)
2198 struct backtrace backtrace; 1911 struct backtrace backtrace;
2199 struct gcpro gcpro1, gcpro2, gcpro3; 1912 struct gcpro gcpro1, gcpro2, gcpro3;
2200 1913
2201 if (handling_signal)
2202 abort ();
2203
2204 if (SYMBOLP (form)) 1914 if (SYMBOLP (form))
2205 { 1915 {
2206 /* Look up its binding in the lexical environment. 1916 /* Look up its binding in the lexical environment.
@@ -2220,15 +1930,7 @@ eval_sub (Lisp_Object form)
2220 return form; 1930 return form;
2221 1931
2222 QUIT; 1932 QUIT;
2223 if ((consing_since_gc > gc_cons_threshold 1933 maybe_gc ();
2224 && consing_since_gc > gc_relative_threshold)
2225 ||
2226 (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
2227 {
2228 GCPRO1 (form);
2229 Fgarbage_collect ();
2230 UNGCPRO;
2231 }
2232 1934
2233 if (++lisp_eval_depth > max_lisp_eval_depth) 1935 if (++lisp_eval_depth > max_lisp_eval_depth)
2234 { 1936 {
@@ -2238,15 +1940,15 @@ eval_sub (Lisp_Object form)
2238 error ("Lisp nesting exceeds `max-lisp-eval-depth'"); 1940 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2239 } 1941 }
2240 1942
2241 original_fun = Fcar (form); 1943 original_fun = XCAR (form);
2242 original_args = Fcdr (form); 1944 original_args = XCDR (form);
2243 1945
2244 backtrace.next = backtrace_list; 1946 backtrace.next = backtrace_list;
2245 backtrace_list = &backtrace; 1947 backtrace.function = original_fun; /* This also protects them from gc. */
2246 backtrace.function = &original_fun; /* This also protects them from gc. */
2247 backtrace.args = &original_args; 1948 backtrace.args = &original_args;
2248 backtrace.nargs = UNEVALLED; 1949 backtrace.nargs = UNEVALLED;
2249 backtrace.debug_on_exit = 0; 1950 backtrace.debug_on_exit = 0;
1951 backtrace_list = &backtrace;
2250 1952
2251 if (debug_on_next_call) 1953 if (debug_on_next_call)
2252 do_debug_on_call (Qt); 1954 do_debug_on_call (Qt);
@@ -2257,7 +1959,7 @@ eval_sub (Lisp_Object form)
2257 1959
2258 /* Optimize for no indirection. */ 1960 /* Optimize for no indirection. */
2259 fun = original_fun; 1961 fun = original_fun;
2260 if (SYMBOLP (fun) && !EQ (fun, Qunbound) 1962 if (SYMBOLP (fun) && !NILP (fun)
2261 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) 1963 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
2262 fun = indirect_function (fun); 1964 fun = indirect_function (fun);
2263 1965
@@ -2271,7 +1973,7 @@ eval_sub (Lisp_Object form)
2271 args_left = original_args; 1973 args_left = original_args;
2272 numargs = Flength (args_left); 1974 numargs = Flength (args_left);
2273 1975
2274 CHECK_CONS_LIST (); 1976 check_cons_list ();
2275 1977
2276 if (XINT (numargs) < XSUBR (fun)->min_args 1978 if (XINT (numargs) < XSUBR (fun)->min_args
2277 || (XSUBR (fun)->max_args >= 0 1979 || (XSUBR (fun)->max_args >= 0
@@ -2371,7 +2073,7 @@ eval_sub (Lisp_Object form)
2371 is supported by this code. We need to either rewrite the 2073 is supported by this code. We need to either rewrite the
2372 subr to use a different argument protocol, or add more 2074 subr to use a different argument protocol, or add more
2373 cases to this switch. */ 2075 cases to this switch. */
2374 abort (); 2076 emacs_abort ();
2375 } 2077 }
2376 } 2078 }
2377 } 2079 }
@@ -2379,7 +2081,7 @@ eval_sub (Lisp_Object form)
2379 val = apply_lambda (fun, original_args); 2081 val = apply_lambda (fun, original_args);
2380 else 2082 else
2381 { 2083 {
2382 if (EQ (fun, Qunbound)) 2084 if (NILP (fun))
2383 xsignal1 (Qvoid_function, original_fun); 2085 xsignal1 (Qvoid_function, original_fun);
2384 if (!CONSP (fun)) 2086 if (!CONSP (fun))
2385 xsignal1 (Qinvalid_function, original_fun); 2087 xsignal1 (Qinvalid_function, original_fun);
@@ -2388,18 +2090,29 @@ eval_sub (Lisp_Object form)
2388 xsignal1 (Qinvalid_function, original_fun); 2090 xsignal1 (Qinvalid_function, original_fun);
2389 if (EQ (funcar, Qautoload)) 2091 if (EQ (funcar, Qautoload))
2390 { 2092 {
2391 do_autoload (fun, original_fun); 2093 Fautoload_do_load (fun, original_fun, Qnil);
2392 goto retry; 2094 goto retry;
2393 } 2095 }
2394 if (EQ (funcar, Qmacro)) 2096 if (EQ (funcar, Qmacro))
2395 val = eval_sub (apply1 (Fcdr (fun), original_args)); 2097 {
2098 ptrdiff_t count = SPECPDL_INDEX ();
2099 Lisp_Object exp;
2100 /* Bind lexical-binding during expansion of the macro, so the
2101 macro can know reliably if the code it outputs will be
2102 interpreted using lexical-binding or not. */
2103 specbind (Qlexical_binding,
2104 NILP (Vinternal_interpreter_environment) ? Qnil : Qt);
2105 exp = apply1 (Fcdr (fun), original_args);
2106 unbind_to (count, Qnil);
2107 val = eval_sub (exp);
2108 }
2396 else if (EQ (funcar, Qlambda) 2109 else if (EQ (funcar, Qlambda)
2397 || EQ (funcar, Qclosure)) 2110 || EQ (funcar, Qclosure))
2398 val = apply_lambda (fun, original_args); 2111 val = apply_lambda (fun, original_args);
2399 else 2112 else
2400 xsignal1 (Qinvalid_function, original_fun); 2113 xsignal1 (Qinvalid_function, original_fun);
2401 } 2114 }
2402 CHECK_CONS_LIST (); 2115 check_cons_list ();
2403 2116
2404 lisp_eval_depth--; 2117 lisp_eval_depth--;
2405 if (backtrace.debug_on_exit) 2118 if (backtrace.debug_on_exit)
@@ -2409,14 +2122,15 @@ eval_sub (Lisp_Object form)
2409 return val; 2122 return val;
2410} 2123}
2411 2124
2412DEFUN ("apply", Fapply, Sapply, 2, MANY, 0, 2125DEFUN ("apply", Fapply, Sapply, 1, MANY, 0,
2413 doc: /* Call FUNCTION with our remaining args, using our last arg as list of args. 2126 doc: /* Call FUNCTION with our remaining args, using our last arg as list of args.
2414Then return the value FUNCTION returns. 2127Then return the value FUNCTION returns.
2415Thus, (apply '+ 1 2 '(3 4)) returns 10. 2128Thus, (apply '+ 1 2 '(3 4)) returns 10.
2416usage: (apply FUNCTION &rest ARGUMENTS) */) 2129usage: (apply FUNCTION &rest ARGUMENTS) */)
2417 (ptrdiff_t nargs, Lisp_Object *args) 2130 (ptrdiff_t nargs, Lisp_Object *args)
2418{ 2131{
2419 ptrdiff_t i, numargs; 2132 ptrdiff_t i;
2133 EMACS_INT numargs;
2420 register Lisp_Object spread_arg; 2134 register Lisp_Object spread_arg;
2421 register Lisp_Object *funcall_args; 2135 register Lisp_Object *funcall_args;
2422 Lisp_Object fun, retval; 2136 Lisp_Object fun, retval;
@@ -2441,10 +2155,10 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
2441 numargs += nargs - 2; 2155 numargs += nargs - 2;
2442 2156
2443 /* Optimize for no indirection. */ 2157 /* Optimize for no indirection. */
2444 if (SYMBOLP (fun) && !EQ (fun, Qunbound) 2158 if (SYMBOLP (fun) && !NILP (fun)
2445 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) 2159 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
2446 fun = indirect_function (fun); 2160 fun = indirect_function (fun);
2447 if (EQ (fun, Qunbound)) 2161 if (NILP (fun))
2448 { 2162 {
2449 /* Let funcall get the error. */ 2163 /* Let funcall get the error. */
2450 fun = args[0]; 2164 fun = args[0];
@@ -2477,7 +2191,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
2477 gcpro1.nvars = 1 + numargs; 2191 gcpro1.nvars = 1 + numargs;
2478 } 2192 }
2479 2193
2480 memcpy (funcall_args, args, nargs * sizeof (Lisp_Object)); 2194 memcpy (funcall_args, args, nargs * word_size);
2481 /* Spread the last arg we got. Its first element goes in 2195 /* Spread the last arg we got. Its first element goes in
2482 the slot that it used to occupy, hence this value of I. */ 2196 the slot that it used to occupy, hence this value of I. */
2483 i = nargs - 1; 2197 i = nargs - 1;
@@ -2536,14 +2250,10 @@ usage: (run-hooks &rest HOOKS) */)
2536DEFUN ("run-hook-with-args", Frun_hook_with_args, 2250DEFUN ("run-hook-with-args", Frun_hook_with_args,
2537 Srun_hook_with_args, 1, MANY, 0, 2251 Srun_hook_with_args, 1, MANY, 0,
2538 doc: /* Run HOOK with the specified arguments ARGS. 2252 doc: /* Run HOOK with the specified arguments ARGS.
2539HOOK should be a symbol, a hook variable. If HOOK has a non-nil 2253HOOK should be a symbol, a hook variable. The value of HOOK
2540value, that value may be a function or a list of functions to be 2254may be nil, a function, or a list of functions. Call each
2541called to run the hook. If the value is a function, it is called with 2255function in order with arguments ARGS. The final return value
2542the given arguments and its return value is returned. If it is a list 2256is unspecified.
2543of functions, those functions are called, in order,
2544with the given arguments ARGS.
2545It is best not to depend on the value returned by `run-hook-with-args',
2546as that may change.
2547 2257
2548Do not use `make-local-variable' to make a hook variable buffer-local. 2258Do not use `make-local-variable' to make a hook variable buffer-local.
2549Instead, use `add-hook' and specify t for the LOCAL argument. 2259Instead, use `add-hook' and specify t for the LOCAL argument.
@@ -2553,17 +2263,18 @@ usage: (run-hook-with-args HOOK &rest ARGS) */)
2553 return run_hook_with_args (nargs, args, funcall_nil); 2263 return run_hook_with_args (nargs, args, funcall_nil);
2554} 2264}
2555 2265
2266/* NB this one still documents a specific non-nil return value.
2267 (As did run-hook-with-args and run-hook-with-args-until-failure
2268 until they were changed in 24.1.) */
2556DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success, 2269DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success,
2557 Srun_hook_with_args_until_success, 1, MANY, 0, 2270 Srun_hook_with_args_until_success, 1, MANY, 0,
2558 doc: /* Run HOOK with the specified arguments ARGS. 2271 doc: /* Run HOOK with the specified arguments ARGS.
2559HOOK should be a symbol, a hook variable. If HOOK has a non-nil 2272HOOK should be a symbol, a hook variable. The value of HOOK
2560value, that value may be a function or a list of functions to be 2273may be nil, a function, or a list of functions. Call each
2561called to run the hook. If the value is a function, it is called with 2274function in order with arguments ARGS, stopping at the first
2562the given arguments and its return value is returned. 2275one that returns non-nil, and return that value. Otherwise (if
2563If it is a list of functions, those functions are called, in order, 2276all functions return nil, or if there are no functions to call),
2564with the given arguments ARGS, until one of them 2277return nil.
2565returns a non-nil value. Then we return that value.
2566However, if they all return nil, we return nil.
2567 2278
2568Do not use `make-local-variable' to make a hook variable buffer-local. 2279Do not use `make-local-variable' to make a hook variable buffer-local.
2569Instead, use `add-hook' and specify t for the LOCAL argument. 2280Instead, use `add-hook' and specify t for the LOCAL argument.
@@ -2582,13 +2293,12 @@ funcall_not (ptrdiff_t nargs, Lisp_Object *args)
2582DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure, 2293DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
2583 Srun_hook_with_args_until_failure, 1, MANY, 0, 2294 Srun_hook_with_args_until_failure, 1, MANY, 0,
2584 doc: /* Run HOOK with the specified arguments ARGS. 2295 doc: /* Run HOOK with the specified arguments ARGS.
2585HOOK should be a symbol, a hook variable. If HOOK has a non-nil 2296HOOK should be a symbol, a hook variable. The value of HOOK
2586value, that value may be a function or a list of functions to be 2297may be nil, a function, or a list of functions. Call each
2587called to run the hook. If the value is a function, it is called with 2298function in order with arguments ARGS, stopping at the first
2588the given arguments and its return value is returned. 2299one that returns nil, and return nil. Otherwise (if all functions
2589If it is a list of functions, those functions are called, in order, 2300return non-nil, or if there are no functions to call), return non-nil
2590with the given arguments ARGS, until one of them returns nil. 2301\(do not rely on the precise return value in this case).
2591Then we return nil. However, if they all return non-nil, we return non-nil.
2592 2302
2593Do not use `make-local-variable' to make a hook variable buffer-local. 2303Do not use `make-local-variable' to make a hook variable buffer-local.
2594Instead, use `add-hook' and specify t for the LOCAL argument. 2304Instead, use `add-hook' and specify t for the LOCAL argument.
@@ -2870,33 +2580,9 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
2870 doc: /* Non-nil if OBJECT is a function. */) 2580 doc: /* Non-nil if OBJECT is a function. */)
2871 (Lisp_Object object) 2581 (Lisp_Object object)
2872{ 2582{
2873 if (SYMBOLP (object) && !NILP (Ffboundp (object))) 2583 if (FUNCTIONP (object))
2874 {
2875 object = Findirect_function (object, Qt);
2876
2877 if (CONSP (object) && EQ (XCAR (object), Qautoload))
2878 {
2879 /* Autoloaded symbols are functions, except if they load
2880 macros or keymaps. */
2881 int i;
2882 for (i = 0; i < 4 && CONSP (object); i++)
2883 object = XCDR (object);
2884
2885 return (CONSP (object) && !NILP (XCAR (object))) ? Qnil : Qt;
2886 }
2887 }
2888
2889 if (SUBRP (object))
2890 return (XSUBR (object)->max_args != UNEVALLED) ? Qt : Qnil;
2891 else if (COMPILEDP (object))
2892 return Qt; 2584 return Qt;
2893 else if (CONSP (object)) 2585 return Qnil;
2894 {
2895 Lisp_Object car = XCAR (object);
2896 return (EQ (car, Qlambda) || EQ (car, Qclosure)) ? Qt : Qnil;
2897 }
2898 else
2899 return Qnil;
2900} 2586}
2901 2587
2902DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0, 2588DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
@@ -2916,11 +2602,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
2916 ptrdiff_t i; 2602 ptrdiff_t i;
2917 2603
2918 QUIT; 2604 QUIT;
2919 if ((consing_since_gc > gc_cons_threshold
2920 && consing_since_gc > gc_relative_threshold)
2921 ||
2922 (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
2923 Fgarbage_collect ();
2924 2605
2925 if (++lisp_eval_depth > max_lisp_eval_depth) 2606 if (++lisp_eval_depth > max_lisp_eval_depth)
2926 { 2607 {
@@ -2931,16 +2612,19 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
2931 } 2612 }
2932 2613
2933 backtrace.next = backtrace_list; 2614 backtrace.next = backtrace_list;
2934 backtrace_list = &backtrace; 2615 backtrace.function = args[0];
2935 backtrace.function = &args[0]; 2616 backtrace.args = &args[1]; /* This also GCPROs them. */
2936 backtrace.args = &args[1];
2937 backtrace.nargs = nargs - 1; 2617 backtrace.nargs = nargs - 1;
2938 backtrace.debug_on_exit = 0; 2618 backtrace.debug_on_exit = 0;
2619 backtrace_list = &backtrace;
2620
2621 /* Call GC after setting up the backtrace, so the latter GCPROs the args. */
2622 maybe_gc ();
2939 2623
2940 if (debug_on_next_call) 2624 if (debug_on_next_call)
2941 do_debug_on_call (Qlambda); 2625 do_debug_on_call (Qlambda);
2942 2626
2943 CHECK_CONS_LIST (); 2627 check_cons_list ();
2944 2628
2945 original_fun = args[0]; 2629 original_fun = args[0];
2946 2630
@@ -2948,7 +2632,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
2948 2632
2949 /* Optimize for no indirection. */ 2633 /* Optimize for no indirection. */
2950 fun = original_fun; 2634 fun = original_fun;
2951 if (SYMBOLP (fun) && !EQ (fun, Qunbound) 2635 if (SYMBOLP (fun) && !NILP (fun)
2952 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) 2636 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
2953 fun = indirect_function (fun); 2637 fun = indirect_function (fun);
2954 2638
@@ -2970,8 +2654,9 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
2970 { 2654 {
2971 if (XSUBR (fun)->max_args > numargs) 2655 if (XSUBR (fun)->max_args > numargs)
2972 { 2656 {
2973 internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object)); 2657 internal_args = alloca (XSUBR (fun)->max_args
2974 memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object)); 2658 * sizeof *internal_args);
2659 memcpy (internal_args, args + 1, numargs * word_size);
2975 for (i = numargs; i < XSUBR (fun)->max_args; i++) 2660 for (i = numargs; i < XSUBR (fun)->max_args; i++)
2976 internal_args[i] = Qnil; 2661 internal_args[i] = Qnil;
2977 } 2662 }
@@ -3027,7 +2712,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
3027 /* If a subr takes more than 8 arguments without using MANY 2712 /* If a subr takes more than 8 arguments without using MANY
3028 or UNEVALLED, we need to extend this function to support it. 2713 or UNEVALLED, we need to extend this function to support it.
3029 Until this is done, there is no way to call the function. */ 2714 Until this is done, there is no way to call the function. */
3030 abort (); 2715 emacs_abort ();
3031 } 2716 }
3032 } 2717 }
3033 } 2718 }
@@ -3035,7 +2720,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
3035 val = funcall_lambda (fun, numargs, args + 1); 2720 val = funcall_lambda (fun, numargs, args + 1);
3036 else 2721 else
3037 { 2722 {
3038 if (EQ (fun, Qunbound)) 2723 if (NILP (fun))
3039 xsignal1 (Qvoid_function, original_fun); 2724 xsignal1 (Qvoid_function, original_fun);
3040 if (!CONSP (fun)) 2725 if (!CONSP (fun))
3041 xsignal1 (Qinvalid_function, original_fun); 2726 xsignal1 (Qinvalid_function, original_fun);
@@ -3047,14 +2732,14 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
3047 val = funcall_lambda (fun, numargs, args + 1); 2732 val = funcall_lambda (fun, numargs, args + 1);
3048 else if (EQ (funcar, Qautoload)) 2733 else if (EQ (funcar, Qautoload))
3049 { 2734 {
3050 do_autoload (fun, original_fun); 2735 Fautoload_do_load (fun, original_fun, Qnil);
3051 CHECK_CONS_LIST (); 2736 check_cons_list ();
3052 goto retry; 2737 goto retry;
3053 } 2738 }
3054 else 2739 else
3055 xsignal1 (Qinvalid_function, original_fun); 2740 xsignal1 (Qinvalid_function, original_fun);
3056 } 2741 }
3057 CHECK_CONS_LIST (); 2742 check_cons_list ();
3058 lisp_eval_depth--; 2743 lisp_eval_depth--;
3059 if (backtrace.debug_on_exit) 2744 if (backtrace.debug_on_exit)
3060 val = call_debugger (Fcons (Qexit, Fcons (val, Qnil))); 2745 val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
@@ -3066,7 +2751,8 @@ static Lisp_Object
3066apply_lambda (Lisp_Object fun, Lisp_Object args) 2751apply_lambda (Lisp_Object fun, Lisp_Object args)
3067{ 2752{
3068 Lisp_Object args_left; 2753 Lisp_Object args_left;
3069 ptrdiff_t i, numargs; 2754 ptrdiff_t i;
2755 EMACS_INT numargs;
3070 register Lisp_Object *arg_vector; 2756 register Lisp_Object *arg_vector;
3071 struct gcpro gcpro1, gcpro2, gcpro3; 2757 struct gcpro gcpro1, gcpro2, gcpro3;
3072 register Lisp_Object tem; 2758 register Lisp_Object tem;
@@ -3111,9 +2797,9 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
3111 register Lisp_Object *arg_vector) 2797 register Lisp_Object *arg_vector)
3112{ 2798{
3113 Lisp_Object val, syms_left, next, lexenv; 2799 Lisp_Object val, syms_left, next, lexenv;
3114 int count = SPECPDL_INDEX (); 2800 ptrdiff_t count = SPECPDL_INDEX ();
3115 ptrdiff_t i; 2801 ptrdiff_t i;
3116 int optional, rest; 2802 bool optional, rest;
3117 2803
3118 if (CONSP (fun)) 2804 if (CONSP (fun))
3119 { 2805 {
@@ -3157,7 +2843,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
3157 lexenv = Qnil; 2843 lexenv = Qnil;
3158 } 2844 }
3159 else 2845 else
3160 abort (); 2846 emacs_abort ();
3161 2847
3162 i = optional = rest = 0; 2848 i = optional = rest = 0;
3163 for (; CONSP (syms_left); syms_left = XCDR (syms_left)) 2849 for (; CONSP (syms_left); syms_left = XCDR (syms_left))
@@ -3250,12 +2936,8 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
3250static void 2936static void
3251grow_specpdl (void) 2937grow_specpdl (void)
3252{ 2938{
3253 register int count = SPECPDL_INDEX (); 2939 register ptrdiff_t count = SPECPDL_INDEX ();
3254 int max_size = 2940 ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX);
3255 min (max_specpdl_size,
3256 min (max (PTRDIFF_MAX, SIZE_MAX) / sizeof (struct specbinding),
3257 INT_MAX));
3258 int size;
3259 if (max_size <= specpdl_size) 2941 if (max_size <= specpdl_size)
3260 { 2942 {
3261 if (max_specpdl_size < 400) 2943 if (max_specpdl_size < 400)
@@ -3263,9 +2945,7 @@ grow_specpdl (void)
3263 if (max_size <= specpdl_size) 2945 if (max_size <= specpdl_size)
3264 signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil); 2946 signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil);
3265 } 2947 }
3266 size = specpdl_size < max_size / 2 ? 2 * specpdl_size : max_size; 2948 specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl);
3267 specpdl = xnrealloc (specpdl, size, sizeof *specpdl);
3268 specpdl_size = size;
3269 specpdl_ptr = specpdl + count; 2949 specpdl_ptr = specpdl + count;
3270} 2950}
3271 2951
@@ -3289,8 +2969,6 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3289{ 2969{
3290 struct Lisp_Symbol *sym; 2970 struct Lisp_Symbol *sym;
3291 2971
3292 eassert (!handling_signal);
3293
3294 CHECK_SYMBOL (symbol); 2972 CHECK_SYMBOL (symbol);
3295 sym = XSYMBOL (symbol); 2973 sym = XSYMBOL (symbol);
3296 if (specpdl_ptr == specpdl + specpdl_size) 2974 if (specpdl_ptr == specpdl + specpdl_size)
@@ -3304,8 +2982,8 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3304 case SYMBOL_PLAINVAL: 2982 case SYMBOL_PLAINVAL:
3305 /* The most common case is that of a non-constant symbol with a 2983 /* The most common case is that of a non-constant symbol with a
3306 trivial value. Make that as fast as we can. */ 2984 trivial value. Make that as fast as we can. */
3307 specpdl_ptr->symbol = symbol; 2985 set_specpdl_symbol (symbol);
3308 specpdl_ptr->old_value = SYMBOL_VAL (sym); 2986 set_specpdl_old_value (SYMBOL_VAL (sym));
3309 specpdl_ptr->func = NULL; 2987 specpdl_ptr->func = NULL;
3310 ++specpdl_ptr; 2988 ++specpdl_ptr;
3311 if (!sym->constant) 2989 if (!sym->constant)
@@ -3320,7 +2998,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3320 { 2998 {
3321 Lisp_Object ovalue = find_symbol_value (symbol); 2999 Lisp_Object ovalue = find_symbol_value (symbol);
3322 specpdl_ptr->func = 0; 3000 specpdl_ptr->func = 0;
3323 specpdl_ptr->old_value = ovalue; 3001 set_specpdl_old_value (ovalue);
3324 3002
3325 eassert (sym->redirect != SYMBOL_LOCALIZED 3003 eassert (sym->redirect != SYMBOL_LOCALIZED
3326 || (EQ (SYMBOL_BLV (sym)->where, 3004 || (EQ (SYMBOL_BLV (sym)->where,
@@ -3337,12 +3015,12 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3337 if (!NILP (Flocal_variable_p (symbol, Qnil))) 3015 if (!NILP (Flocal_variable_p (symbol, Qnil)))
3338 { 3016 {
3339 eassert (sym->redirect != SYMBOL_LOCALIZED 3017 eassert (sym->redirect != SYMBOL_LOCALIZED
3340 || (BLV_FOUND (SYMBOL_BLV (sym)) 3018 || (blv_found (SYMBOL_BLV (sym))
3341 && EQ (cur_buf, SYMBOL_BLV (sym)->where))); 3019 && EQ (cur_buf, SYMBOL_BLV (sym)->where)));
3342 where = cur_buf; 3020 where = cur_buf;
3343 } 3021 }
3344 else if (sym->redirect == SYMBOL_LOCALIZED 3022 else if (sym->redirect == SYMBOL_LOCALIZED
3345 && BLV_FOUND (SYMBOL_BLV (sym))) 3023 && blv_found (SYMBOL_BLV (sym)))
3346 where = SYMBOL_BLV (sym)->where; 3024 where = SYMBOL_BLV (sym)->where;
3347 else 3025 else
3348 where = Qnil; 3026 where = Qnil;
@@ -3354,7 +3032,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3354 let_shadows_buffer_binding_p which is itself only used 3032 let_shadows_buffer_binding_p which is itself only used
3355 in set_internal for local_if_set. */ 3033 in set_internal for local_if_set. */
3356 eassert (NILP (where) || EQ (where, cur_buf)); 3034 eassert (NILP (where) || EQ (where, cur_buf));
3357 specpdl_ptr->symbol = Fcons (symbol, Fcons (where, cur_buf)); 3035 set_specpdl_symbol (Fcons (symbol, Fcons (where, cur_buf)));
3358 3036
3359 /* If SYMBOL is a per-buffer variable which doesn't have a 3037 /* If SYMBOL is a per-buffer variable which doesn't have a
3360 buffer-local value here, make the `let' change the global 3038 buffer-local value here, make the `let' change the global
@@ -3371,31 +3049,29 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3371 } 3049 }
3372 } 3050 }
3373 else 3051 else
3374 specpdl_ptr->symbol = symbol; 3052 set_specpdl_symbol (symbol);
3375 3053
3376 specpdl_ptr++; 3054 specpdl_ptr++;
3377 set_internal (symbol, value, Qnil, 1); 3055 set_internal (symbol, value, Qnil, 1);
3378 break; 3056 break;
3379 } 3057 }
3380 default: abort (); 3058 default: emacs_abort ();
3381 } 3059 }
3382} 3060}
3383 3061
3384void 3062void
3385record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) 3063record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
3386{ 3064{
3387 eassert (!handling_signal);
3388
3389 if (specpdl_ptr == specpdl + specpdl_size) 3065 if (specpdl_ptr == specpdl + specpdl_size)
3390 grow_specpdl (); 3066 grow_specpdl ();
3391 specpdl_ptr->func = function; 3067 specpdl_ptr->func = function;
3392 specpdl_ptr->symbol = Qnil; 3068 set_specpdl_symbol (Qnil);
3393 specpdl_ptr->old_value = arg; 3069 set_specpdl_old_value (arg);
3394 specpdl_ptr++; 3070 specpdl_ptr++;
3395} 3071}
3396 3072
3397Lisp_Object 3073Lisp_Object
3398unbind_to (int count, Lisp_Object value) 3074unbind_to (ptrdiff_t count, Lisp_Object value)
3399{ 3075{
3400 Lisp_Object quitf = Vquit_flag; 3076 Lisp_Object quitf = Vquit_flag;
3401 struct gcpro gcpro1, gcpro2; 3077 struct gcpro gcpro1, gcpro2;
@@ -3475,7 +3151,7 @@ The debugger is entered when that frame exits, if the flag is non-nil. */)
3475 (Lisp_Object level, Lisp_Object flag) 3151 (Lisp_Object level, Lisp_Object flag)
3476{ 3152{
3477 register struct backtrace *backlist = backtrace_list; 3153 register struct backtrace *backlist = backtrace_list;
3478 register int i; 3154 register EMACS_INT i;
3479 3155
3480 CHECK_NUMBER (level); 3156 CHECK_NUMBER (level);
3481 3157
@@ -3512,23 +3188,23 @@ Output stream used is value of `standard-output'. */)
3512 write_string (backlist->debug_on_exit ? "* " : " ", 2); 3188 write_string (backlist->debug_on_exit ? "* " : " ", 2);
3513 if (backlist->nargs == UNEVALLED) 3189 if (backlist->nargs == UNEVALLED)
3514 { 3190 {
3515 Fprin1 (Fcons (*backlist->function, *backlist->args), Qnil); 3191 Fprin1 (Fcons (backlist->function, *backlist->args), Qnil);
3516 write_string ("\n", -1); 3192 write_string ("\n", -1);
3517 } 3193 }
3518 else 3194 else
3519 { 3195 {
3520 tem = *backlist->function; 3196 tem = backlist->function;
3521 Fprin1 (tem, Qnil); /* This can QUIT. */ 3197 Fprin1 (tem, Qnil); /* This can QUIT. */
3522 write_string ("(", -1); 3198 write_string ("(", -1);
3523 if (backlist->nargs == MANY) 3199 if (backlist->nargs == MANY)
3524 { /* FIXME: Can this happen? */ 3200 { /* FIXME: Can this happen? */
3525 int i; 3201 bool later_arg = 0;
3526 for (tail = *backlist->args, i = 0; 3202 for (tail = *backlist->args; !NILP (tail); tail = Fcdr (tail))
3527 !NILP (tail);
3528 tail = Fcdr (tail), i = 1)
3529 { 3203 {
3530 if (i) write_string (" ", -1); 3204 if (later_arg)
3205 write_string (" ", -1);
3531 Fprin1 (Fcar (tail), Qnil); 3206 Fprin1 (Fcar (tail), Qnil);
3207 later_arg = 1;
3532 } 3208 }
3533 } 3209 }
3534 else 3210 else
@@ -3575,7 +3251,7 @@ If NFRAMES is more than the number of frames, the value is nil. */)
3575 if (!backlist) 3251 if (!backlist)
3576 return Qnil; 3252 return Qnil;
3577 if (backlist->nargs == UNEVALLED) 3253 if (backlist->nargs == UNEVALLED)
3578 return Fcons (Qnil, Fcons (*backlist->function, *backlist->args)); 3254 return Fcons (Qnil, Fcons (backlist->function, *backlist->args));
3579 else 3255 else
3580 { 3256 {
3581 if (backlist->nargs == MANY) /* FIXME: Can this happen? */ 3257 if (backlist->nargs == MANY) /* FIXME: Can this happen? */
@@ -3583,7 +3259,7 @@ If NFRAMES is more than the number of frames, the value is nil. */)
3583 else 3259 else
3584 tem = Flist (backlist->nargs, backlist->args); 3260 tem = Flist (backlist->nargs, backlist->args);
3585 3261
3586 return Fcons (Qt, Fcons (*backlist->function, tem)); 3262 return Fcons (Qt, Fcons (backlist->function, tem));
3587 } 3263 }
3588} 3264}
3589 3265
@@ -3597,7 +3273,7 @@ mark_backtrace (void)
3597 3273
3598 for (backlist = backtrace_list; backlist; backlist = backlist->next) 3274 for (backlist = backtrace_list; backlist; backlist = backlist->next)
3599 { 3275 {
3600 mark_object (*backlist->function); 3276 mark_object (backlist->function);
3601 3277
3602 if (backlist->nargs == UNEVALLED 3278 if (backlist->nargs == UNEVALLED
3603 || backlist->nargs == MANY) /* FIXME: Can this happen? */ 3279 || backlist->nargs == MANY) /* FIXME: Can this happen? */
@@ -3614,7 +3290,7 @@ void
3614syms_of_eval (void) 3290syms_of_eval (void)
3615{ 3291{
3616 DEFVAR_INT ("max-specpdl-size", max_specpdl_size, 3292 DEFVAR_INT ("max-specpdl-size", max_specpdl_size,
3617 doc: /* *Limit on number of Lisp variable bindings and `unwind-protect's. 3293 doc: /* Limit on number of Lisp variable bindings and `unwind-protect's.
3618If Lisp code tries to increase the total number past this amount, 3294If Lisp code tries to increase the total number past this amount,
3619an error is signaled. 3295an error is signaled.
3620You can safely use a value considerably larger than the default value, 3296You can safely use a value considerably larger than the default value,
@@ -3622,7 +3298,7 @@ if that proves inconveniently small. However, if you increase it too far,
3622Emacs could run out of memory trying to make the stack bigger. */); 3298Emacs could run out of memory trying to make the stack bigger. */);
3623 3299
3624 DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth, 3300 DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth,
3625 doc: /* *Limit on depth in `eval', `apply' and `funcall' before error. 3301 doc: /* Limit on depth in `eval', `apply' and `funcall' before error.
3626 3302
3627This limit serves to catch infinite recursions for you before they cause 3303This limit serves to catch infinite recursions for you before they cause
3628actual stack overflow in C, which would be fatal for Emacs. 3304actual stack overflow in C, which would be fatal for Emacs.
@@ -3649,7 +3325,7 @@ before making `inhibit-quit' nil. */);
3649 3325
3650 DEFSYM (Qinhibit_quit, "inhibit-quit"); 3326 DEFSYM (Qinhibit_quit, "inhibit-quit");
3651 DEFSYM (Qautoload, "autoload"); 3327 DEFSYM (Qautoload, "autoload");
3652 DEFSYM (Qdebug_on_error, "debug-on-error"); 3328 DEFSYM (Qinhibit_debugger, "inhibit-debugger");
3653 DEFSYM (Qmacro, "macro"); 3329 DEFSYM (Qmacro, "macro");
3654 DEFSYM (Qdeclare, "declare"); 3330 DEFSYM (Qdeclare, "declare");
3655 3331
@@ -3659,14 +3335,19 @@ before making `inhibit-quit' nil. */);
3659 3335
3660 DEFSYM (Qinteractive, "interactive"); 3336 DEFSYM (Qinteractive, "interactive");
3661 DEFSYM (Qcommandp, "commandp"); 3337 DEFSYM (Qcommandp, "commandp");
3662 DEFSYM (Qdefun, "defun");
3663 DEFSYM (Qand_rest, "&rest"); 3338 DEFSYM (Qand_rest, "&rest");
3664 DEFSYM (Qand_optional, "&optional"); 3339 DEFSYM (Qand_optional, "&optional");
3665 DEFSYM (Qclosure, "closure"); 3340 DEFSYM (Qclosure, "closure");
3666 DEFSYM (Qdebug, "debug"); 3341 DEFSYM (Qdebug, "debug");
3667 3342
3343 DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger,
3344 doc: /* Non-nil means never enter the debugger.
3345Normally set while the debugger is already active, to avoid recursive
3346invocations. */);
3347 Vinhibit_debugger = Qnil;
3348
3668 DEFVAR_LISP ("debug-on-error", Vdebug_on_error, 3349 DEFVAR_LISP ("debug-on-error", Vdebug_on_error,
3669 doc: /* *Non-nil means enter debugger if an error is signaled. 3350 doc: /* Non-nil means enter debugger if an error is signaled.
3670Does not apply to errors handled by `condition-case' or those 3351Does not apply to errors handled by `condition-case' or those
3671matched by `debug-ignored-errors'. 3352matched by `debug-ignored-errors'.
3672If the value is a list, an error only means to enter the debugger 3353If the value is a list, an error only means to enter the debugger
@@ -3674,11 +3355,11 @@ if one of its condition symbols appears in the list.
3674When you evaluate an expression interactively, this variable 3355When you evaluate an expression interactively, this variable
3675is temporarily non-nil if `eval-expression-debug-on-error' is non-nil. 3356is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3676The command `toggle-debug-on-error' toggles this. 3357The command `toggle-debug-on-error' toggles this.
3677See also the variable `debug-on-quit'. */); 3358See also the variable `debug-on-quit' and `inhibit-debugger'. */);
3678 Vdebug_on_error = Qnil; 3359 Vdebug_on_error = Qnil;
3679 3360
3680 DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors, 3361 DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors,
3681 doc: /* *List of errors for which the debugger should not be called. 3362 doc: /* List of errors for which the debugger should not be called.
3682Each element may be a condition-name or a regexp that matches error messages. 3363Each element may be a condition-name or a regexp that matches error messages.
3683If any element applies to a given error, that error skips the debugger 3364If any element applies to a given error, that error skips the debugger
3684and just returns to top level. 3365and just returns to top level.
@@ -3687,7 +3368,7 @@ It does not apply to errors handled by `condition-case'. */);
3687 Vdebug_ignored_errors = Qnil; 3368 Vdebug_ignored_errors = Qnil;
3688 3369
3689 DEFVAR_BOOL ("debug-on-quit", debug_on_quit, 3370 DEFVAR_BOOL ("debug-on-quit", debug_on_quit,
3690 doc: /* *Non-nil means enter debugger if quit is signaled (C-g, for example). 3371 doc: /* Non-nil means enter debugger if quit is signaled (C-g, for example).
3691Does not apply if quit is handled by a `condition-case'. */); 3372Does not apply if quit is handled by a `condition-case'. */);
3692 debug_on_quit = 0; 3373 debug_on_quit = 0;
3693 3374
@@ -3716,28 +3397,21 @@ The Edebug package uses this to regain control. */);
3716 Vsignal_hook_function = Qnil; 3397 Vsignal_hook_function = Qnil;
3717 3398
3718 DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal, 3399 DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal,
3719 doc: /* *Non-nil means call the debugger regardless of condition handlers. 3400 doc: /* Non-nil means call the debugger regardless of condition handlers.
3720Note that `debug-on-error', `debug-on-quit' and friends 3401Note that `debug-on-error', `debug-on-quit' and friends
3721still determine whether to handle the particular condition. */); 3402still determine whether to handle the particular condition. */);
3722 Vdebug_on_signal = Qnil; 3403 Vdebug_on_signal = Qnil;
3723 3404
3724 DEFVAR_LISP ("macro-declaration-function", Vmacro_declaration_function,
3725 doc: /* Function to process declarations in a macro definition.
3726The function will be called with two args MACRO and DECL.
3727MACRO is the name of the macro being defined.
3728DECL is a list `(declare ...)' containing the declarations.
3729The value the function returns is not used. */);
3730 Vmacro_declaration_function = Qnil;
3731
3732 /* When lexical binding is being used, 3405 /* When lexical binding is being used,
3733 vinternal_interpreter_environment is non-nil, and contains an alist 3406 Vinternal_interpreter_environment is non-nil, and contains an alist
3734 of lexically-bound variable, or (t), indicating an empty 3407 of lexically-bound variable, or (t), indicating an empty
3735 environment. The lisp name of this variable would be 3408 environment. The lisp name of this variable would be
3736 `internal-interpreter-environment' if it weren't hidden. 3409 `internal-interpreter-environment' if it weren't hidden.
3737 Every element of this list can be either a cons (VAR . VAL) 3410 Every element of this list can be either a cons (VAR . VAL)
3738 specifying a lexical binding, or a single symbol VAR indicating 3411 specifying a lexical binding, or a single symbol VAR indicating
3739 that this variable should use dynamic scoping. */ 3412 that this variable should use dynamic scoping. */
3740 DEFSYM (Qinternal_interpreter_environment, "internal-interpreter-environment"); 3413 DEFSYM (Qinternal_interpreter_environment,
3414 "internal-interpreter-environment");
3741 DEFVAR_LISP ("internal-interpreter-environment", 3415 DEFVAR_LISP ("internal-interpreter-environment",
3742 Vinternal_interpreter_environment, 3416 Vinternal_interpreter_environment,
3743 doc: /* If non-nil, the current lexical environment of the lisp interpreter. 3417 doc: /* If non-nil, the current lexical environment of the lisp interpreter.
@@ -3756,6 +3430,8 @@ alist of active lexical bindings. */);
3756 staticpro (&Vsignaling_function); 3430 staticpro (&Vsignaling_function);
3757 Vsignaling_function = Qnil; 3431 Vsignaling_function = Qnil;
3758 3432
3433 inhibit_lisp_code = Qnil;
3434
3759 defsubr (&Sor); 3435 defsubr (&Sor);
3760 defsubr (&Sand); 3436 defsubr (&Sand);
3761 defsubr (&Sif); 3437 defsubr (&Sif);
@@ -3766,12 +3442,10 @@ alist of active lexical bindings. */);
3766 defsubr (&Ssetq); 3442 defsubr (&Ssetq);
3767 defsubr (&Squote); 3443 defsubr (&Squote);
3768 defsubr (&Sfunction); 3444 defsubr (&Sfunction);
3769 defsubr (&Sdefun);
3770 defsubr (&Sdefmacro);
3771 defsubr (&Sdefvar); 3445 defsubr (&Sdefvar);
3772 defsubr (&Sdefvaralias); 3446 defsubr (&Sdefvaralias);
3773 defsubr (&Sdefconst); 3447 defsubr (&Sdefconst);
3774 defsubr (&Suser_variable_p); 3448 defsubr (&Smake_var_non_special);
3775 defsubr (&Slet); 3449 defsubr (&Slet);
3776 defsubr (&SletX); 3450 defsubr (&SletX);
3777 defsubr (&Swhile); 3451 defsubr (&Swhile);
@@ -3781,10 +3455,9 @@ alist of active lexical bindings. */);
3781 defsubr (&Sunwind_protect); 3455 defsubr (&Sunwind_protect);
3782 defsubr (&Scondition_case); 3456 defsubr (&Scondition_case);
3783 defsubr (&Ssignal); 3457 defsubr (&Ssignal);
3784 defsubr (&Sinteractive_p);
3785 defsubr (&Scalled_interactively_p);
3786 defsubr (&Scommandp); 3458 defsubr (&Scommandp);
3787 defsubr (&Sautoload); 3459 defsubr (&Sautoload);
3460 defsubr (&Sautoload_do_load);
3788 defsubr (&Seval); 3461 defsubr (&Seval);
3789 defsubr (&Sapply); 3462 defsubr (&Sapply);
3790 defsubr (&Sfuncall); 3463 defsubr (&Sfuncall);