aboutsummaryrefslogtreecommitdiffstats
path: root/src/eval.c
diff options
context:
space:
mode:
authorTom Tromey2012-12-17 07:56:22 -0700
committerTom Tromey2012-12-17 07:56:22 -0700
commit3d6eced1ae51ffd0a782130e7c334052277e2724 (patch)
tree5d1d2ad7cd3374f922886c4a72062511a035c168 /src/eval.c
parentbf69f522a9e135f9aa483cedd53e71e915f2bf75 (diff)
parent7c3d167f48d6262ee4e5512aa50a07ee96bc1509 (diff)
downloademacs-3d6eced1ae51ffd0a782130e7c334052277e2724.tar.gz
emacs-3d6eced1ae51ffd0a782130e7c334052277e2724.zip
merge from trunk
Diffstat (limited to 'src/eval.c')
-rw-r--r--src/eval.c320
1 files changed, 91 insertions, 229 deletions
diff --git a/src/eval.c b/src/eval.c
index ecdbe960a8a..0932564b36f 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -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,16 +31,6 @@ 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
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
45/* static struct backtrace *backtrace_list; */ 34/* static struct backtrace *backtrace_list; */
46 35
47/* #if !BYTE_MARK_STACK */ 36/* #if !BYTE_MARK_STACK */
@@ -69,7 +58,7 @@ Lisp_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
@@ -118,12 +107,6 @@ static EMACS_INT when_entered_debugger;
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
122 make sure the Lisp interpreter isn't called from a signal handler,
123 which is unsafe because the interpreter isn't reentrant. */
124
125int handling_signal;
126
127/* If non-nil, Lisp code must not be run since some part of Emacs is 110/* If non-nil, Lisp code must not be run since some part of Emacs is
128 in an inconsistent state. Currently, x-create-frame uses this to 111 in an inconsistent state. Currently, x-create-frame uses this to
129 avoid triggering window-configuration-change-hook while the new 112 avoid triggering window-configuration-change-hook while the new
@@ -131,18 +114,17 @@ int handling_signal;
131Lisp_Object inhibit_lisp_code; 114Lisp_Object inhibit_lisp_code;
132 115
133static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); 116static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
134static bool interactive_p (void);
135static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); 117static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
136 118
137/* Functions to set Lisp_Object slots of struct specbinding. */ 119/* Functions to set Lisp_Object slots of struct specbinding. */
138 120
139static inline void 121static void
140set_specpdl_symbol (Lisp_Object symbol) 122set_specpdl_symbol (Lisp_Object symbol)
141{ 123{
142 specpdl_ptr->symbol = symbol; 124 specpdl_ptr->symbol = symbol;
143} 125}
144 126
145static inline void 127static void
146set_specpdl_old_value (Lisp_Object oldval) 128set_specpdl_old_value (Lisp_Object oldval)
147{ 129{
148 specpdl_ptr->old_value = oldval; 130 specpdl_ptr->old_value = oldval;
@@ -210,7 +192,7 @@ restore_stack_limits (Lisp_Object data)
210 192
211/* Call the Lisp debugger, giving it argument ARG. */ 193/* Call the Lisp debugger, giving it argument ARG. */
212 194
213static Lisp_Object 195Lisp_Object
214call_debugger (Lisp_Object arg) 196call_debugger (Lisp_Object arg)
215{ 197{
216 bool debug_while_redisplaying; 198 bool debug_while_redisplaying;
@@ -248,7 +230,7 @@ call_debugger (Lisp_Object arg)
248 specbind (intern ("debugger-may-continue"), 230 specbind (intern ("debugger-may-continue"),
249 debug_while_redisplaying ? Qnil : Qt); 231 debug_while_redisplaying ? Qnil : Qt);
250 specbind (Qinhibit_redisplay, Qnil); 232 specbind (Qinhibit_redisplay, Qnil);
251 specbind (Qdebug_on_error, Qnil); 233 specbind (Qinhibit_debugger, Qt);
252 234
253#if 0 /* Binding this prevents execution of Lisp code during 235#if 0 /* Binding this prevents execution of Lisp code during
254 redisplay, which necessarily leads to display problems. */ 236 redisplay, which necessarily leads to display problems. */
@@ -525,102 +507,6 @@ usage: (function ARG) */)
525} 507}
526 508
527 509
528DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
529 doc: /* Return t if the containing function was run directly by user input.
530This means that the function was called with `call-interactively'
531\(which includes being called as the binding of a key)
532and input is currently coming from the keyboard (not a keyboard macro),
533and Emacs is not running in batch mode (`noninteractive' is nil).
534
535The only known proper use of `interactive-p' is in deciding whether to
536display a helpful message, or how to display it. If you're thinking
537of using it for any other purpose, it is quite likely that you're
538making a mistake. Think: what do you want to do when the command is
539called from a keyboard macro?
540
541To test whether your function was called with `call-interactively',
542either (i) add an extra optional argument and give it an `interactive'
543spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
544use `called-interactively-p'. */)
545 (void)
546{
547 return interactive_p () ? Qt : Qnil;
548}
549
550
551DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 1, 0,
552 doc: /* Return t if the containing function was called by `call-interactively'.
553If KIND is `interactive', then only return t if the call was made
554interactively by the user, i.e. not in `noninteractive' mode nor
555when `executing-kbd-macro'.
556If KIND is `any', on the other hand, it will return t for any kind of
557interactive call, including being called as the binding of a key, or
558from a keyboard macro, or in `noninteractive' mode.
559
560The only known proper use of `interactive' for KIND is in deciding
561whether to display a helpful message, or how to display it. If you're
562thinking of using it for any other purpose, it is quite likely that
563you're making a mistake. Think: what do you want to do when the
564command is called from a keyboard macro?
565
566Instead of using this function, it is sometimes cleaner to give your
567function an extra optional argument whose `interactive' spec specifies
568non-nil unconditionally (\"p\" is a good way to do this), or via
569\(not (or executing-kbd-macro noninteractive)). */)
570 (Lisp_Object kind)
571{
572 return (((INTERACTIVE || !EQ (kind, intern ("interactive")))
573 && interactive_p ())
574 ? Qt : Qnil);
575}
576
577
578/* Return true if function in which this appears was called using
579 call-interactively and is not a built-in. */
580
581static bool
582interactive_p (void)
583{
584 struct backtrace *btp;
585 Lisp_Object fun;
586
587 btp = backtrace_list;
588
589 /* If this isn't a byte-compiled function, there may be a frame at
590 the top for Finteractive_p. If so, skip it. */
591 fun = Findirect_function (*btp->function, Qnil);
592 if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p
593 || XSUBR (fun) == &Scalled_interactively_p))
594 btp = btp->next;
595
596 /* If we're running an Emacs 18-style byte-compiled function, there
597 may be a frame for Fbytecode at the top level. In any version of
598 Emacs there can be Fbytecode frames for subexpressions evaluated
599 inside catch and condition-case. Skip past them.
600
601 If this isn't a byte-compiled function, then we may now be
602 looking at several frames for special forms. Skip past them. */
603 while (btp
604 && (EQ (*btp->function, Qbytecode)
605 || btp->nargs == UNEVALLED))
606 btp = btp->next;
607
608 /* `btp' now points at the frame of the innermost function that isn't
609 a special form, ignoring frames for Finteractive_p and/or
610 Fbytecode at the top. If this frame is for a built-in function
611 (such as load or eval-region) return false. */
612 fun = Findirect_function (*btp->function, Qnil);
613 if (SUBRP (fun))
614 return 0;
615
616 /* `btp' points to the frame of a Lisp function that called interactive-p.
617 Return t if that function was called interactively. */
618 if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
619 return 1;
620 return 0;
621}
622
623
624DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, 510DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
625 doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE. 511 doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
626Aliased variables always have the same value; setting one sets the other. 512Aliased variables always have the same value; setting one sets the other.
@@ -726,14 +612,15 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
726 else 612 else
727 { /* Check if there is really a global binding rather than just a let 613 { /* Check if there is really a global binding rather than just a let
728 binding that shadows the global unboundness of the var. */ 614 binding that shadows the global unboundness of the var. */
729 volatile struct specbinding *pdl = specpdl_ptr; 615 struct specbinding *pdl = specpdl_ptr;
730 while (pdl > specpdl) 616 while (pdl > specpdl)
731 { 617 {
732 if (EQ ((--pdl)->symbol, sym) && !pdl->func 618 if (EQ ((--pdl)->symbol, sym) && !pdl->func
733 && EQ (pdl->old_value, Qunbound)) 619 && EQ (pdl->old_value, Qunbound))
734 { 620 {
735 message_with_string ("Warning: defvar ignored because %s is let-bound", 621 message_with_string
736 SYMBOL_NAME (sym), 1); 622 ("Warning: defvar ignored because %s is let-bound",
623 SYMBOL_NAME (sym), 1);
737 break; 624 break;
738 } 625 }
739 } 626 }
@@ -753,8 +640,8 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
753 /* A simple (defvar foo) with lexical scoping does "nothing" except 640 /* A simple (defvar foo) with lexical scoping does "nothing" except
754 declare that var to be dynamically scoped *locally* (i.e. within 641 declare that var to be dynamically scoped *locally* (i.e. within
755 the current file or let-block). */ 642 the current file or let-block). */
756 Vinternal_interpreter_environment = 643 Vinternal_interpreter_environment
757 Fcons (sym, Vinternal_interpreter_environment); 644 = Fcons (sym, Vinternal_interpreter_environment);
758 else 645 else
759 { 646 {
760 /* Simple (defvar <var>) should not count as a definition at all. 647 /* Simple (defvar <var>) should not count as a definition at all.
@@ -1007,7 +894,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
1007 if (NILP (tem)) 894 if (NILP (tem))
1008 { 895 {
1009 def = XSYMBOL (sym)->function; 896 def = XSYMBOL (sym)->function;
1010 if (!EQ (def, Qunbound)) 897 if (!NILP (def))
1011 continue; 898 continue;
1012 } 899 }
1013 break; 900 break;
@@ -1022,7 +909,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
1022 GCPRO1 (form); 909 GCPRO1 (form);
1023 def = Fautoload_do_load (def, sym, Qmacro); 910 def = Fautoload_do_load (def, sym, Qmacro);
1024 UNGCPRO; 911 UNGCPRO;
1025 if (EQ (def, Qunbound) || !CONSP (def)) 912 if (!CONSP (def))
1026 /* Not defined or definition not suitable. */ 913 /* Not defined or definition not suitable. */
1027 break; 914 break;
1028 if (!EQ (XCAR (def), Qmacro)) 915 if (!EQ (XCAR (def), Qmacro))
@@ -1091,7 +978,7 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
1091 catchlist = &c; 978 catchlist = &c;
1092 979
1093 /* Call FUNC. */ 980 /* Call FUNC. */
1094 if (! _setjmp (c.jmp)) 981 if (! sys_setjmp (c.jmp))
1095 c.val = (*func) (arg); 982 c.val = (*func) (arg);
1096 983
1097 /* Throw works by a longjmp that comes right here. */ 984 /* Throw works by a longjmp that comes right here. */
@@ -1102,7 +989,7 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
1102/* Unwind the specbind, catch, and handler stacks back to CATCH, and 989/* Unwind the specbind, catch, and handler stacks back to CATCH, and
1103 jump to that CATCH, returning VALUE as the value of that catch. 990 jump to that CATCH, returning VALUE as the value of that catch.
1104 991
1105 This is the guts Fthrow and Fsignal; they differ only in the way 992 This is the guts of Fthrow and Fsignal; they differ only in the way
1106 they choose the catch tag to throw to. A catch tag for a 993 they choose the catch tag to throw to. A catch tag for a
1107 condition-case form has a TAG of Qnil. 994 condition-case form has a TAG of Qnil.
1108 995
@@ -1111,7 +998,7 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
1111 the handler stack as we go, so that the proper handlers are in 998 the handler stack as we go, so that the proper handlers are in
1112 effect for each unwind-protect clause we run. At the end, restore 999 effect for each unwind-protect clause we run. At the end, restore
1113 some static info saved in CATCH, and longjmp to the location 1000 some static info saved in CATCH, and longjmp to the location
1114 specified in the 1001 specified there.
1115 1002
1116 This is used for correct unwinding in Fthrow and Fsignal. */ 1003 This is used for correct unwinding in Fthrow and Fsignal. */
1117 1004
@@ -1125,8 +1012,7 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value)
1125 1012
1126 /* Restore certain special C variables. */ 1013 /* Restore certain special C variables. */
1127 set_poll_suppress_count (catch->poll_suppress_count); 1014 set_poll_suppress_count (catch->poll_suppress_count);
1128 UNBLOCK_INPUT_TO (catch->interrupt_input_blocked); 1015 unblock_input_to (catch->interrupt_input_blocked);
1129 handling_signal = 0;
1130 immediate_quit = 0; 1016 immediate_quit = 0;
1131 1017
1132 do 1018 do
@@ -1141,16 +1027,6 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value)
1141 } 1027 }
1142 while (! last_time); 1028 while (! last_time);
1143 1029
1144#if HAVE_X_WINDOWS
1145 /* If x_catch_errors was done, turn it off now.
1146 (First we give unbind_to a chance to do that.) */
1147#if 0 /* This would disable x_catch_errors after x_connection_closed.
1148 The catch must remain in effect during that delicate
1149 state. --lorentey */
1150 x_fully_uncatch_errors ();
1151#endif
1152#endif
1153
1154 byte_stack_list = catch->byte_stack; 1030 byte_stack_list = catch->byte_stack;
1155 gcprolist = catch->gcpro; 1031 gcprolist = catch->gcpro;
1156#ifdef DEBUG_GCPRO 1032#ifdef DEBUG_GCPRO
@@ -1159,7 +1035,7 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value)
1159 backtrace_list = catch->backlist; 1035 backtrace_list = catch->backlist;
1160 lisp_eval_depth = catch->f_lisp_eval_depth; 1036 lisp_eval_depth = catch->f_lisp_eval_depth;
1161 1037
1162 _longjmp (catch->jmp, 1); 1038 sys_longjmp (catch->jmp, 1);
1163} 1039}
1164 1040
1165DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0, 1041DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
@@ -1223,12 +1099,9 @@ See also the function `signal' for more info.
1223usage: (condition-case VAR BODYFORM &rest HANDLERS) */) 1099usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1224 (Lisp_Object args) 1100 (Lisp_Object args)
1225{ 1101{
1226 register Lisp_Object bodyform, handlers; 1102 Lisp_Object var = Fcar (args);
1227 volatile Lisp_Object var; 1103 Lisp_Object bodyform = Fcar (Fcdr (args));
1228 1104 Lisp_Object handlers = Fcdr (Fcdr (args));
1229 var = Fcar (args);
1230 bodyform = Fcar (Fcdr (args));
1231 handlers = Fcdr (Fcdr (args));
1232 1105
1233 return internal_lisp_condition_case (var, bodyform, handlers); 1106 return internal_lisp_condition_case (var, bodyform, handlers);
1234} 1107}
@@ -1268,7 +1141,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
1268 c.interrupt_input_blocked = interrupt_input_blocked; 1141 c.interrupt_input_blocked = interrupt_input_blocked;
1269 c.gcpro = gcprolist; 1142 c.gcpro = gcprolist;
1270 c.byte_stack = byte_stack_list; 1143 c.byte_stack = byte_stack_list;
1271 if (_setjmp (c.jmp)) 1144 if (sys_setjmp (c.jmp))
1272 { 1145 {
1273 if (!NILP (h.var)) 1146 if (!NILP (h.var))
1274 specbind (h.var, c.val); 1147 specbind (h.var, c.val);
@@ -1323,7 +1196,7 @@ internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers,
1323 c.interrupt_input_blocked = interrupt_input_blocked; 1196 c.interrupt_input_blocked = interrupt_input_blocked;
1324 c.gcpro = gcprolist; 1197 c.gcpro = gcprolist;
1325 c.byte_stack = byte_stack_list; 1198 c.byte_stack = byte_stack_list;
1326 if (_setjmp (c.jmp)) 1199 if (sys_setjmp (c.jmp))
1327 { 1200 {
1328 return (*hfun) (c.val); 1201 return (*hfun) (c.val);
1329 } 1202 }
@@ -1361,7 +1234,7 @@ internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg,
1361 c.interrupt_input_blocked = interrupt_input_blocked; 1234 c.interrupt_input_blocked = interrupt_input_blocked;
1362 c.gcpro = gcprolist; 1235 c.gcpro = gcprolist;
1363 c.byte_stack = byte_stack_list; 1236 c.byte_stack = byte_stack_list;
1364 if (_setjmp (c.jmp)) 1237 if (sys_setjmp (c.jmp))
1365 { 1238 {
1366 return (*hfun) (c.val); 1239 return (*hfun) (c.val);
1367 } 1240 }
@@ -1403,7 +1276,7 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object),
1403 c.interrupt_input_blocked = interrupt_input_blocked; 1276 c.interrupt_input_blocked = interrupt_input_blocked;
1404 c.gcpro = gcprolist; 1277 c.gcpro = gcprolist;
1405 c.byte_stack = byte_stack_list; 1278 c.byte_stack = byte_stack_list;
1406 if (_setjmp (c.jmp)) 1279 if (sys_setjmp (c.jmp))
1407 { 1280 {
1408 return (*hfun) (c.val); 1281 return (*hfun) (c.val);
1409 } 1282 }
@@ -1447,7 +1320,7 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
1447 c.interrupt_input_blocked = interrupt_input_blocked; 1320 c.interrupt_input_blocked = interrupt_input_blocked;
1448 c.gcpro = gcprolist; 1321 c.gcpro = gcprolist;
1449 c.byte_stack = byte_stack_list; 1322 c.byte_stack = byte_stack_list;
1450 if (_setjmp (c.jmp)) 1323 if (sys_setjmp (c.jmp))
1451 { 1324 {
1452 return (*hfun) (c.val, nargs, args); 1325 return (*hfun) (c.val, nargs, args);
1453 } 1326 }
@@ -1509,10 +1382,10 @@ See also the function `condition-case'. */)
1509 struct handler *h; 1382 struct handler *h;
1510 struct backtrace *bp; 1383 struct backtrace *bp;
1511 1384
1512 immediate_quit = handling_signal = 0; 1385 immediate_quit = 0;
1513 abort_on_gc = 0; 1386 abort_on_gc = 0;
1514 if (gc_in_progress || waiting_for_input) 1387 if (gc_in_progress || waiting_for_input)
1515 abort (); 1388 emacs_abort ();
1516 1389
1517#if 0 /* rms: I don't know why this was here, 1390#if 0 /* rms: I don't know why this was here,
1518 but it is surely wrong for an error that is handled. */ 1391 but it is surely wrong for an error that is handled. */
@@ -1546,10 +1419,10 @@ See also the function `condition-case'. */)
1546 if (backtrace_list && !NILP (error_symbol)) 1419 if (backtrace_list && !NILP (error_symbol))
1547 { 1420 {
1548 bp = backtrace_list->next; 1421 bp = backtrace_list->next;
1549 if (bp && bp->function && EQ (*bp->function, Qerror)) 1422 if (bp && EQ (bp->function, Qerror))
1550 bp = bp->next; 1423 bp = bp->next;
1551 if (bp && bp->function) 1424 if (bp)
1552 Vsignaling_function = *bp->function; 1425 Vsignaling_function = bp->function;
1553 } 1426 }
1554 1427
1555 for (h = handlerlist; h; h = h->next) 1428 for (h = handlerlist; h; h = h->next)
@@ -1560,7 +1433,7 @@ See also the function `condition-case'. */)
1560 } 1433 }
1561 1434
1562 if (/* Don't run the debugger for a memory-full error. 1435 if (/* Don't run the debugger for a memory-full error.
1563 (There is no room in memory to do that!) */ 1436 (There is no room in memory to do that!) */
1564 !NILP (error_symbol) 1437 !NILP (error_symbol)
1565 && (!NILP (Vdebug_on_signal) 1438 && (!NILP (Vdebug_on_signal)
1566 /* If no handler is present now, try to run the debugger. */ 1439 /* If no handler is present now, try to run the debugger. */
@@ -1609,7 +1482,7 @@ void
1609xsignal (Lisp_Object error_symbol, Lisp_Object data) 1482xsignal (Lisp_Object error_symbol, Lisp_Object data)
1610{ 1483{
1611 Fsignal (error_symbol, data); 1484 Fsignal (error_symbol, data);
1612 abort (); 1485 emacs_abort ();
1613} 1486}
1614 1487
1615/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */ 1488/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
@@ -1743,7 +1616,8 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
1743 if ( 1616 if (
1744 /* Don't try to run the debugger with interrupts blocked. 1617 /* Don't try to run the debugger with interrupts blocked.
1745 The editing loop would return anyway. */ 1618 The editing loop would return anyway. */
1746 ! INPUT_BLOCKED_P 1619 ! input_blocked_p ()
1620 && NILP (Vinhibit_debugger)
1747 /* Does user want to enter debugger for this kind of error? */ 1621 /* Does user want to enter debugger for this kind of error? */
1748 && (EQ (sig, Qquit) 1622 && (EQ (sig, Qquit)
1749 ? debug_on_quit 1623 ? debug_on_quit
@@ -1860,12 +1734,12 @@ then strings and vectors are not accepted. */)
1860 1734
1861 fun = function; 1735 fun = function;
1862 1736
1863 fun = indirect_function (fun); /* Check cycles. */ 1737 fun = indirect_function (fun); /* Check cycles. */
1864 if (NILP (fun) || EQ (fun, Qunbound)) 1738 if (NILP (fun))
1865 return Qnil; 1739 return Qnil;
1866 1740
1867 /* Check an `interactive-form' property if present, analogous to the 1741 /* Check an `interactive-form' property if present, analogous to the
1868 function-documentation property. */ 1742 function-documentation property. */
1869 fun = function; 1743 fun = function;
1870 while (SYMBOLP (fun)) 1744 while (SYMBOLP (fun))
1871 { 1745 {
@@ -1925,24 +1799,19 @@ this does nothing and returns nil. */)
1925 CHECK_STRING (file); 1799 CHECK_STRING (file);
1926 1800
1927 /* If function is defined and not as an autoload, don't override. */ 1801 /* If function is defined and not as an autoload, don't override. */
1928 if (!EQ (XSYMBOL (function)->function, Qunbound) 1802 if (!NILP (XSYMBOL (function)->function)
1929 && !(CONSP (XSYMBOL (function)->function) 1803 && !AUTOLOADP (XSYMBOL (function)->function))
1930 && EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
1931 return Qnil; 1804 return Qnil;
1932 1805
1933 if (NILP (Vpurify_flag)) 1806 if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0)))
1934 /* Only add entries after dumping, because the ones before are
1935 not useful and else we get loads of them from the loaddefs.el. */
1936 LOADHIST_ATTACH (Fcons (Qautoload, function));
1937 else if (EQ (docstring, make_number (0)))
1938 /* `read1' in lread.c has found the docstring starting with "\ 1807 /* `read1' in lread.c has found the docstring starting with "\
1939 and assumed the docstring will be provided by Snarf-documentation, so it 1808 and assumed the docstring will be provided by Snarf-documentation, so it
1940 passed us 0 instead. But that leads to accidental sharing in purecopy's 1809 passed us 0 instead. But that leads to accidental sharing in purecopy's
1941 hash-consing, so we use a (hopefully) unique integer instead. */ 1810 hash-consing, so we use a (hopefully) unique integer instead. */
1942 docstring = make_number (XUNTAG (function, Lisp_Symbol)); 1811 docstring = make_number (XHASH (function));
1943 return Ffset (function, 1812 return Fdefalias (function,
1944 Fpurecopy (list5 (Qautoload, file, docstring, 1813 list5 (Qautoload, file, docstring, interactive, type),
1945 interactive, type))); 1814 Qnil);
1946} 1815}
1947 1816
1948Lisp_Object 1817Lisp_Object
@@ -2061,9 +1930,6 @@ eval_sub (Lisp_Object form)
2061 struct backtrace backtrace; 1930 struct backtrace backtrace;
2062 struct gcpro gcpro1, gcpro2, gcpro3; 1931 struct gcpro gcpro1, gcpro2, gcpro3;
2063 1932
2064 if (handling_signal)
2065 abort ();
2066
2067 if (SYMBOLP (form)) 1933 if (SYMBOLP (form))
2068 { 1934 {
2069 /* Look up its binding in the lexical environment. 1935 /* Look up its binding in the lexical environment.
@@ -2097,11 +1963,11 @@ eval_sub (Lisp_Object form)
2097 original_args = XCDR (form); 1963 original_args = XCDR (form);
2098 1964
2099 backtrace.next = backtrace_list; 1965 backtrace.next = backtrace_list;
2100 backtrace_list = &backtrace; 1966 backtrace.function = original_fun; /* This also protects them from gc. */
2101 backtrace.function = &original_fun; /* This also protects them from gc. */
2102 backtrace.args = &original_args; 1967 backtrace.args = &original_args;
2103 backtrace.nargs = UNEVALLED; 1968 backtrace.nargs = UNEVALLED;
2104 backtrace.debug_on_exit = 0; 1969 backtrace.debug_on_exit = 0;
1970 backtrace_list = &backtrace;
2105 1971
2106 if (debug_on_next_call) 1972 if (debug_on_next_call)
2107 do_debug_on_call (Qt); 1973 do_debug_on_call (Qt);
@@ -2112,7 +1978,7 @@ eval_sub (Lisp_Object form)
2112 1978
2113 /* Optimize for no indirection. */ 1979 /* Optimize for no indirection. */
2114 fun = original_fun; 1980 fun = original_fun;
2115 if (SYMBOLP (fun) && !EQ (fun, Qunbound) 1981 if (SYMBOLP (fun) && !NILP (fun)
2116 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) 1982 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
2117 fun = indirect_function (fun); 1983 fun = indirect_function (fun);
2118 1984
@@ -2226,7 +2092,7 @@ eval_sub (Lisp_Object form)
2226 is supported by this code. We need to either rewrite the 2092 is supported by this code. We need to either rewrite the
2227 subr to use a different argument protocol, or add more 2093 subr to use a different argument protocol, or add more
2228 cases to this switch. */ 2094 cases to this switch. */
2229 abort (); 2095 emacs_abort ();
2230 } 2096 }
2231 } 2097 }
2232 } 2098 }
@@ -2234,7 +2100,7 @@ eval_sub (Lisp_Object form)
2234 val = apply_lambda (fun, original_args); 2100 val = apply_lambda (fun, original_args);
2235 else 2101 else
2236 { 2102 {
2237 if (EQ (fun, Qunbound)) 2103 if (NILP (fun))
2238 xsignal1 (Qvoid_function, original_fun); 2104 xsignal1 (Qvoid_function, original_fun);
2239 if (!CONSP (fun)) 2105 if (!CONSP (fun))
2240 xsignal1 (Qinvalid_function, original_fun); 2106 xsignal1 (Qinvalid_function, original_fun);
@@ -2308,10 +2174,10 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
2308 numargs += nargs - 2; 2174 numargs += nargs - 2;
2309 2175
2310 /* Optimize for no indirection. */ 2176 /* Optimize for no indirection. */
2311 if (SYMBOLP (fun) && !EQ (fun, Qunbound) 2177 if (SYMBOLP (fun) && !NILP (fun)
2312 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) 2178 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
2313 fun = indirect_function (fun); 2179 fun = indirect_function (fun);
2314 if (EQ (fun, Qunbound)) 2180 if (NILP (fun))
2315 { 2181 {
2316 /* Let funcall get the error. */ 2182 /* Let funcall get the error. */
2317 fun = args[0]; 2183 fun = args[0];
@@ -2403,14 +2269,10 @@ usage: (run-hooks &rest HOOKS) */)
2403DEFUN ("run-hook-with-args", Frun_hook_with_args, 2269DEFUN ("run-hook-with-args", Frun_hook_with_args,
2404 Srun_hook_with_args, 1, MANY, 0, 2270 Srun_hook_with_args, 1, MANY, 0,
2405 doc: /* Run HOOK with the specified arguments ARGS. 2271 doc: /* Run HOOK with the specified arguments ARGS.
2406HOOK 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
2407value, 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
2408called to run the hook. If the value is a function, it is called with 2274function in order with arguments ARGS. The final return value
2409the given arguments and its return value is returned. If it is a list 2275is unspecified.
2410of functions, those functions are called, in order,
2411with the given arguments ARGS.
2412It is best not to depend on the value returned by `run-hook-with-args',
2413as that may change.
2414 2276
2415Do not use `make-local-variable' to make a hook variable buffer-local. 2277Do not use `make-local-variable' to make a hook variable buffer-local.
2416Instead, use `add-hook' and specify t for the LOCAL argument. 2278Instead, use `add-hook' and specify t for the LOCAL argument.
@@ -2420,17 +2282,18 @@ usage: (run-hook-with-args HOOK &rest ARGS) */)
2420 return run_hook_with_args (nargs, args, funcall_nil); 2282 return run_hook_with_args (nargs, args, funcall_nil);
2421} 2283}
2422 2284
2285/* NB this one still documents a specific non-nil return value.
2286 (As did run-hook-with-args and run-hook-with-args-until-failure
2287 until they were changed in 24.1.) */
2423DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success, 2288DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success,
2424 Srun_hook_with_args_until_success, 1, MANY, 0, 2289 Srun_hook_with_args_until_success, 1, MANY, 0,
2425 doc: /* Run HOOK with the specified arguments ARGS. 2290 doc: /* Run HOOK with the specified arguments ARGS.
2426HOOK should be a symbol, a hook variable. If HOOK has a non-nil 2291HOOK should be a symbol, a hook variable. The value of HOOK
2427value, that value may be a function or a list of functions to be 2292may be nil, a function, or a list of functions. Call each
2428called to run the hook. If the value is a function, it is called with 2293function in order with arguments ARGS, stopping at the first
2429the given arguments and its return value is returned. 2294one that returns non-nil, and return that value. Otherwise (if
2430If it is a list of functions, those functions are called, in order, 2295all functions return nil, or if there are no functions to call),
2431with the given arguments ARGS, until one of them 2296return nil.
2432returns a non-nil value. Then we return that value.
2433However, if they all return nil, we return nil.
2434 2297
2435Do not use `make-local-variable' to make a hook variable buffer-local. 2298Do not use `make-local-variable' to make a hook variable buffer-local.
2436Instead, use `add-hook' and specify t for the LOCAL argument. 2299Instead, use `add-hook' and specify t for the LOCAL argument.
@@ -2449,13 +2312,12 @@ funcall_not (ptrdiff_t nargs, Lisp_Object *args)
2449DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure, 2312DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
2450 Srun_hook_with_args_until_failure, 1, MANY, 0, 2313 Srun_hook_with_args_until_failure, 1, MANY, 0,
2451 doc: /* Run HOOK with the specified arguments ARGS. 2314 doc: /* Run HOOK with the specified arguments ARGS.
2452HOOK should be a symbol, a hook variable. If HOOK has a non-nil 2315HOOK should be a symbol, a hook variable. The value of HOOK
2453value, that value may be a function or a list of functions to be 2316may be nil, a function, or a list of functions. Call each
2454called to run the hook. If the value is a function, it is called with 2317function in order with arguments ARGS, stopping at the first
2455the given arguments and its return value is returned. 2318one that returns nil, and return nil. Otherwise (if all functions
2456If it is a list of functions, those functions are called, in order, 2319return non-nil, or if there are no functions to call), return non-nil
2457with the given arguments ARGS, until one of them returns nil. 2320\(do not rely on the precise return value in this case).
2458Then we return nil. However, if they all return non-nil, we return non-nil.
2459 2321
2460Do not use `make-local-variable' to make a hook variable buffer-local. 2322Do not use `make-local-variable' to make a hook variable buffer-local.
2461Instead, use `add-hook' and specify t for the LOCAL argument. 2323Instead, use `add-hook' and specify t for the LOCAL argument.
@@ -2769,11 +2631,11 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
2769 } 2631 }
2770 2632
2771 backtrace.next = backtrace_list; 2633 backtrace.next = backtrace_list;
2772 backtrace_list = &backtrace; 2634 backtrace.function = args[0];
2773 backtrace.function = &args[0];
2774 backtrace.args = &args[1]; /* This also GCPROs them. */ 2635 backtrace.args = &args[1]; /* This also GCPROs them. */
2775 backtrace.nargs = nargs - 1; 2636 backtrace.nargs = nargs - 1;
2776 backtrace.debug_on_exit = 0; 2637 backtrace.debug_on_exit = 0;
2638 backtrace_list = &backtrace;
2777 2639
2778 /* Call GC after setting up the backtrace, so the latter GCPROs the args. */ 2640 /* Call GC after setting up the backtrace, so the latter GCPROs the args. */
2779 maybe_gc (); 2641 maybe_gc ();
@@ -2789,7 +2651,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
2789 2651
2790 /* Optimize for no indirection. */ 2652 /* Optimize for no indirection. */
2791 fun = original_fun; 2653 fun = original_fun;
2792 if (SYMBOLP (fun) && !EQ (fun, Qunbound) 2654 if (SYMBOLP (fun) && !NILP (fun)
2793 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) 2655 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
2794 fun = indirect_function (fun); 2656 fun = indirect_function (fun);
2795 2657
@@ -2869,7 +2731,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
2869 /* If a subr takes more than 8 arguments without using MANY 2731 /* If a subr takes more than 8 arguments without using MANY
2870 or UNEVALLED, we need to extend this function to support it. 2732 or UNEVALLED, we need to extend this function to support it.
2871 Until this is done, there is no way to call the function. */ 2733 Until this is done, there is no way to call the function. */
2872 abort (); 2734 emacs_abort ();
2873 } 2735 }
2874 } 2736 }
2875 } 2737 }
@@ -2877,7 +2739,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
2877 val = funcall_lambda (fun, numargs, args + 1); 2739 val = funcall_lambda (fun, numargs, args + 1);
2878 else 2740 else
2879 { 2741 {
2880 if (EQ (fun, Qunbound)) 2742 if (NILP (fun))
2881 xsignal1 (Qvoid_function, original_fun); 2743 xsignal1 (Qvoid_function, original_fun);
2882 if (!CONSP (fun)) 2744 if (!CONSP (fun))
2883 xsignal1 (Qinvalid_function, original_fun); 2745 xsignal1 (Qinvalid_function, original_fun);
@@ -3000,7 +2862,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
3000 lexenv = Qnil; 2862 lexenv = Qnil;
3001 } 2863 }
3002 else 2864 else
3003 abort (); 2865 emacs_abort ();
3004 2866
3005 i = optional = rest = 0; 2867 i = optional = rest = 0;
3006 for (; CONSP (syms_left); syms_left = XCDR (syms_left)) 2868 for (; CONSP (syms_left); syms_left = XCDR (syms_left))
@@ -3172,8 +3034,6 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3172{ 3034{
3173 struct Lisp_Symbol *sym; 3035 struct Lisp_Symbol *sym;
3174 3036
3175 eassert (!handling_signal);
3176
3177 CHECK_SYMBOL (symbol); 3037 CHECK_SYMBOL (symbol);
3178 sym = XSYMBOL (symbol); 3038 sym = XSYMBOL (symbol);
3179 if (specpdl_ptr == specpdl + specpdl_size) 3039 if (specpdl_ptr == specpdl + specpdl_size)
@@ -3258,15 +3118,13 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3258 do_specbind (sym, specpdl_ptr - 1, value); 3118 do_specbind (sym, specpdl_ptr - 1, value);
3259 break; 3119 break;
3260 } 3120 }
3261 default: abort (); 3121 default: emacs_abort ();
3262 } 3122 }
3263} 3123}
3264 3124
3265void 3125void
3266record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) 3126record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
3267{ 3127{
3268 eassert (!handling_signal);
3269
3270 if (specpdl_ptr == specpdl + specpdl_size) 3128 if (specpdl_ptr == specpdl + specpdl_size)
3271 grow_specpdl (); 3129 grow_specpdl ();
3272 specpdl_ptr->func = function; 3130 specpdl_ptr->func = function;
@@ -3432,12 +3290,12 @@ Output stream used is value of `standard-output'. */)
3432 write_string (backlist->debug_on_exit ? "* " : " ", 2); 3290 write_string (backlist->debug_on_exit ? "* " : " ", 2);
3433 if (backlist->nargs == UNEVALLED) 3291 if (backlist->nargs == UNEVALLED)
3434 { 3292 {
3435 Fprin1 (Fcons (*backlist->function, *backlist->args), Qnil); 3293 Fprin1 (Fcons (backlist->function, *backlist->args), Qnil);
3436 write_string ("\n", -1); 3294 write_string ("\n", -1);
3437 } 3295 }
3438 else 3296 else
3439 { 3297 {
3440 tem = *backlist->function; 3298 tem = backlist->function;
3441 Fprin1 (tem, Qnil); /* This can QUIT. */ 3299 Fprin1 (tem, Qnil); /* This can QUIT. */
3442 write_string ("(", -1); 3300 write_string ("(", -1);
3443 if (backlist->nargs == MANY) 3301 if (backlist->nargs == MANY)
@@ -3495,7 +3353,7 @@ If NFRAMES is more than the number of frames, the value is nil. */)
3495 if (!backlist) 3353 if (!backlist)
3496 return Qnil; 3354 return Qnil;
3497 if (backlist->nargs == UNEVALLED) 3355 if (backlist->nargs == UNEVALLED)
3498 return Fcons (Qnil, Fcons (*backlist->function, *backlist->args)); 3356 return Fcons (Qnil, Fcons (backlist->function, *backlist->args));
3499 else 3357 else
3500 { 3358 {
3501 if (backlist->nargs == MANY) /* FIXME: Can this happen? */ 3359 if (backlist->nargs == MANY) /* FIXME: Can this happen? */
@@ -3503,7 +3361,7 @@ If NFRAMES is more than the number of frames, the value is nil. */)
3503 else 3361 else
3504 tem = Flist (backlist->nargs, backlist->args); 3362 tem = Flist (backlist->nargs, backlist->args);
3505 3363
3506 return Fcons (Qt, Fcons (*backlist->function, tem)); 3364 return Fcons (Qt, Fcons (backlist->function, tem));
3507 } 3365 }
3508} 3366}
3509 3367
@@ -3517,7 +3375,7 @@ mark_backtrace (void)
3517 3375
3518 for (backlist = backtrace_list; backlist; backlist = backlist->next) 3376 for (backlist = backtrace_list; backlist; backlist = backlist->next)
3519 { 3377 {
3520 mark_object (*backlist->function); 3378 mark_object (backlist->function);
3521 3379
3522 if (backlist->nargs == UNEVALLED 3380 if (backlist->nargs == UNEVALLED
3523 || backlist->nargs == MANY) /* FIXME: Can this happen? */ 3381 || backlist->nargs == MANY) /* FIXME: Can this happen? */
@@ -3569,7 +3427,7 @@ before making `inhibit-quit' nil. */);
3569 3427
3570 DEFSYM (Qinhibit_quit, "inhibit-quit"); 3428 DEFSYM (Qinhibit_quit, "inhibit-quit");
3571 DEFSYM (Qautoload, "autoload"); 3429 DEFSYM (Qautoload, "autoload");
3572 DEFSYM (Qdebug_on_error, "debug-on-error"); 3430 DEFSYM (Qinhibit_debugger, "inhibit-debugger");
3573 DEFSYM (Qmacro, "macro"); 3431 DEFSYM (Qmacro, "macro");
3574 DEFSYM (Qdeclare, "declare"); 3432 DEFSYM (Qdeclare, "declare");
3575 3433
@@ -3584,6 +3442,12 @@ before making `inhibit-quit' nil. */);
3584 DEFSYM (Qclosure, "closure"); 3442 DEFSYM (Qclosure, "closure");
3585 DEFSYM (Qdebug, "debug"); 3443 DEFSYM (Qdebug, "debug");
3586 3444
3445 DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger,
3446 doc: /* Non-nil means never enter the debugger.
3447Normally set while the debugger is already active, to avoid recursive
3448invocations. */);
3449 Vinhibit_debugger = Qnil;
3450
3587 DEFVAR_LISP ("debug-on-error", Vdebug_on_error, 3451 DEFVAR_LISP ("debug-on-error", Vdebug_on_error,
3588 doc: /* Non-nil means enter debugger if an error is signaled. 3452 doc: /* Non-nil means enter debugger if an error is signaled.
3589Does not apply to errors handled by `condition-case' or those 3453Does not apply to errors handled by `condition-case' or those
@@ -3593,7 +3457,7 @@ if one of its condition symbols appears in the list.
3593When you evaluate an expression interactively, this variable 3457When you evaluate an expression interactively, this variable
3594is temporarily non-nil if `eval-expression-debug-on-error' is non-nil. 3458is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
3595The command `toggle-debug-on-error' toggles this. 3459The command `toggle-debug-on-error' toggles this.
3596See also the variable `debug-on-quit'. */); 3460See also the variable `debug-on-quit' and `inhibit-debugger'. */);
3597 Vdebug_on_error = Qnil; 3461 Vdebug_on_error = Qnil;
3598 3462
3599 DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors, 3463 DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors,
@@ -3693,8 +3557,6 @@ alist of active lexical bindings. */);
3693 defsubr (&Sunwind_protect); 3557 defsubr (&Sunwind_protect);
3694 defsubr (&Scondition_case); 3558 defsubr (&Scondition_case);
3695 defsubr (&Ssignal); 3559 defsubr (&Ssignal);
3696 defsubr (&Sinteractive_p);
3697 defsubr (&Scalled_interactively_p);
3698 defsubr (&Scommandp); 3560 defsubr (&Scommandp);
3699 defsubr (&Sautoload); 3561 defsubr (&Sautoload);
3700 defsubr (&Sautoload_do_load); 3562 defsubr (&Sautoload_do_load);