aboutsummaryrefslogtreecommitdiffstats
path: root/src/eval.c
diff options
context:
space:
mode:
authorJoakim Verona2011-02-05 11:23:09 +0100
committerJoakim Verona2011-02-05 11:23:09 +0100
commit4bd51ad5c3445b644dfb017d5b57b10a90aa325f (patch)
tree894801e7308ce4ecc34933f959e28f4b9cff9533 /src/eval.c
parent13cfe8df462ab8da9f0028e16cc84dcaceaca3d1 (diff)
parent9bcaafce5351d270ac514e23cb69ff1a5fd35229 (diff)
downloademacs-4bd51ad5c3445b644dfb017d5b57b10a90aa325f.tar.gz
emacs-4bd51ad5c3445b644dfb017d5b57b10a90aa325f.zip
merge from upstream. currently seems to have bitroted and i get segfaults
Diffstat (limited to 'src/eval.c')
-rw-r--r--src/eval.c556
1 files changed, 200 insertions, 356 deletions
diff --git a/src/eval.c b/src/eval.c
index 15112d8659b..d0effc755a2 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1,7 +1,5 @@
1/* Evaluator for GNU Emacs Lisp interpreter. 1/* Evaluator for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001, 2 Copyright (C) 1985-1987, 1993-1995, 1999-2011 Free Software Foundation, Inc.
3 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
4 Free Software Foundation, Inc.
5 3
6This file is part of GNU Emacs. 4This file is part of GNU Emacs.
7 5
@@ -58,7 +56,7 @@ int gcpro_level;
58#endif 56#endif
59 57
60Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun; 58Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
61Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag; 59Lisp_Object Qinhibit_quit;
62Lisp_Object Qand_rest, Qand_optional; 60Lisp_Object Qand_rest, Qand_optional;
63Lisp_Object Qdebug_on_error; 61Lisp_Object Qdebug_on_error;
64Lisp_Object Qdeclare; 62Lisp_Object Qdeclare;
@@ -89,56 +87,10 @@ struct specbinding *specpdl;
89 87
90struct specbinding *specpdl_ptr; 88struct specbinding *specpdl_ptr;
91 89
92/* Maximum size allowed for specpdl allocation */
93
94EMACS_INT max_specpdl_size;
95
96/* Depth in Lisp evaluations and function calls. */ 90/* Depth in Lisp evaluations and function calls. */
97 91
98EMACS_INT lisp_eval_depth; 92EMACS_INT lisp_eval_depth;
99 93
100/* Maximum allowed depth in Lisp evaluations and function calls. */
101
102EMACS_INT max_lisp_eval_depth;
103
104/* Nonzero means enter debugger before next function call */
105
106int debug_on_next_call;
107
108/* Non-zero means debugger may continue. This is zero when the
109 debugger is called during redisplay, where it might not be safe to
110 continue the interrupted redisplay. */
111
112int debugger_may_continue;
113
114/* List of conditions (non-nil atom means all) which cause a backtrace
115 if an error is handled by the command loop's error handler. */
116
117Lisp_Object Vstack_trace_on_error;
118
119/* List of conditions (non-nil atom means all) which enter the debugger
120 if an error is handled by the command loop's error handler. */
121
122Lisp_Object Vdebug_on_error;
123
124/* List of conditions and regexps specifying error messages which
125 do not enter the debugger even if Vdebug_on_error says they should. */
126
127Lisp_Object Vdebug_ignored_errors;
128
129/* Non-nil means call the debugger even if the error will be handled. */
130
131Lisp_Object Vdebug_on_signal;
132
133/* Hook for edebug to use. */
134
135Lisp_Object Vsignal_hook_function;
136
137/* Nonzero means enter debugger if a quit signal
138 is handled by the command loop's error handler. */
139
140int debug_on_quit;
141
142/* The value of num_nonmacro_input_events as of the last time we 94/* The value of num_nonmacro_input_events as of the last time we
143 started to enter the debugger. If we decide to enter the debugger 95 started to enter the debugger. If we decide to enter the debugger
144 again when this is still equal to num_nonmacro_input_events, then we 96 again when this is still equal to num_nonmacro_input_events, then we
@@ -148,8 +100,6 @@ int debug_on_quit;
148 100
149int when_entered_debugger; 101int when_entered_debugger;
150 102
151Lisp_Object Vdebugger;
152
153/* The function from which the last `signal' was called. Set in 103/* The function from which the last `signal' was called. Set in
154 Fsignal. */ 104 Fsignal. */
155 105
@@ -161,12 +111,10 @@ Lisp_Object Vsignaling_function;
161 111
162int handling_signal; 112int handling_signal;
163 113
164/* Function to process declarations in defmacro forms. */
165
166Lisp_Object Vmacro_declaration_function;
167
168static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object*); 114static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object*);
169static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; 115static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
116static int interactive_p (int);
117static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, int);
170 118
171void 119void
172init_eval_once (void) 120init_eval_once (void)
@@ -176,7 +124,7 @@ init_eval_once (void)
176 specpdl_ptr = specpdl; 124 specpdl_ptr = specpdl;
177 /* Don't forget to update docs (lispref node "Local Variables"). */ 125 /* Don't forget to update docs (lispref node "Local Variables"). */
178 max_specpdl_size = 1000; 126 max_specpdl_size = 1000;
179 max_lisp_eval_depth = 500; 127 max_lisp_eval_depth = 600;
180 128
181 Vrun_hooks = Qnil; 129 Vrun_hooks = Qnil;
182} 130}
@@ -581,7 +529,7 @@ way to do this), or via (not (or executing-kbd-macro noninteractive)). */)
581 EXCLUDE_SUBRS_P non-zero means always return 0 if the function 529 EXCLUDE_SUBRS_P non-zero means always return 0 if the function
582 called is a built-in. */ 530 called is a built-in. */
583 531
584int 532static int
585interactive_p (int exclude_subrs_p) 533interactive_p (int exclude_subrs_p)
586{ 534{
587 struct backtrace *btp; 535 struct backtrace *btp;
@@ -1609,6 +1557,8 @@ internal_condition_case_n (Lisp_Object (*bfun) (int, Lisp_Object*),
1609 1557
1610static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object, 1558static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object,
1611 Lisp_Object, Lisp_Object); 1559 Lisp_Object, Lisp_Object);
1560static int maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
1561 Lisp_Object data);
1612 1562
1613DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, 1563DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
1614 doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. 1564 doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
@@ -1629,10 +1579,12 @@ See also the function `condition-case'. */)
1629 /* When memory is full, ERROR-SYMBOL is nil, 1579 /* When memory is full, ERROR-SYMBOL is nil,
1630 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA). 1580 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1631 That is a special case--don't do this in other situations. */ 1581 That is a special case--don't do this in other situations. */
1632 register struct handler *allhandlers = handlerlist;
1633 Lisp_Object conditions; 1582 Lisp_Object conditions;
1634 Lisp_Object string; 1583 Lisp_Object string;
1635 Lisp_Object real_error_symbol; 1584 Lisp_Object real_error_symbol
1585 = (NILP (error_symbol) ? Fcar (data) : error_symbol);
1586 register Lisp_Object clause = Qnil;
1587 struct handler *h;
1636 struct backtrace *bp; 1588 struct backtrace *bp;
1637 1589
1638 immediate_quit = handling_signal = 0; 1590 immediate_quit = handling_signal = 0;
@@ -1640,11 +1592,6 @@ See also the function `condition-case'. */)
1640 if (gc_in_progress || waiting_for_input) 1592 if (gc_in_progress || waiting_for_input)
1641 abort (); 1593 abort ();
1642 1594
1643 if (NILP (error_symbol))
1644 real_error_symbol = Fcar (data);
1645 else
1646 real_error_symbol = error_symbol;
1647
1648#if 0 /* rms: I don't know why this was here, 1595#if 0 /* rms: I don't know why this was here,
1649 but it is surely wrong for an error that is handled. */ 1596 but it is surely wrong for an error that is handled. */
1650#ifdef HAVE_WINDOW_SYSTEM 1597#ifdef HAVE_WINDOW_SYSTEM
@@ -1683,49 +1630,49 @@ See also the function `condition-case'. */)
1683 Vsignaling_function = *bp->function; 1630 Vsignaling_function = *bp->function;
1684 } 1631 }
1685 1632
1686 for (; handlerlist; handlerlist = handlerlist->next) 1633 for (h = handlerlist; h; h = h->next)
1687 { 1634 {
1688 register Lisp_Object clause; 1635 clause = find_handler_clause (h->handler, conditions,
1689
1690 clause = find_handler_clause (handlerlist->handler, conditions,
1691 error_symbol, data); 1636 error_symbol, data);
1692
1693 if (EQ (clause, Qlambda))
1694 {
1695 /* We can't return values to code which signaled an error, but we
1696 can continue code which has signaled a quit. */
1697 if (EQ (real_error_symbol, Qquit))
1698 return Qnil;
1699 else
1700 error ("Cannot return from the debugger in an error");
1701 }
1702
1703 if (!NILP (clause)) 1637 if (!NILP (clause))
1704 { 1638 break;
1705 Lisp_Object unwind_data;
1706 struct handler *h = handlerlist;
1707
1708 handlerlist = allhandlers;
1709
1710 if (NILP (error_symbol))
1711 unwind_data = data;
1712 else
1713 unwind_data = Fcons (error_symbol, data);
1714 h->chosen_clause = clause;
1715 unwind_to_catch (h->tag, unwind_data);
1716 }
1717 } 1639 }
1640
1641 if (/* Don't run the debugger for a memory-full error.
1642 (There is no room in memory to do that!) */
1643 !NILP (error_symbol)
1644 && (!NILP (Vdebug_on_signal)
1645 /* If no handler is present now, try to run the debugger. */
1646 || NILP (clause)
1647 /* Special handler that means "print a message and run debugger
1648 if requested". */
1649 || EQ (h->handler, Qerror)))
1650 {
1651 int debugger_called
1652 = maybe_call_debugger (conditions, error_symbol, data);
1653 /* We can't return values to code which signaled an error, but we
1654 can continue code which has signaled a quit. */
1655 if (debugger_called && EQ (real_error_symbol, Qquit))
1656 return Qnil;
1657 }
1718 1658
1719 handlerlist = allhandlers; 1659 if (!NILP (clause))
1720 /* If no handler is present now, try to run the debugger, 1660 {
1721 and if that fails, throw to top level. */ 1661 Lisp_Object unwind_data
1722 find_handler_clause (Qerror, conditions, error_symbol, data); 1662 = (NILP (error_symbol) ? data : Fcons (error_symbol, data));
1723 if (catchlist != 0) 1663
1724 Fthrow (Qtop_level, Qt); 1664 h->chosen_clause = clause;
1665 unwind_to_catch (h->tag, unwind_data);
1666 }
1667 else
1668 {
1669 if (catchlist != 0)
1670 Fthrow (Qtop_level, Qt);
1671 }
1725 1672
1726 if (! NILP (error_symbol)) 1673 if (! NILP (error_symbol))
1727 data = Fcons (error_symbol, data); 1674 data = Fcons (error_symbol, data);
1728 1675
1729 string = Ferror_message_string (data); 1676 string = Ferror_message_string (data);
1730 fatal ("%s", SDATA (string), 0); 1677 fatal ("%s", SDATA (string), 0);
1731} 1678}
@@ -1900,63 +1847,24 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions,
1900 Lisp_Object sig, Lisp_Object data) 1847 Lisp_Object sig, Lisp_Object data)
1901{ 1848{
1902 register Lisp_Object h; 1849 register Lisp_Object h;
1903 register Lisp_Object tem;
1904 int debugger_called = 0;
1905 int debugger_considered = 0;
1906 1850
1907 /* t is used by handlers for all conditions, set up by C code. */ 1851 /* t is used by handlers for all conditions, set up by C code. */
1908 if (EQ (handlers, Qt)) 1852 if (EQ (handlers, Qt))
1909 return Qt; 1853 return Qt;
1910 1854
1911 /* Don't run the debugger for a memory-full error.
1912 (There is no room in memory to do that!) */
1913 if (NILP (sig))
1914 debugger_considered = 1;
1915
1916 /* error is used similarly, but means print an error message 1855 /* error is used similarly, but means print an error message
1917 and run the debugger if that is enabled. */ 1856 and run the debugger if that is enabled. */
1918 if (EQ (handlers, Qerror) 1857 if (EQ (handlers, Qerror))
1919 || !NILP (Vdebug_on_signal)) /* This says call debugger even if 1858 return Qt;
1920 there is a handler. */
1921 {
1922 if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions))
1923 {
1924 max_lisp_eval_depth += 15;
1925 max_specpdl_size++;
1926 if (noninteractive)
1927 Fbacktrace ();
1928 else
1929 internal_with_output_to_temp_buffer
1930 ("*Backtrace*",
1931 (Lisp_Object (*) (Lisp_Object)) Fbacktrace,
1932 Qnil);
1933 max_specpdl_size--;
1934 max_lisp_eval_depth -= 15;
1935 }
1936
1937 if (!debugger_considered)
1938 {
1939 debugger_considered = 1;
1940 debugger_called = maybe_call_debugger (conditions, sig, data);
1941 }
1942
1943 /* If there is no handler, return saying whether we ran the debugger. */
1944 if (EQ (handlers, Qerror))
1945 {
1946 if (debugger_called)
1947 return Qlambda;
1948 return Qt;
1949 }
1950 }
1951 1859
1952 for (h = handlers; CONSP (h); h = Fcdr (h)) 1860 for (h = handlers; CONSP (h); h = XCDR (h))
1953 { 1861 {
1954 Lisp_Object handler, condit; 1862 Lisp_Object handler = XCAR (h);
1863 Lisp_Object condit, tem;
1955 1864
1956 handler = Fcar (h);
1957 if (!CONSP (handler)) 1865 if (!CONSP (handler))
1958 continue; 1866 continue;
1959 condit = Fcar (handler); 1867 condit = XCAR (handler);
1960 /* Handle a single condition name in handler HANDLER. */ 1868 /* Handle a single condition name in handler HANDLER. */
1961 if (SYMBOLP (condit)) 1869 if (SYMBOLP (condit))
1962 { 1870 {
@@ -1970,15 +1878,9 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions,
1970 Lisp_Object tail; 1878 Lisp_Object tail;
1971 for (tail = condit; CONSP (tail); tail = XCDR (tail)) 1879 for (tail = condit; CONSP (tail); tail = XCDR (tail))
1972 { 1880 {
1973 tem = Fmemq (Fcar (tail), conditions); 1881 tem = Fmemq (XCAR (tail), conditions);
1974 if (!NILP (tem)) 1882 if (!NILP (tem))
1975 { 1883 return handler;
1976 /* This handler is going to apply.
1977 Does it allow the debugger to run first? */
1978 if (! debugger_considered && !NILP (Fmemq (Qdebug, condit)))
1979 maybe_call_debugger (conditions, sig, data);
1980 return handler;
1981 }
1982 } 1884 }
1983 } 1885 }
1984 } 1886 }
@@ -1995,7 +1897,6 @@ verror (const char *m, va_list ap)
1995 EMACS_INT size = 200; 1897 EMACS_INT size = 200;
1996 int mlen; 1898 int mlen;
1997 char *buffer = buf; 1899 char *buffer = buf;
1998 char *args[3];
1999 int allocated = 0; 1900 int allocated = 0;
2000 Lisp_Object string; 1901 Lisp_Object string;
2001 1902
@@ -2291,14 +2192,12 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
2291 (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs))) 2192 (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs)))
2292 xsignal2 (Qwrong_number_of_arguments, original_fun, numargs); 2193 xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
2293 2194
2294 if (XSUBR (fun)->max_args == UNEVALLED) 2195 else if (XSUBR (fun)->max_args == UNEVALLED)
2295 { 2196 {
2296 backtrace.evalargs = 0; 2197 backtrace.evalargs = 0;
2297 val = (XSUBR (fun)->function.aUNEVALLED) (args_left); 2198 val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
2298 goto done;
2299 } 2199 }
2300 2200 else if (XSUBR (fun)->max_args == MANY)
2301 if (XSUBR (fun)->max_args == MANY)
2302 { 2201 {
2303 /* Pass a vector of evaluated arguments */ 2202 /* Pass a vector of evaluated arguments */
2304 Lisp_Object *vals; 2203 Lisp_Object *vals;
@@ -2324,73 +2223,76 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
2324 val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); 2223 val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
2325 UNGCPRO; 2224 UNGCPRO;
2326 SAFE_FREE (); 2225 SAFE_FREE ();
2327 goto done;
2328 } 2226 }
2329 2227 else
2330 GCPRO3 (args_left, fun, fun);
2331 gcpro3.var = argvals;
2332 gcpro3.nvars = 0;
2333
2334 maxargs = XSUBR (fun)->max_args;
2335 for (i = 0; i < maxargs; args_left = Fcdr (args_left))
2336 { 2228 {
2337 argvals[i] = Feval (Fcar (args_left)); 2229 GCPRO3 (args_left, fun, fun);
2338 gcpro3.nvars = ++i; 2230 gcpro3.var = argvals;
2339 } 2231 gcpro3.nvars = 0;
2340 2232
2341 UNGCPRO; 2233 maxargs = XSUBR (fun)->max_args;
2234 for (i = 0; i < maxargs; args_left = Fcdr (args_left))
2235 {
2236 argvals[i] = Feval (Fcar (args_left));
2237 gcpro3.nvars = ++i;
2238 }
2342 2239
2343 backtrace.args = argvals; 2240 UNGCPRO;
2344 backtrace.nargs = XINT (numargs);
2345 2241
2346 switch (i) 2242 backtrace.args = argvals;
2347 { 2243 backtrace.nargs = XINT (numargs);
2348 case 0: 2244
2349 val = (XSUBR (fun)->function.a0) (); 2245 switch (i)
2350 goto done; 2246 {
2351 case 1: 2247 case 0:
2352 val = (XSUBR (fun)->function.a1) (argvals[0]); 2248 val = (XSUBR (fun)->function.a0 ());
2353 goto done; 2249 break;
2354 case 2: 2250 case 1:
2355 val = (XSUBR (fun)->function.a2) (argvals[0], argvals[1]); 2251 val = (XSUBR (fun)->function.a1 (argvals[0]));
2356 goto done; 2252 break;
2357 case 3: 2253 case 2:
2358 val = (XSUBR (fun)->function.a3) (argvals[0], argvals[1], 2254 val = (XSUBR (fun)->function.a2 (argvals[0], argvals[1]));
2359 argvals[2]); 2255 break;
2360 goto done; 2256 case 3:
2361 case 4: 2257 val = (XSUBR (fun)->function.a3
2362 val = (XSUBR (fun)->function.a4) (argvals[0], argvals[1], 2258 (argvals[0], argvals[1], argvals[2]));
2363 argvals[2], argvals[3]); 2259 break;
2364 goto done; 2260 case 4:
2365 case 5: 2261 val = (XSUBR (fun)->function.a4
2366 val = (XSUBR (fun)->function.a5) (argvals[0], argvals[1], argvals[2], 2262 (argvals[0], argvals[1], argvals[2], argvals[3]));
2367 argvals[3], argvals[4]); 2263 break;
2368 goto done; 2264 case 5:
2369 case 6: 2265 val = (XSUBR (fun)->function.a5
2370 val = (XSUBR (fun)->function.a6) (argvals[0], argvals[1], argvals[2], 2266 (argvals[0], argvals[1], argvals[2], argvals[3],
2371 argvals[3], argvals[4], argvals[5]); 2267 argvals[4]));
2372 goto done; 2268 break;
2373 case 7: 2269 case 6:
2374 val = (XSUBR (fun)->function.a7) (argvals[0], argvals[1], argvals[2], 2270 val = (XSUBR (fun)->function.a6
2375 argvals[3], argvals[4], argvals[5], 2271 (argvals[0], argvals[1], argvals[2], argvals[3],
2376 argvals[6]); 2272 argvals[4], argvals[5]));
2377 goto done; 2273 break;
2378 2274 case 7:
2379 case 8: 2275 val = (XSUBR (fun)->function.a7
2380 val = (XSUBR (fun)->function.a8) (argvals[0], argvals[1], argvals[2], 2276 (argvals[0], argvals[1], argvals[2], argvals[3],
2381 argvals[3], argvals[4], argvals[5], 2277 argvals[4], argvals[5], argvals[6]));
2382 argvals[6], argvals[7]); 2278 break;
2383 goto done; 2279
2384 2280 case 8:
2385 default: 2281 val = (XSUBR (fun)->function.a8
2386 /* Someone has created a subr that takes more arguments than 2282 (argvals[0], argvals[1], argvals[2], argvals[3],
2387 is supported by this code. We need to either rewrite the 2283 argvals[4], argvals[5], argvals[6], argvals[7]));
2388 subr to use a different argument protocol, or add more 2284 break;
2389 cases to this switch. */ 2285
2390 abort (); 2286 default:
2287 /* Someone has created a subr that takes more arguments than
2288 is supported by this code. We need to either rewrite the
2289 subr to use a different argument protocol, or add more
2290 cases to this switch. */
2291 abort ();
2292 }
2391 } 2293 }
2392 } 2294 }
2393 if (COMPILEDP (fun)) 2295 else if (COMPILEDP (fun))
2394 val = apply_lambda (fun, original_args, 1); 2296 val = apply_lambda (fun, original_args, 1);
2395 else 2297 else
2396 { 2298 {
@@ -2413,7 +2315,6 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
2413 else 2315 else
2414 xsignal1 (Qinvalid_function, original_fun); 2316 xsignal1 (Qinvalid_function, original_fun);
2415 } 2317 }
2416 done:
2417 CHECK_CONS_LIST (); 2318 CHECK_CONS_LIST ();
2418 2319
2419 lisp_eval_depth--; 2320 lisp_eval_depth--;
@@ -2685,53 +2586,6 @@ run_hook_with_args (int nargs, Lisp_Object *args, enum run_hooks_condition cond)
2685 } 2586 }
2686} 2587}
2687 2588
2688/* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
2689 present value of that symbol.
2690 Call each element of FUNLIST,
2691 passing each of them the rest of ARGS.
2692 The caller (or its caller, etc) must gcpro all of ARGS,
2693 except that it isn't necessary to gcpro ARGS[0]. */
2694
2695Lisp_Object
2696run_hook_list_with_args (Lisp_Object funlist, int nargs, Lisp_Object *args)
2697{
2698 Lisp_Object sym;
2699 Lisp_Object val;
2700 Lisp_Object globals;
2701 struct gcpro gcpro1, gcpro2, gcpro3;
2702
2703 sym = args[0];
2704 globals = Qnil;
2705 GCPRO3 (sym, val, globals);
2706
2707 for (val = funlist; CONSP (val); val = XCDR (val))
2708 {
2709 if (EQ (XCAR (val), Qt))
2710 {
2711 /* t indicates this hook has a local binding;
2712 it means to run the global binding too. */
2713
2714 for (globals = Fdefault_value (sym);
2715 CONSP (globals);
2716 globals = XCDR (globals))
2717 {
2718 args[0] = XCAR (globals);
2719 /* In a global value, t should not occur. If it does, we
2720 must ignore it to avoid an endless loop. */
2721 if (!EQ (args[0], Qt))
2722 Ffuncall (nargs, args);
2723 }
2724 }
2725 else
2726 {
2727 args[0] = XCAR (val);
2728 Ffuncall (nargs, args);
2729 }
2730 }
2731 UNGCPRO;
2732 return Qnil;
2733}
2734
2735/* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */ 2589/* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2736 2590
2737void 2591void
@@ -2956,83 +2810,84 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
2956 2810
2957 if (SUBRP (fun)) 2811 if (SUBRP (fun))
2958 { 2812 {
2959 if (numargs < XSUBR (fun)->min_args 2813 if (numargs < XSUBR (fun)->min_args
2960 || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) 2814 || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
2961 { 2815 {
2962 XSETFASTINT (lisp_numargs, numargs); 2816 XSETFASTINT (lisp_numargs, numargs);
2963 xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs); 2817 xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs);
2964 } 2818 }
2965 2819
2966 if (XSUBR (fun)->max_args == UNEVALLED) 2820 else if (XSUBR (fun)->max_args == UNEVALLED)
2967 xsignal1 (Qinvalid_function, original_fun); 2821 xsignal1 (Qinvalid_function, original_fun);
2968 2822
2969 if (XSUBR (fun)->max_args == MANY) 2823 else if (XSUBR (fun)->max_args == MANY)
2970 { 2824 val = (XSUBR (fun)->function.aMANY) (numargs, args + 1);
2971 val = (XSUBR (fun)->function.aMANY) (numargs, args + 1);
2972 goto done;
2973 }
2974
2975 if (XSUBR (fun)->max_args > numargs)
2976 {
2977 internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object));
2978 memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object));
2979 for (i = numargs; i < XSUBR (fun)->max_args; i++)
2980 internal_args[i] = Qnil;
2981 }
2982 else 2825 else
2983 internal_args = args + 1;
2984 switch (XSUBR (fun)->max_args)
2985 { 2826 {
2986 case 0: 2827 if (XSUBR (fun)->max_args > numargs)
2987 val = (XSUBR (fun)->function.a0) (); 2828 {
2988 goto done; 2829 internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object));
2989 case 1: 2830 memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object));
2990 val = (XSUBR (fun)->function.a1) (internal_args[0]); 2831 for (i = numargs; i < XSUBR (fun)->max_args; i++)
2991 goto done; 2832 internal_args[i] = Qnil;
2992 case 2: 2833 }
2993 val = (XSUBR (fun)->function.a2) (internal_args[0], internal_args[1]); 2834 else
2994 goto done; 2835 internal_args = args + 1;
2995 case 3: 2836 switch (XSUBR (fun)->max_args)
2996 val = (XSUBR (fun)->function.a3) (internal_args[0], internal_args[1], 2837 {
2997 internal_args[2]); 2838 case 0:
2998 goto done; 2839 val = (XSUBR (fun)->function.a0 ());
2999 case 4: 2840 break;
3000 val = (XSUBR (fun)->function.a4) (internal_args[0], internal_args[1], 2841 case 1:
3001 internal_args[2], internal_args[3]); 2842 val = (XSUBR (fun)->function.a1 (internal_args[0]));
3002 goto done; 2843 break;
3003 case 5: 2844 case 2:
3004 val = (XSUBR (fun)->function.a5) (internal_args[0], internal_args[1], 2845 val = (XSUBR (fun)->function.a2
3005 internal_args[2], internal_args[3], 2846 (internal_args[0], internal_args[1]));
3006 internal_args[4]); 2847 break;
3007 goto done; 2848 case 3:
3008 case 6: 2849 val = (XSUBR (fun)->function.a3
3009 val = (XSUBR (fun)->function.a6) (internal_args[0], internal_args[1], 2850 (internal_args[0], internal_args[1], internal_args[2]));
3010 internal_args[2], internal_args[3], 2851 break;
3011 internal_args[4], internal_args[5]); 2852 case 4:
3012 goto done; 2853 val = (XSUBR (fun)->function.a4
3013 case 7: 2854 (internal_args[0], internal_args[1], internal_args[2],
3014 val = (XSUBR (fun)->function.a7) (internal_args[0], internal_args[1], 2855 internal_args[3]));
3015 internal_args[2], internal_args[3], 2856 break;
3016 internal_args[4], internal_args[5], 2857 case 5:
3017 internal_args[6]); 2858 val = (XSUBR (fun)->function.a5
3018 goto done; 2859 (internal_args[0], internal_args[1], internal_args[2],
3019 2860 internal_args[3], internal_args[4]));
3020 case 8: 2861 break;
3021 val = (XSUBR (fun)->function.a8) (internal_args[0], internal_args[1], 2862 case 6:
3022 internal_args[2], internal_args[3], 2863 val = (XSUBR (fun)->function.a6
3023 internal_args[4], internal_args[5], 2864 (internal_args[0], internal_args[1], internal_args[2],
3024 internal_args[6], internal_args[7]); 2865 internal_args[3], internal_args[4], internal_args[5]));
3025 goto done; 2866 break;
3026 2867 case 7:
3027 default: 2868 val = (XSUBR (fun)->function.a7
3028 2869 (internal_args[0], internal_args[1], internal_args[2],
3029 /* If a subr takes more than 8 arguments without using MANY 2870 internal_args[3], internal_args[4], internal_args[5],
3030 or UNEVALLED, we need to extend this function to support it. 2871 internal_args[6]));
3031 Until this is done, there is no way to call the function. */ 2872 break;
3032 abort (); 2873
2874 case 8:
2875 val = (XSUBR (fun)->function.a8
2876 (internal_args[0], internal_args[1], internal_args[2],
2877 internal_args[3], internal_args[4], internal_args[5],
2878 internal_args[6], internal_args[7]));
2879 break;
2880
2881 default:
2882
2883 /* If a subr takes more than 8 arguments without using MANY
2884 or UNEVALLED, we need to extend this function to support it.
2885 Until this is done, there is no way to call the function. */
2886 abort ();
2887 }
3033 } 2888 }
3034 } 2889 }
3035 if (COMPILEDP (fun)) 2890 else if (COMPILEDP (fun))
3036 val = funcall_lambda (fun, numargs, args + 1); 2891 val = funcall_lambda (fun, numargs, args + 1);
3037 else 2892 else
3038 { 2893 {
@@ -3054,7 +2909,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
3054 else 2909 else
3055 xsignal1 (Qinvalid_function, original_fun); 2910 xsignal1 (Qinvalid_function, original_fun);
3056 } 2911 }
3057 done:
3058 CHECK_CONS_LIST (); 2912 CHECK_CONS_LIST ();
3059 lisp_eval_depth--; 2913 lisp_eval_depth--;
3060 if (backtrace.debug_on_exit) 2914 if (backtrace.debug_on_exit)
@@ -3063,7 +2917,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
3063 return val; 2917 return val;
3064} 2918}
3065 2919
3066Lisp_Object 2920static Lisp_Object
3067apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag) 2921apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag)
3068{ 2922{
3069 Lisp_Object args_left; 2923 Lisp_Object args_left;
@@ -3550,7 +3404,7 @@ mark_backtrace (void)
3550void 3404void
3551syms_of_eval (void) 3405syms_of_eval (void)
3552{ 3406{
3553 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size, 3407 DEFVAR_INT ("max-specpdl-size", max_specpdl_size,
3554 doc: /* *Limit on number of Lisp variable bindings and `unwind-protect's. 3408 doc: /* *Limit on number of Lisp variable bindings and `unwind-protect's.
3555If Lisp code tries to increase the total number past this amount, 3409If Lisp code tries to increase the total number past this amount,
3556an error is signaled. 3410an error is signaled.
@@ -3558,7 +3412,7 @@ You can safely use a value considerably larger than the default value,
3558if that proves inconveniently small. However, if you increase it too far, 3412if that proves inconveniently small. However, if you increase it too far,
3559Emacs could run out of memory trying to make the stack bigger. */); 3413Emacs could run out of memory trying to make the stack bigger. */);
3560 3414
3561 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth, 3415 DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth,
3562 doc: /* *Limit on depth in `eval', `apply' and `funcall' before error. 3416 doc: /* *Limit on depth in `eval', `apply' and `funcall' before error.
3563 3417
3564This limit serves to catch infinite recursions for you before they cause 3418This limit serves to catch infinite recursions for you before they cause
@@ -3567,7 +3421,7 @@ You can safely make it considerably larger than its default value,
3567if that proves inconveniently small. However, if you increase it too far, 3421if that proves inconveniently small. However, if you increase it too far,
3568Emacs could overflow the real C stack, and crash. */); 3422Emacs could overflow the real C stack, and crash. */);
3569 3423
3570 DEFVAR_LISP ("quit-flag", &Vquit_flag, 3424 DEFVAR_LISP ("quit-flag", Vquit_flag,
3571 doc: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil. 3425 doc: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
3572If the value is t, that means do an ordinary quit. 3426If the value is t, that means do an ordinary quit.
3573If the value equals `throw-on-input', that means quit by throwing 3427If the value equals `throw-on-input', that means quit by throwing
@@ -3576,7 +3430,7 @@ Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
3576but `inhibit-quit' non-nil prevents anything from taking notice of that. */); 3430but `inhibit-quit' non-nil prevents anything from taking notice of that. */);
3577 Vquit_flag = Qnil; 3431 Vquit_flag = Qnil;
3578 3432
3579 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit, 3433 DEFVAR_LISP ("inhibit-quit", Vinhibit_quit,
3580 doc: /* Non-nil inhibits C-g quitting from happening immediately. 3434 doc: /* Non-nil inhibits C-g quitting from happening immediately.
3581Note that `quit-flag' will still be set by typing C-g, 3435Note that `quit-flag' will still be set by typing C-g,
3582so a quit will be signaled as soon as `inhibit-quit' is nil. 3436so a quit will be signaled as soon as `inhibit-quit' is nil.
@@ -3622,15 +3476,7 @@ before making `inhibit-quit' nil. */);
3622 Qdebug = intern_c_string ("debug"); 3476 Qdebug = intern_c_string ("debug");
3623 staticpro (&Qdebug); 3477 staticpro (&Qdebug);
3624 3478
3625 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error, 3479 DEFVAR_LISP ("debug-on-error", Vdebug_on_error,
3626 doc: /* *Non-nil means errors display a backtrace buffer.
3627More precisely, this happens for any error that is handled
3628by the editor command loop.
3629If the value is a list, an error only means to display a backtrace
3630if one of its condition symbols appears in the list. */);
3631 Vstack_trace_on_error = Qnil;
3632
3633 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error,
3634 doc: /* *Non-nil means enter debugger if an error is signaled. 3480 doc: /* *Non-nil means enter debugger if an error is signaled.
3635Does not apply to errors handled by `condition-case' or those 3481Does not apply to errors handled by `condition-case' or those
3636matched by `debug-ignored-errors'. 3482matched by `debug-ignored-errors'.
@@ -3642,7 +3488,7 @@ The command `toggle-debug-on-error' toggles this.
3642See also the variable `debug-on-quit'. */); 3488See also the variable `debug-on-quit'. */);
3643 Vdebug_on_error = Qnil; 3489 Vdebug_on_error = Qnil;
3644 3490
3645 DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors, 3491 DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors,
3646 doc: /* *List of errors for which the debugger should not be called. 3492 doc: /* *List of errors for which the debugger should not be called.
3647Each element may be a condition-name or a regexp that matches error messages. 3493Each element may be a condition-name or a regexp that matches error messages.
3648If any element applies to a given error, that error skips the debugger 3494If any element applies to a given error, that error skips the debugger
@@ -3651,21 +3497,21 @@ This overrides the variable `debug-on-error'.
3651It does not apply to errors handled by `condition-case'. */); 3497It does not apply to errors handled by `condition-case'. */);
3652 Vdebug_ignored_errors = Qnil; 3498 Vdebug_ignored_errors = Qnil;
3653 3499
3654 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit, 3500 DEFVAR_BOOL ("debug-on-quit", debug_on_quit,
3655 doc: /* *Non-nil means enter debugger if quit is signaled (C-g, for example). 3501 doc: /* *Non-nil means enter debugger if quit is signaled (C-g, for example).
3656Does not apply if quit is handled by a `condition-case'. */); 3502Does not apply if quit is handled by a `condition-case'. */);
3657 debug_on_quit = 0; 3503 debug_on_quit = 0;
3658 3504
3659 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call, 3505 DEFVAR_BOOL ("debug-on-next-call", debug_on_next_call,
3660 doc: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */); 3506 doc: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */);
3661 3507
3662 DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue, 3508 DEFVAR_BOOL ("debugger-may-continue", debugger_may_continue,
3663 doc: /* Non-nil means debugger may continue execution. 3509 doc: /* Non-nil means debugger may continue execution.
3664This is nil when the debugger is called under circumstances where it 3510This is nil when the debugger is called under circumstances where it
3665might not be safe to continue. */); 3511might not be safe to continue. */);
3666 debugger_may_continue = 1; 3512 debugger_may_continue = 1;
3667 3513
3668 DEFVAR_LISP ("debugger", &Vdebugger, 3514 DEFVAR_LISP ("debugger", Vdebugger,
3669 doc: /* Function to call to invoke debugger. 3515 doc: /* Function to call to invoke debugger.
3670If due to frame exit, args are `exit' and the value being returned; 3516If due to frame exit, args are `exit' and the value being returned;
3671 this function's value will be returned instead of that. 3517 this function's value will be returned instead of that.
@@ -3674,19 +3520,19 @@ If due to `apply' or `funcall' entry, one arg, `lambda'.
3674If due to `eval' entry, one arg, t. */); 3520If due to `eval' entry, one arg, t. */);
3675 Vdebugger = Qnil; 3521 Vdebugger = Qnil;
3676 3522
3677 DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function, 3523 DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function,
3678 doc: /* If non-nil, this is a function for `signal' to call. 3524 doc: /* If non-nil, this is a function for `signal' to call.
3679It receives the same arguments that `signal' was given. 3525It receives the same arguments that `signal' was given.
3680The Edebug package uses this to regain control. */); 3526The Edebug package uses this to regain control. */);
3681 Vsignal_hook_function = Qnil; 3527 Vsignal_hook_function = Qnil;
3682 3528
3683 DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal, 3529 DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal,
3684 doc: /* *Non-nil means call the debugger regardless of condition handlers. 3530 doc: /* *Non-nil means call the debugger regardless of condition handlers.
3685Note that `debug-on-error', `debug-on-quit' and friends 3531Note that `debug-on-error', `debug-on-quit' and friends
3686still determine whether to handle the particular condition. */); 3532still determine whether to handle the particular condition. */);
3687 Vdebug_on_signal = Qnil; 3533 Vdebug_on_signal = Qnil;
3688 3534
3689 DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function, 3535 DEFVAR_LISP ("macro-declaration-function", Vmacro_declaration_function,
3690 doc: /* Function to process declarations in a macro definition. 3536 doc: /* Function to process declarations in a macro definition.
3691The function will be called with two args MACRO and DECL. 3537The function will be called with two args MACRO and DECL.
3692MACRO is the name of the macro being defined. 3538MACRO is the name of the macro being defined.
@@ -3744,5 +3590,3 @@ The value the function returns is not used. */);
3744 defsubr (&Sbacktrace_frame); 3590 defsubr (&Sbacktrace_frame);
3745} 3591}
3746 3592
3747/* arch-tag: 014a07aa-33ab-4a8f-a3d2-ee8a4a9ff7fb
3748 (do not change this comment) */