aboutsummaryrefslogtreecommitdiffstats
path: root/src/eval.c
diff options
context:
space:
mode:
authorJoakim Verona2010-08-27 10:58:44 +0200
committerJoakim Verona2010-08-27 10:58:44 +0200
commit362120833bcbbaea94976b6701633e2ed75f6051 (patch)
tree632690a24a934bb51a32303add5172d63b6b9e00 /src/eval.c
parent1800c4865b15a9e1154bf1f03d87d1aaf750a527 (diff)
parent1a868076f51b5d6f1cf78117463e6f9c614551ec (diff)
downloademacs-362120833bcbbaea94976b6701633e2ed75f6051.tar.gz
emacs-362120833bcbbaea94976b6701633e2ed75f6051.zip
merge from trunk, fix conflicts
Diffstat (limited to 'src/eval.c')
-rw-r--r--src/eval.c518
1 files changed, 211 insertions, 307 deletions
diff --git a/src/eval.c b/src/eval.c
index 199c4705736..89d353cf7cb 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1,7 +1,7 @@
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, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
3 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 3 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
4 Free Software Foundation, Inc. 4 Free Software Foundation, Inc.
5 5
6This file is part of GNU Emacs. 6This file is part of GNU Emacs.
7 7
@@ -63,7 +63,6 @@ Lisp_Object Qand_rest, Qand_optional;
63Lisp_Object Qdebug_on_error; 63Lisp_Object Qdebug_on_error;
64Lisp_Object Qdeclare; 64Lisp_Object Qdeclare;
65Lisp_Object Qdebug; 65Lisp_Object Qdebug;
66extern Lisp_Object Qinteractive_form;
67 66
68/* This holds either the symbol `run-hooks' or nil. 67/* This holds either the symbol `run-hooks' or nil.
69 It is nil at an early stage of startup, and when Emacs 68 It is nil at an early stage of startup, and when Emacs
@@ -166,23 +165,11 @@ int handling_signal;
166 165
167Lisp_Object Vmacro_declaration_function; 166Lisp_Object Vmacro_declaration_function;
168 167
169extern Lisp_Object Qrisky_local_variable; 168static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object*);
170 169static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
171extern Lisp_Object Qfunction;
172
173static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*));
174static void unwind_to_catch P_ ((struct catchtag *, Lisp_Object)) NO_RETURN;
175
176#if __GNUC__
177/* "gcc -O3" enables automatic function inlining, which optimizes out
178 the arguments for the invocations of these functions, whereas they
179 expect these values on the stack. */
180Lisp_Object apply1 () __attribute__((noinline));
181Lisp_Object call2 () __attribute__((noinline));
182#endif
183 170
184void 171void
185init_eval_once () 172init_eval_once (void)
186{ 173{
187 specpdl_size = 50; 174 specpdl_size = 50;
188 specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding)); 175 specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
@@ -195,7 +182,7 @@ init_eval_once ()
195} 182}
196 183
197void 184void
198init_eval () 185init_eval (void)
199{ 186{
200 specpdl_ptr = specpdl; 187 specpdl_ptr = specpdl;
201 catchlist = 0; 188 catchlist = 0;
@@ -214,8 +201,7 @@ init_eval ()
214/* unwind-protect function used by call_debugger. */ 201/* unwind-protect function used by call_debugger. */
215 202
216static Lisp_Object 203static Lisp_Object
217restore_stack_limits (data) 204restore_stack_limits (Lisp_Object data)
218 Lisp_Object data;
219{ 205{
220 max_specpdl_size = XINT (XCAR (data)); 206 max_specpdl_size = XINT (XCAR (data));
221 max_lisp_eval_depth = XINT (XCDR (data)); 207 max_lisp_eval_depth = XINT (XCDR (data));
@@ -225,8 +211,7 @@ restore_stack_limits (data)
225/* Call the Lisp debugger, giving it argument ARG. */ 211/* Call the Lisp debugger, giving it argument ARG. */
226 212
227Lisp_Object 213Lisp_Object
228call_debugger (arg) 214call_debugger (Lisp_Object arg)
229 Lisp_Object arg;
230{ 215{
231 int debug_while_redisplaying; 216 int debug_while_redisplaying;
232 int count = SPECPDL_INDEX (); 217 int count = SPECPDL_INDEX ();
@@ -282,8 +267,7 @@ call_debugger (arg)
282} 267}
283 268
284void 269void
285do_debug_on_call (code) 270do_debug_on_call (Lisp_Object code)
286 Lisp_Object code;
287{ 271{
288 debug_on_next_call = 0; 272 debug_on_next_call = 0;
289 backtrace_list->debug_on_exit = 1; 273 backtrace_list->debug_on_exit = 1;
@@ -299,8 +283,7 @@ DEFUN ("or", For, Sor, 0, UNEVALLED, 0,
299The remaining args are not evalled at all. 283The remaining args are not evalled at all.
300If all args return nil, return nil. 284If all args return nil, return nil.
301usage: (or CONDITIONS...) */) 285usage: (or CONDITIONS...) */)
302 (args) 286 (Lisp_Object args)
303 Lisp_Object args;
304{ 287{
305 register Lisp_Object val = Qnil; 288 register Lisp_Object val = Qnil;
306 struct gcpro gcpro1; 289 struct gcpro gcpro1;
@@ -324,8 +307,7 @@ DEFUN ("and", Fand, Sand, 0, UNEVALLED, 0,
324The remaining args are not evalled at all. 307The remaining args are not evalled at all.
325If no arg yields nil, return the last arg's value. 308If no arg yields nil, return the last arg's value.
326usage: (and CONDITIONS...) */) 309usage: (and CONDITIONS...) */)
327 (args) 310 (Lisp_Object args)
328 Lisp_Object args;
329{ 311{
330 register Lisp_Object val = Qt; 312 register Lisp_Object val = Qt;
331 struct gcpro gcpro1; 313 struct gcpro gcpro1;
@@ -350,8 +332,7 @@ Returns the value of THEN or the value of the last of the ELSE's.
350THEN must be one expression, but ELSE... can be zero or more expressions. 332THEN must be one expression, but ELSE... can be zero or more expressions.
351If COND yields nil, and there are no ELSE's, the value is nil. 333If COND yields nil, and there are no ELSE's, the value is nil.
352usage: (if COND THEN ELSE...) */) 334usage: (if COND THEN ELSE...) */)
353 (args) 335 (Lisp_Object args)
354 Lisp_Object args;
355{ 336{
356 register Lisp_Object cond; 337 register Lisp_Object cond;
357 struct gcpro gcpro1; 338 struct gcpro gcpro1;
@@ -375,8 +356,7 @@ If no clause succeeds, cond returns nil.
375If a clause has one element, as in (CONDITION), 356If a clause has one element, as in (CONDITION),
376CONDITION's value if non-nil is returned from the cond-form. 357CONDITION's value if non-nil is returned from the cond-form.
377usage: (cond CLAUSES...) */) 358usage: (cond CLAUSES...) */)
378 (args) 359 (Lisp_Object args)
379 Lisp_Object args;
380{ 360{
381 register Lisp_Object clause, val; 361 register Lisp_Object clause, val;
382 struct gcpro gcpro1; 362 struct gcpro gcpro1;
@@ -403,8 +383,7 @@ usage: (cond CLAUSES...) */)
403DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0, 383DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
404 doc: /* Eval BODY forms sequentially and return value of last one. 384 doc: /* Eval BODY forms sequentially and return value of last one.
405usage: (progn BODY...) */) 385usage: (progn BODY...) */)
406 (args) 386 (Lisp_Object args)
407 Lisp_Object args;
408{ 387{
409 register Lisp_Object val = Qnil; 388 register Lisp_Object val = Qnil;
410 struct gcpro gcpro1; 389 struct gcpro gcpro1;
@@ -426,8 +405,7 @@ DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0,
426The value of FIRST is saved during the evaluation of the remaining args, 405The value of FIRST is saved during the evaluation of the remaining args,
427whose values are discarded. 406whose values are discarded.
428usage: (prog1 FIRST BODY...) */) 407usage: (prog1 FIRST BODY...) */)
429 (args) 408 (Lisp_Object args)
430 Lisp_Object args;
431{ 409{
432 Lisp_Object val; 410 Lisp_Object val;
433 register Lisp_Object args_left; 411 register Lisp_Object args_left;
@@ -444,7 +422,7 @@ usage: (prog1 FIRST BODY...) */)
444 do 422 do
445 { 423 {
446 if (!(argnum++)) 424 if (!(argnum++))
447 val = Feval (Fcar (args_left)); 425 val = Feval (Fcar (args_left));
448 else 426 else
449 Feval (Fcar (args_left)); 427 Feval (Fcar (args_left));
450 args_left = Fcdr (args_left); 428 args_left = Fcdr (args_left);
@@ -460,8 +438,7 @@ DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0,
460The value of FORM2 is saved during the evaluation of the 438The value of FORM2 is saved during the evaluation of the
461remaining args, whose values are discarded. 439remaining args, whose values are discarded.
462usage: (prog2 FORM1 FORM2 BODY...) */) 440usage: (prog2 FORM1 FORM2 BODY...) */)
463 (args) 441 (Lisp_Object args)
464 Lisp_Object args;
465{ 442{
466 Lisp_Object val; 443 Lisp_Object val;
467 register Lisp_Object args_left; 444 register Lisp_Object args_left;
@@ -480,7 +457,7 @@ usage: (prog2 FORM1 FORM2 BODY...) */)
480 do 457 do
481 { 458 {
482 if (!(argnum++)) 459 if (!(argnum++))
483 val = Feval (Fcar (args_left)); 460 val = Feval (Fcar (args_left));
484 else 461 else
485 Feval (Fcar (args_left)); 462 Feval (Fcar (args_left));
486 args_left = Fcdr (args_left); 463 args_left = Fcdr (args_left);
@@ -500,8 +477,7 @@ The second VAL is not computed until after the first SYM is set, and so on;
500each VAL can use the new value of variables set earlier in the `setq'. 477each VAL can use the new value of variables set earlier in the `setq'.
501The return value of the `setq' form is the value of the last VAL. 478The return value of the `setq' form is the value of the last VAL.
502usage: (setq [SYM VAL]...) */) 479usage: (setq [SYM VAL]...) */)
503 (args) 480 (Lisp_Object args)
504 Lisp_Object args;
505{ 481{
506 register Lisp_Object args_left; 482 register Lisp_Object args_left;
507 register Lisp_Object val, sym; 483 register Lisp_Object val, sym;
@@ -529,8 +505,7 @@ usage: (setq [SYM VAL]...) */)
529DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0, 505DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0,
530 doc: /* Return the argument, without evaluating it. `(quote x)' yields `x'. 506 doc: /* Return the argument, without evaluating it. `(quote x)' yields `x'.
531usage: (quote ARG) */) 507usage: (quote ARG) */)
532 (args) 508 (Lisp_Object args)
533 Lisp_Object args;
534{ 509{
535 if (!NILP (Fcdr (args))) 510 if (!NILP (Fcdr (args)))
536 xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args)); 511 xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args));
@@ -542,8 +517,7 @@ DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
542In byte compilation, `function' causes its argument to be compiled. 517In byte compilation, `function' causes its argument to be compiled.
543`quote' cannot do that. 518`quote' cannot do that.
544usage: (function ARG) */) 519usage: (function ARG) */)
545 (args) 520 (Lisp_Object args)
546 Lisp_Object args;
547{ 521{
548 if (!NILP (Fcdr (args))) 522 if (!NILP (Fcdr (args)))
549 xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args)); 523 xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
@@ -568,7 +542,7 @@ To test whether your function was called with `call-interactively',
568either (i) add an extra optional argument and give it an `interactive' 542either (i) add an extra optional argument and give it an `interactive'
569spec that specifies non-nil unconditionally (such as \"p\"); or (ii) 543spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
570use `called-interactively-p'. */) 544use `called-interactively-p'. */)
571 () 545 (void)
572{ 546{
573 return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil; 547 return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil;
574} 548}
@@ -594,8 +568,7 @@ function-modifying features. Instead of using this, it is sometimes
594cleaner to give your function an extra optional argument whose 568cleaner to give your function an extra optional argument whose
595`interactive' spec specifies non-nil unconditionally (\"p\" is a good 569`interactive' spec specifies non-nil unconditionally (\"p\" is a good
596way to do this), or via (not (or executing-kbd-macro noninteractive)). */) 570way to do this), or via (not (or executing-kbd-macro noninteractive)). */)
597 (kind) 571 (Lisp_Object kind)
598 Lisp_Object kind;
599{ 572{
600 return ((INTERACTIVE || !EQ (kind, intern ("interactive"))) 573 return ((INTERACTIVE || !EQ (kind, intern ("interactive")))
601 && interactive_p (1)) ? Qt : Qnil; 574 && interactive_p (1)) ? Qt : Qnil;
@@ -609,8 +582,7 @@ way to do this), or via (not (or executing-kbd-macro noninteractive)). */)
609 called is a built-in. */ 582 called is a built-in. */
610 583
611int 584int
612interactive_p (exclude_subrs_p) 585interactive_p (int exclude_subrs_p)
613 int exclude_subrs_p;
614{ 586{
615 struct backtrace *btp; 587 struct backtrace *btp;
616 Lisp_Object fun; 588 Lisp_Object fun;
@@ -657,8 +629,7 @@ DEFUN ("defun", Fdefun, Sdefun, 2, UNEVALLED, 0,
657The definition is (lambda ARGLIST [DOCSTRING] BODY...). 629The definition is (lambda ARGLIST [DOCSTRING] BODY...).
658See also the function `interactive'. 630See also the function `interactive'.
659usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */) 631usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */)
660 (args) 632 (Lisp_Object args)
661 Lisp_Object args;
662{ 633{
663 register Lisp_Object fn_name; 634 register Lisp_Object fn_name;
664 register Lisp_Object defn; 635 register Lisp_Object defn;
@@ -701,8 +672,7 @@ The elements can look like this:
701 Set NAME's `doc-string-elt' property to ELT. 672 Set NAME's `doc-string-elt' property to ELT.
702 673
703usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) 674usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
704 (args) 675 (Lisp_Object args)
705 Lisp_Object args;
706{ 676{
707 register Lisp_Object fn_name; 677 register Lisp_Object fn_name;
708 register Lisp_Object defn; 678 register Lisp_Object defn;
@@ -720,8 +690,8 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
720 tail = XCDR (tail); 690 tail = XCDR (tail);
721 } 691 }
722 692
723 while (CONSP (Fcar (tail)) 693 if (CONSP (Fcar (tail))
724 && EQ (Fcar (Fcar (tail)), Qdeclare)) 694 && EQ (Fcar (Fcar (tail)), Qdeclare))
725 { 695 {
726 if (!NILP (Vmacro_declaration_function)) 696 if (!NILP (Vmacro_declaration_function))
727 { 697 {
@@ -760,8 +730,7 @@ or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
760itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not, 730itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
761then the value of BASE-VARIABLE is set to that of NEW-ALIAS. 731then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
762The return value is BASE-VARIABLE. */) 732The return value is BASE-VARIABLE. */)
763 (new_alias, base_variable, docstring) 733 (Lisp_Object new_alias, Lisp_Object base_variable, Lisp_Object docstring)
764 Lisp_Object new_alias, base_variable, docstring;
765{ 734{
766 struct Lisp_Symbol *sym; 735 struct Lisp_Symbol *sym;
767 736
@@ -832,8 +801,7 @@ load a file defining variables, with this form or with `defconst' or
832for these variables. \(`defconst' and `defcustom' behave similarly in 801for these variables. \(`defconst' and `defcustom' behave similarly in
833this respect.) 802this respect.)
834usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) 803usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
835 (args) 804 (Lisp_Object args)
836 Lisp_Object args;
837{ 805{
838 register Lisp_Object sym, tem, tail; 806 register Lisp_Object sym, tem, tail;
839 807
@@ -905,8 +873,7 @@ If SYMBOL has a local binding, then this form sets the local binding's
905value. However, you should normally not make local bindings for 873value. However, you should normally not make local bindings for
906variables defined with this form. 874variables defined with this form.
907usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) 875usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
908 (args) 876 (Lisp_Object args)
909 Lisp_Object args;
910{ 877{
911 register Lisp_Object sym, tem; 878 register Lisp_Object sym, tem;
912 879
@@ -932,8 +899,7 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
932 899
933/* Error handler used in Fuser_variable_p. */ 900/* Error handler used in Fuser_variable_p. */
934static Lisp_Object 901static Lisp_Object
935user_variable_p_eh (ignore) 902user_variable_p_eh (Lisp_Object ignore)
936 Lisp_Object ignore;
937{ 903{
938 return Qnil; 904 return Qnil;
939} 905}
@@ -955,8 +921,7 @@ A variable is a user variable if
955\(3) it is an alias for another user variable. 921\(3) it is an alias for another user variable.
956Return nil if VARIABLE is an alias and there is a loop in the 922Return nil if VARIABLE is an alias and there is a loop in the
957chain of symbols. */) 923chain of symbols. */)
958 (variable) 924 (Lisp_Object variable)
959 Lisp_Object variable;
960{ 925{
961 Lisp_Object documentation; 926 Lisp_Object documentation;
962 927
@@ -966,30 +931,30 @@ chain of symbols. */)
966 /* If indirect and there's an alias loop, don't check anything else. */ 931 /* If indirect and there's an alias loop, don't check anything else. */
967 if (XSYMBOL (variable)->redirect == SYMBOL_VARALIAS 932 if (XSYMBOL (variable)->redirect == SYMBOL_VARALIAS
968 && NILP (internal_condition_case_1 (lisp_indirect_variable, variable, 933 && NILP (internal_condition_case_1 (lisp_indirect_variable, variable,
969 Qt, user_variable_p_eh))) 934 Qt, user_variable_p_eh)))
970 return Qnil; 935 return Qnil;
971 936
972 while (1) 937 while (1)
973 { 938 {
974 documentation = Fget (variable, Qvariable_documentation); 939 documentation = Fget (variable, Qvariable_documentation);
975 if (INTEGERP (documentation) && XINT (documentation) < 0) 940 if (INTEGERP (documentation) && XINT (documentation) < 0)
976 return Qt; 941 return Qt;
977 if (STRINGP (documentation) 942 if (STRINGP (documentation)
978 && ((unsigned char) SREF (documentation, 0) == '*')) 943 && ((unsigned char) SREF (documentation, 0) == '*'))
979 return Qt; 944 return Qt;
980 /* If it is (STRING . INTEGER), a negative integer means a user variable. */ 945 /* If it is (STRING . INTEGER), a negative integer means a user variable. */
981 if (CONSP (documentation) 946 if (CONSP (documentation)
982 && STRINGP (XCAR (documentation)) 947 && STRINGP (XCAR (documentation))
983 && INTEGERP (XCDR (documentation)) 948 && INTEGERP (XCDR (documentation))
984 && XINT (XCDR (documentation)) < 0) 949 && XINT (XCDR (documentation)) < 0)
985 return Qt; 950 return Qt;
986 /* Customizable? See `custom-variable-p'. */ 951 /* Customizable? See `custom-variable-p'. */
987 if ((!NILP (Fget (variable, intern ("standard-value")))) 952 if ((!NILP (Fget (variable, intern ("standard-value"))))
988 || (!NILP (Fget (variable, intern ("custom-autoload"))))) 953 || (!NILP (Fget (variable, intern ("custom-autoload")))))
989 return Qt; 954 return Qt;
990 955
991 if (!(XSYMBOL (variable)->redirect == SYMBOL_VARALIAS)) 956 if (!(XSYMBOL (variable)->redirect == SYMBOL_VARALIAS))
992 return Qnil; 957 return Qnil;
993 958
994 /* An indirect variable? Let's follow the chain. */ 959 /* An indirect variable? Let's follow the chain. */
995 XSETSYMBOL (variable, SYMBOL_ALIAS (XSYMBOL (variable))); 960 XSETSYMBOL (variable, SYMBOL_ALIAS (XSYMBOL (variable)));
@@ -1003,8 +968,7 @@ Each element of VARLIST is a symbol (which is bound to nil)
1003or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). 968or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
1004Each VALUEFORM can refer to the symbols already bound by this VARLIST. 969Each VALUEFORM can refer to the symbols already bound by this VARLIST.
1005usage: (let* VARLIST BODY...) */) 970usage: (let* VARLIST BODY...) */)
1006 (args) 971 (Lisp_Object args)
1007 Lisp_Object args;
1008{ 972{
1009 Lisp_Object varlist, val, elt; 973 Lisp_Object varlist, val, elt;
1010 int count = SPECPDL_INDEX (); 974 int count = SPECPDL_INDEX ();
@@ -1040,20 +1004,20 @@ Each element of VARLIST is a symbol (which is bound to nil)
1040or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). 1004or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
1041All the VALUEFORMs are evalled before any symbols are bound. 1005All the VALUEFORMs are evalled before any symbols are bound.
1042usage: (let VARLIST BODY...) */) 1006usage: (let VARLIST BODY...) */)
1043 (args) 1007 (Lisp_Object args)
1044 Lisp_Object args;
1045{ 1008{
1046 Lisp_Object *temps, tem; 1009 Lisp_Object *temps, tem;
1047 register Lisp_Object elt, varlist; 1010 register Lisp_Object elt, varlist;
1048 int count = SPECPDL_INDEX (); 1011 int count = SPECPDL_INDEX ();
1049 register int argnum; 1012 register int argnum;
1050 struct gcpro gcpro1, gcpro2; 1013 struct gcpro gcpro1, gcpro2;
1014 USE_SAFE_ALLOCA;
1051 1015
1052 varlist = Fcar (args); 1016 varlist = Fcar (args);
1053 1017
1054 /* Make space to hold the values to give the bound variables */ 1018 /* Make space to hold the values to give the bound variables */
1055 elt = Flength (varlist); 1019 elt = Flength (varlist);
1056 temps = (Lisp_Object *) alloca (XFASTINT (elt) * sizeof (Lisp_Object)); 1020 SAFE_ALLOCA_LISP (temps, XFASTINT (elt));
1057 1021
1058 /* Compute the values and store them in `temps' */ 1022 /* Compute the values and store them in `temps' */
1059 1023
@@ -1086,6 +1050,7 @@ usage: (let VARLIST BODY...) */)
1086 } 1050 }
1087 1051
1088 elt = Fprogn (Fcdr (args)); 1052 elt = Fprogn (Fcdr (args));
1053 SAFE_FREE ();
1089 return unbind_to (count, elt); 1054 return unbind_to (count, elt);
1090} 1055}
1091 1056
@@ -1094,8 +1059,7 @@ DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0,
1094The order of execution is thus TEST, BODY, TEST, BODY and so on 1059The order of execution is thus TEST, BODY, TEST, BODY and so on
1095until TEST returns nil. 1060until TEST returns nil.
1096usage: (while TEST BODY...) */) 1061usage: (while TEST BODY...) */)
1097 (args) 1062 (Lisp_Object args)
1098 Lisp_Object args;
1099{ 1063{
1100 Lisp_Object test, body; 1064 Lisp_Object test, body;
1101 struct gcpro gcpro1, gcpro2; 1065 struct gcpro gcpro1, gcpro2;
@@ -1122,9 +1086,7 @@ in place of FORM. When a non-macro-call results, it is returned.
1122 1086
1123The second optional arg ENVIRONMENT specifies an environment of macro 1087The second optional arg ENVIRONMENT specifies an environment of macro
1124definitions to shadow the loaded ones for use in file byte-compilation. */) 1088definitions to shadow the loaded ones for use in file byte-compilation. */)
1125 (form, environment) 1089 (Lisp_Object form, Lisp_Object environment)
1126 Lisp_Object form;
1127 Lisp_Object environment;
1128{ 1090{
1129 /* With cleanups from Hallvard Furuseth. */ 1091 /* With cleanups from Hallvard Furuseth. */
1130 register Lisp_Object expander, sym, def, tem; 1092 register Lisp_Object expander, sym, def, tem;
@@ -1202,8 +1164,7 @@ Within BODY, a call to `throw' with the same TAG exits BODY and this `catch'.
1202If no throw happens, `catch' returns the value of the last BODY form. 1164If no throw happens, `catch' returns the value of the last BODY form.
1203If a throw happens, it specifies the value to return from `catch'. 1165If a throw happens, it specifies the value to return from `catch'.
1204usage: (catch TAG BODY...) */) 1166usage: (catch TAG BODY...) */)
1205 (args) 1167 (Lisp_Object args)
1206 Lisp_Object args;
1207{ 1168{
1208 register Lisp_Object tag; 1169 register Lisp_Object tag;
1209 struct gcpro gcpro1; 1170 struct gcpro gcpro1;
@@ -1219,10 +1180,7 @@ usage: (catch TAG BODY...) */)
1219 This is how catches are done from within C code. */ 1180 This is how catches are done from within C code. */
1220 1181
1221Lisp_Object 1182Lisp_Object
1222internal_catch (tag, func, arg) 1183internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
1223 Lisp_Object tag;
1224 Lisp_Object (*func) ();
1225 Lisp_Object arg;
1226{ 1184{
1227 /* This structure is made part of the chain `catchlist'. */ 1185 /* This structure is made part of the chain `catchlist'. */
1228 struct catchtag c; 1186 struct catchtag c;
@@ -1267,9 +1225,7 @@ internal_catch (tag, func, arg)
1267 This is used for correct unwinding in Fthrow and Fsignal. */ 1225 This is used for correct unwinding in Fthrow and Fsignal. */
1268 1226
1269static void 1227static void
1270unwind_to_catch (catch, value) 1228unwind_to_catch (struct catchtag *catch, Lisp_Object value)
1271 struct catchtag *catch;
1272 Lisp_Object value;
1273{ 1229{
1274 register int last_time; 1230 register int last_time;
1275 1231
@@ -1287,7 +1243,7 @@ unwind_to_catch (catch, value)
1287 last_time = catchlist == catch; 1243 last_time = catchlist == catch;
1288 1244
1289 /* Unwind the specpdl stack, and then restore the proper set of 1245 /* Unwind the specpdl stack, and then restore the proper set of
1290 handlers. */ 1246 handlers. */
1291 unbind_to (catchlist->pdlcount, Qnil); 1247 unbind_to (catchlist->pdlcount, Qnil);
1292 handlerlist = catchlist->handlerlist; 1248 handlerlist = catchlist->handlerlist;
1293 catchlist = catchlist->next; 1249 catchlist = catchlist->next;
@@ -1298,8 +1254,8 @@ unwind_to_catch (catch, value)
1298 /* If x_catch_errors was done, turn it off now. 1254 /* If x_catch_errors was done, turn it off now.
1299 (First we give unbind_to a chance to do that.) */ 1255 (First we give unbind_to a chance to do that.) */
1300#if 0 /* This would disable x_catch_errors after x_connection_closed. 1256#if 0 /* This would disable x_catch_errors after x_connection_closed.
1301 * The catch must remain in effect during that delicate 1257 The catch must remain in effect during that delicate
1302 * state. --lorentey */ 1258 state. --lorentey */
1303 x_fully_uncatch_errors (); 1259 x_fully_uncatch_errors ();
1304#endif 1260#endif
1305#endif 1261#endif
@@ -1321,8 +1277,7 @@ unwind_to_catch (catch, value)
1321DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0, 1277DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
1322 doc: /* Throw to the catch for TAG and return VALUE from it. 1278 doc: /* Throw to the catch for TAG and return VALUE from it.
1323Both TAG and VALUE are evalled. */) 1279Both TAG and VALUE are evalled. */)
1324 (tag, value) 1280 (register Lisp_Object tag, Lisp_Object value)
1325 register Lisp_Object tag, value;
1326{ 1281{
1327 register struct catchtag *c; 1282 register struct catchtag *c;
1328 1283
@@ -1342,8 +1297,7 @@ If BODYFORM completes normally, its value is returned
1342after executing the UNWINDFORMS. 1297after executing the UNWINDFORMS.
1343If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway. 1298If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
1344usage: (unwind-protect BODYFORM UNWINDFORMS...) */) 1299usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
1345 (args) 1300 (Lisp_Object args)
1346 Lisp_Object args;
1347{ 1301{
1348 Lisp_Object val; 1302 Lisp_Object val;
1349 int count = SPECPDL_INDEX (); 1303 int count = SPECPDL_INDEX ();
@@ -1377,14 +1331,13 @@ instead of a single condition name. Then it handles all of them.
1377When a handler handles an error, control returns to the `condition-case' 1331When a handler handles an error, control returns to the `condition-case'
1378and it executes the handler's BODY... 1332and it executes the handler's BODY...
1379with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error. 1333with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
1380(If VAR is nil, the handler can't access that information.) 1334\(If VAR is nil, the handler can't access that information.)
1381Then the value of the last BODY form is returned from the `condition-case' 1335Then the value of the last BODY form is returned from the `condition-case'
1382expression. 1336expression.
1383 1337
1384See also the function `signal' for more info. 1338See also the function `signal' for more info.
1385usage: (condition-case VAR BODYFORM &rest HANDLERS) */) 1339usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1386 (args) 1340 (Lisp_Object args)
1387 Lisp_Object args;
1388{ 1341{
1389 register Lisp_Object bodyform, handlers; 1342 register Lisp_Object bodyform, handlers;
1390 volatile Lisp_Object var; 1343 volatile Lisp_Object var;
@@ -1400,9 +1353,8 @@ usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1400 rather than passed in a list. Used by Fbyte_code. */ 1353 rather than passed in a list. Used by Fbyte_code. */
1401 1354
1402Lisp_Object 1355Lisp_Object
1403internal_lisp_condition_case (var, bodyform, handlers) 1356internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
1404 volatile Lisp_Object var; 1357 Lisp_Object handlers)
1405 Lisp_Object bodyform, handlers;
1406{ 1358{
1407 Lisp_Object val; 1359 Lisp_Object val;
1408 struct catchtag c; 1360 struct catchtag c;
@@ -1434,7 +1386,7 @@ internal_lisp_condition_case (var, bodyform, handlers)
1434 if (_setjmp (c.jmp)) 1386 if (_setjmp (c.jmp))
1435 { 1387 {
1436 if (!NILP (h.var)) 1388 if (!NILP (h.var))
1437 specbind (h.var, c.val); 1389 specbind (h.var, c.val);
1438 val = Fprogn (Fcdr (h.chosen_clause)); 1390 val = Fprogn (Fcdr (h.chosen_clause));
1439 1391
1440 /* Note that this just undoes the binding of h.var; whoever 1392 /* Note that this just undoes the binding of h.var; whoever
@@ -1469,10 +1421,8 @@ internal_lisp_condition_case (var, bodyform, handlers)
1469 but allow the debugger to run if that is enabled. */ 1421 but allow the debugger to run if that is enabled. */
1470 1422
1471Lisp_Object 1423Lisp_Object
1472internal_condition_case (bfun, handlers, hfun) 1424internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers,
1473 Lisp_Object (*bfun) (); 1425 Lisp_Object (*hfun) (Lisp_Object))
1474 Lisp_Object handlers;
1475 Lisp_Object (*hfun) ();
1476{ 1426{
1477 Lisp_Object val; 1427 Lisp_Object val;
1478 struct catchtag c; 1428 struct catchtag c;
@@ -1516,11 +1466,8 @@ internal_condition_case (bfun, handlers, hfun)
1516/* Like internal_condition_case but call BFUN with ARG as its argument. */ 1466/* Like internal_condition_case but call BFUN with ARG as its argument. */
1517 1467
1518Lisp_Object 1468Lisp_Object
1519internal_condition_case_1 (bfun, arg, handlers, hfun) 1469internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg,
1520 Lisp_Object (*bfun) (); 1470 Lisp_Object handlers, Lisp_Object (*hfun) (Lisp_Object))
1521 Lisp_Object arg;
1522 Lisp_Object handlers;
1523 Lisp_Object (*hfun) ();
1524{ 1471{
1525 Lisp_Object val; 1472 Lisp_Object val;
1526 struct catchtag c; 1473 struct catchtag c;
@@ -1660,8 +1607,8 @@ internal_condition_case_n (Lisp_Object (*bfun) (int, Lisp_Object*),
1660} 1607}
1661 1608
1662 1609
1663static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object, 1610static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object,
1664 Lisp_Object, Lisp_Object)); 1611 Lisp_Object, Lisp_Object);
1665 1612
1666DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, 1613DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
1667 doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. 1614 doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
@@ -1677,16 +1624,13 @@ See Info anchor `(elisp)Definition of signal' for some details on how this
1677error message is constructed. 1624error message is constructed.
1678If the signal is handled, DATA is made available to the handler. 1625If the signal is handled, DATA is made available to the handler.
1679See also the function `condition-case'. */) 1626See also the function `condition-case'. */)
1680 (error_symbol, data) 1627 (Lisp_Object error_symbol, Lisp_Object data)
1681 Lisp_Object error_symbol, data;
1682{ 1628{
1683 /* When memory is full, ERROR-SYMBOL is nil, 1629 /* When memory is full, ERROR-SYMBOL is nil,
1684 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA). 1630 and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
1685 That is a special case--don't do this in other situations. */ 1631 That is a special case--don't do this in other situations. */
1686 register struct handler *allhandlers = handlerlist; 1632 register struct handler *allhandlers = handlerlist;
1687 Lisp_Object conditions; 1633 Lisp_Object conditions;
1688 extern int gc_in_progress;
1689 extern int waiting_for_input;
1690 Lisp_Object string; 1634 Lisp_Object string;
1691 Lisp_Object real_error_symbol; 1635 Lisp_Object real_error_symbol;
1692 struct backtrace *bp; 1636 struct backtrace *bp;
@@ -1790,8 +1734,7 @@ See also the function `condition-case'. */)
1790 Used for anything but Qquit (which can return from Fsignal). */ 1734 Used for anything but Qquit (which can return from Fsignal). */
1791 1735
1792void 1736void
1793xsignal (error_symbol, data) 1737xsignal (Lisp_Object error_symbol, Lisp_Object data)
1794 Lisp_Object error_symbol, data;
1795{ 1738{
1796 Fsignal (error_symbol, data); 1739 Fsignal (error_symbol, data);
1797 abort (); 1740 abort ();
@@ -1800,29 +1743,25 @@ xsignal (error_symbol, data)
1800/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */ 1743/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
1801 1744
1802void 1745void
1803xsignal0 (error_symbol) 1746xsignal0 (Lisp_Object error_symbol)
1804 Lisp_Object error_symbol;
1805{ 1747{
1806 xsignal (error_symbol, Qnil); 1748 xsignal (error_symbol, Qnil);
1807} 1749}
1808 1750
1809void 1751void
1810xsignal1 (error_symbol, arg) 1752xsignal1 (Lisp_Object error_symbol, Lisp_Object arg)
1811 Lisp_Object error_symbol, arg;
1812{ 1753{
1813 xsignal (error_symbol, list1 (arg)); 1754 xsignal (error_symbol, list1 (arg));
1814} 1755}
1815 1756
1816void 1757void
1817xsignal2 (error_symbol, arg1, arg2) 1758xsignal2 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2)
1818 Lisp_Object error_symbol, arg1, arg2;
1819{ 1759{
1820 xsignal (error_symbol, list2 (arg1, arg2)); 1760 xsignal (error_symbol, list2 (arg1, arg2));
1821} 1761}
1822 1762
1823void 1763void
1824xsignal3 (error_symbol, arg1, arg2, arg3) 1764xsignal3 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
1825 Lisp_Object error_symbol, arg1, arg2, arg3;
1826{ 1765{
1827 xsignal (error_symbol, list3 (arg1, arg2, arg3)); 1766 xsignal (error_symbol, list3 (arg1, arg2, arg3));
1828} 1767}
@@ -1831,9 +1770,7 @@ xsignal3 (error_symbol, arg1, arg2, arg3)
1831 If ARG is not a genuine list, make it a one-element list. */ 1770 If ARG is not a genuine list, make it a one-element list. */
1832 1771
1833void 1772void
1834signal_error (s, arg) 1773signal_error (const char *s, Lisp_Object arg)
1835 char *s;
1836 Lisp_Object arg;
1837{ 1774{
1838 Lisp_Object tortoise, hare; 1775 Lisp_Object tortoise, hare;
1839 1776
@@ -1862,8 +1799,7 @@ signal_error (s, arg)
1862 a list containing one of CONDITIONS. */ 1799 a list containing one of CONDITIONS. */
1863 1800
1864static int 1801static int
1865wants_debugger (list, conditions) 1802wants_debugger (Lisp_Object list, Lisp_Object conditions)
1866 Lisp_Object list, conditions;
1867{ 1803{
1868 if (NILP (list)) 1804 if (NILP (list))
1869 return 0; 1805 return 0;
@@ -1887,8 +1823,7 @@ wants_debugger (list, conditions)
1887 according to debugger-ignored-errors. */ 1823 according to debugger-ignored-errors. */
1888 1824
1889static int 1825static int
1890skip_debugger (conditions, data) 1826skip_debugger (Lisp_Object conditions, Lisp_Object data)
1891 Lisp_Object conditions, data;
1892{ 1827{
1893 Lisp_Object tail; 1828 Lisp_Object tail;
1894 int first_string = 1; 1829 int first_string = 1;
@@ -1925,8 +1860,7 @@ skip_debugger (conditions, data)
1925 SIG and DATA describe the signal, as in find_handler_clause. */ 1860 SIG and DATA describe the signal, as in find_handler_clause. */
1926 1861
1927static int 1862static int
1928maybe_call_debugger (conditions, sig, data) 1863maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
1929 Lisp_Object conditions, sig, data;
1930{ 1864{
1931 Lisp_Object combined_data; 1865 Lisp_Object combined_data;
1932 1866
@@ -1962,8 +1896,8 @@ maybe_call_debugger (conditions, sig, data)
1962 a second error here in case we're handling specpdl overflow. */ 1896 a second error here in case we're handling specpdl overflow. */
1963 1897
1964static Lisp_Object 1898static Lisp_Object
1965find_handler_clause (handlers, conditions, sig, data) 1899find_handler_clause (Lisp_Object handlers, Lisp_Object conditions,
1966 Lisp_Object handlers, conditions, sig, data; 1900 Lisp_Object sig, Lisp_Object data)
1967{ 1901{
1968 register Lisp_Object h; 1902 register Lisp_Object h;
1969 register Lisp_Object tem; 1903 register Lisp_Object tem;
@@ -2052,13 +1986,10 @@ find_handler_clause (handlers, conditions, sig, data)
2052 return Qnil; 1986 return Qnil;
2053} 1987}
2054 1988
2055/* dump an error message; called like printf */
2056 1989
2057/* VARARGS 1 */ 1990/* dump an error message; called like vprintf */
2058void 1991void
2059error (m, a1, a2, a3) 1992verror (const char *m, va_list ap)
2060 char *m;
2061 char *a1, *a2, *a3;
2062{ 1993{
2063 char buf[200]; 1994 char buf[200];
2064 int size = 200; 1995 int size = 200;
@@ -2068,15 +1999,12 @@ error (m, a1, a2, a3)
2068 int allocated = 0; 1999 int allocated = 0;
2069 Lisp_Object string; 2000 Lisp_Object string;
2070 2001
2071 args[0] = a1;
2072 args[1] = a2;
2073 args[2] = a3;
2074
2075 mlen = strlen (m); 2002 mlen = strlen (m);
2076 2003
2077 while (1) 2004 while (1)
2078 { 2005 {
2079 int used = doprnt (buffer, size, m, m + mlen, 3, args); 2006 int used;
2007 used = doprnt (buffer, size, m, m + mlen, ap);
2080 if (used < size) 2008 if (used < size)
2081 break; 2009 break;
2082 size *= 2; 2010 size *= 2;
@@ -2095,6 +2023,19 @@ error (m, a1, a2, a3)
2095 2023
2096 xsignal1 (Qerror, string); 2024 xsignal1 (Qerror, string);
2097} 2025}
2026
2027
2028/* dump an error message; called like printf */
2029
2030/* VARARGS 1 */
2031void
2032error (const char *m, ...)
2033{
2034 va_list ap;
2035 va_start (ap, m);
2036 verror (m, ap);
2037 va_end (ap);
2038}
2098 2039
2099DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0, 2040DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
2100 doc: /* Non-nil if FUNCTION makes provisions for interactive calling. 2041 doc: /* Non-nil if FUNCTION makes provisions for interactive calling.
@@ -2111,8 +2052,7 @@ Also, a symbol satisfies `commandp' if its function definition does so.
2111 2052
2112If the optional argument FOR-CALL-INTERACTIVELY is non-nil, 2053If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
2113then strings and vectors are not accepted. */) 2054then strings and vectors are not accepted. */)
2114 (function, for_call_interactively) 2055 (Lisp_Object function, Lisp_Object for_call_interactively)
2115 Lisp_Object function, for_call_interactively;
2116{ 2056{
2117 register Lisp_Object fun; 2057 register Lisp_Object fun;
2118 register Lisp_Object funcar; 2058 register Lisp_Object funcar;
@@ -2176,8 +2116,7 @@ Third through fifth args give info about the real definition.
2176They default to nil. 2116They default to nil.
2177If FUNCTION is already defined other than as an autoload, 2117If FUNCTION is already defined other than as an autoload,
2178this does nothing and returns nil. */) 2118this does nothing and returns nil. */)
2179 (function, file, docstring, interactive, type) 2119 (Lisp_Object function, Lisp_Object file, Lisp_Object docstring, Lisp_Object interactive, Lisp_Object type)
2180 Lisp_Object function, file, docstring, interactive, type;
2181{ 2120{
2182 CHECK_SYMBOL (function); 2121 CHECK_SYMBOL (function);
2183 CHECK_STRING (file); 2122 CHECK_STRING (file);
@@ -2205,8 +2144,7 @@ this does nothing and returns nil. */)
2205} 2144}
2206 2145
2207Lisp_Object 2146Lisp_Object
2208un_autoload (oldqueue) 2147un_autoload (Lisp_Object oldqueue)
2209 Lisp_Object oldqueue;
2210{ 2148{
2211 register Lisp_Object queue, first, second; 2149 register Lisp_Object queue, first, second;
2212 2150
@@ -2233,8 +2171,7 @@ un_autoload (oldqueue)
2233 FUNDEF is the autoload definition (a list). */ 2171 FUNDEF is the autoload definition (a list). */
2234 2172
2235void 2173void
2236do_autoload (fundef, funname) 2174do_autoload (Lisp_Object fundef, Lisp_Object funname)
2237 Lisp_Object fundef, funname;
2238{ 2175{
2239 int count = SPECPDL_INDEX (); 2176 int count = SPECPDL_INDEX ();
2240 Lisp_Object fun; 2177 Lisp_Object fun;
@@ -2259,7 +2196,7 @@ do_autoload (fundef, funname)
2259 the function. We do this in the specific case of autoloading 2196 the function. We do this in the specific case of autoloading
2260 because autoloading is not an explicit request "load this file", 2197 because autoloading is not an explicit request "load this file",
2261 but rather a request to "call this function". 2198 but rather a request to "call this function".
2262 2199
2263 The value saved here is to be restored into Vautoload_queue. */ 2200 The value saved here is to be restored into Vautoload_queue. */
2264 record_unwind_protect (un_autoload, Vautoload_queue); 2201 record_unwind_protect (un_autoload, Vautoload_queue);
2265 Vautoload_queue = Qt; 2202 Vautoload_queue = Qt;
@@ -2280,8 +2217,7 @@ do_autoload (fundef, funname)
2280 2217
2281DEFUN ("eval", Feval, Seval, 1, 1, 0, 2218DEFUN ("eval", Feval, Seval, 1, 1, 0,
2282 doc: /* Evaluate FORM and return its value. */) 2219 doc: /* Evaluate FORM and return its value. */)
2283 (form) 2220 (Lisp_Object form)
2284 Lisp_Object form;
2285{ 2221{
2286 Lisp_Object fun, val, original_fun, original_args; 2222 Lisp_Object fun, val, original_fun, original_args;
2287 Lisp_Object funcar; 2223 Lisp_Object funcar;
@@ -2358,7 +2294,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
2358 if (XSUBR (fun)->max_args == UNEVALLED) 2294 if (XSUBR (fun)->max_args == UNEVALLED)
2359 { 2295 {
2360 backtrace.evalargs = 0; 2296 backtrace.evalargs = 0;
2361 val = (*XSUBR (fun)->function) (args_left); 2297 val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
2362 goto done; 2298 goto done;
2363 } 2299 }
2364 2300
@@ -2367,8 +2303,9 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
2367 /* Pass a vector of evaluated arguments */ 2303 /* Pass a vector of evaluated arguments */
2368 Lisp_Object *vals; 2304 Lisp_Object *vals;
2369 register int argnum = 0; 2305 register int argnum = 0;
2306 USE_SAFE_ALLOCA;
2370 2307
2371 vals = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object)); 2308 SAFE_ALLOCA_LISP (vals, XINT (numargs));
2372 2309
2373 GCPRO3 (args_left, fun, fun); 2310 GCPRO3 (args_left, fun, fun);
2374 gcpro3.var = vals; 2311 gcpro3.var = vals;
@@ -2384,8 +2321,9 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
2384 backtrace.args = vals; 2321 backtrace.args = vals;
2385 backtrace.nargs = XINT (numargs); 2322 backtrace.nargs = XINT (numargs);
2386 2323
2387 val = (*XSUBR (fun)->function) (XINT (numargs), vals); 2324 val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
2388 UNGCPRO; 2325 UNGCPRO;
2326 SAFE_FREE ();
2389 goto done; 2327 goto done;
2390 } 2328 }
2391 2329
@@ -2408,40 +2346,40 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
2408 switch (i) 2346 switch (i)
2409 { 2347 {
2410 case 0: 2348 case 0:
2411 val = (*XSUBR (fun)->function) (); 2349 val = (XSUBR (fun)->function.a0) ();
2412 goto done; 2350 goto done;
2413 case 1: 2351 case 1:
2414 val = (*XSUBR (fun)->function) (argvals[0]); 2352 val = (XSUBR (fun)->function.a1) (argvals[0]);
2415 goto done; 2353 goto done;
2416 case 2: 2354 case 2:
2417 val = (*XSUBR (fun)->function) (argvals[0], argvals[1]); 2355 val = (XSUBR (fun)->function.a2) (argvals[0], argvals[1]);
2418 goto done; 2356 goto done;
2419 case 3: 2357 case 3:
2420 val = (*XSUBR (fun)->function) (argvals[0], argvals[1], 2358 val = (XSUBR (fun)->function.a3) (argvals[0], argvals[1],
2421 argvals[2]); 2359 argvals[2]);
2422 goto done; 2360 goto done;
2423 case 4: 2361 case 4:
2424 val = (*XSUBR (fun)->function) (argvals[0], argvals[1], 2362 val = (XSUBR (fun)->function.a4) (argvals[0], argvals[1],
2425 argvals[2], argvals[3]); 2363 argvals[2], argvals[3]);
2426 goto done; 2364 goto done;
2427 case 5: 2365 case 5:
2428 val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2], 2366 val = (XSUBR (fun)->function.a5) (argvals[0], argvals[1], argvals[2],
2429 argvals[3], argvals[4]); 2367 argvals[3], argvals[4]);
2430 goto done; 2368 goto done;
2431 case 6: 2369 case 6:
2432 val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2], 2370 val = (XSUBR (fun)->function.a6) (argvals[0], argvals[1], argvals[2],
2433 argvals[3], argvals[4], argvals[5]); 2371 argvals[3], argvals[4], argvals[5]);
2434 goto done; 2372 goto done;
2435 case 7: 2373 case 7:
2436 val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2], 2374 val = (XSUBR (fun)->function.a7) (argvals[0], argvals[1], argvals[2],
2437 argvals[3], argvals[4], argvals[5], 2375 argvals[3], argvals[4], argvals[5],
2438 argvals[6]); 2376 argvals[6]);
2439 goto done; 2377 goto done;
2440 2378
2441 case 8: 2379 case 8:
2442 val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2], 2380 val = (XSUBR (fun)->function.a8) (argvals[0], argvals[1], argvals[2],
2443 argvals[3], argvals[4], argvals[5], 2381 argvals[3], argvals[4], argvals[5],
2444 argvals[6], argvals[7]); 2382 argvals[6], argvals[7]);
2445 goto done; 2383 goto done;
2446 2384
2447 default: 2385 default:
@@ -2491,15 +2429,14 @@ DEFUN ("apply", Fapply, Sapply, 2, MANY, 0,
2491Then return the value FUNCTION returns. 2429Then return the value FUNCTION returns.
2492Thus, (apply '+ 1 2 '(3 4)) returns 10. 2430Thus, (apply '+ 1 2 '(3 4)) returns 10.
2493usage: (apply FUNCTION &rest ARGUMENTS) */) 2431usage: (apply FUNCTION &rest ARGUMENTS) */)
2494 (nargs, args) 2432 (int nargs, Lisp_Object *args)
2495 int nargs;
2496 Lisp_Object *args;
2497{ 2433{
2498 register int i, numargs; 2434 register int i, numargs;
2499 register Lisp_Object spread_arg; 2435 register Lisp_Object spread_arg;
2500 register Lisp_Object *funcall_args; 2436 register Lisp_Object *funcall_args;
2501 Lisp_Object fun; 2437 Lisp_Object fun, retval;
2502 struct gcpro gcpro1; 2438 struct gcpro gcpro1;
2439 USE_SAFE_ALLOCA;
2503 2440
2504 fun = args [0]; 2441 fun = args [0];
2505 funcall_args = 0; 2442 funcall_args = 0;
@@ -2538,8 +2475,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
2538 { 2475 {
2539 /* Avoid making funcall cons up a yet another new vector of arguments 2476 /* Avoid making funcall cons up a yet another new vector of arguments
2540 by explicitly supplying nil's for optional values */ 2477 by explicitly supplying nil's for optional values */
2541 funcall_args = (Lisp_Object *) alloca ((1 + XSUBR (fun)->max_args) 2478 SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args);
2542 * sizeof (Lisp_Object));
2543 for (i = numargs; i < XSUBR (fun)->max_args;) 2479 for (i = numargs; i < XSUBR (fun)->max_args;)
2544 funcall_args[++i] = Qnil; 2480 funcall_args[++i] = Qnil;
2545 GCPRO1 (*funcall_args); 2481 GCPRO1 (*funcall_args);
@@ -2551,13 +2487,12 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
2551 function itself as well as its arguments. */ 2487 function itself as well as its arguments. */
2552 if (!funcall_args) 2488 if (!funcall_args)
2553 { 2489 {
2554 funcall_args = (Lisp_Object *) alloca ((1 + numargs) 2490 SAFE_ALLOCA_LISP (funcall_args, 1 + numargs);
2555 * sizeof (Lisp_Object));
2556 GCPRO1 (*funcall_args); 2491 GCPRO1 (*funcall_args);
2557 gcpro1.nvars = 1 + numargs; 2492 gcpro1.nvars = 1 + numargs;
2558 } 2493 }
2559 2494
2560 bcopy (args, funcall_args, nargs * sizeof (Lisp_Object)); 2495 memcpy (funcall_args, args, nargs * sizeof (Lisp_Object));
2561 /* Spread the last arg we got. Its first element goes in 2496 /* Spread the last arg we got. Its first element goes in
2562 the slot that it used to occupy, hence this value of I. */ 2497 the slot that it used to occupy, hence this value of I. */
2563 i = nargs - 1; 2498 i = nargs - 1;
@@ -2568,14 +2503,18 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
2568 } 2503 }
2569 2504
2570 /* By convention, the caller needs to gcpro Ffuncall's args. */ 2505 /* By convention, the caller needs to gcpro Ffuncall's args. */
2571 RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args)); 2506 retval = Ffuncall (gcpro1.nvars, funcall_args);
2507 UNGCPRO;
2508 SAFE_FREE ();
2509
2510 return retval;
2572} 2511}
2573 2512
2574/* Run hook variables in various ways. */ 2513/* Run hook variables in various ways. */
2575 2514
2576enum run_hooks_condition {to_completion, until_success, until_failure}; 2515enum run_hooks_condition {to_completion, until_success, until_failure};
2577static Lisp_Object run_hook_with_args P_ ((int, Lisp_Object *, 2516static Lisp_Object run_hook_with_args (int, Lisp_Object *,
2578 enum run_hooks_condition)); 2517 enum run_hooks_condition);
2579 2518
2580DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0, 2519DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
2581 doc: /* Run each hook in HOOKS. 2520 doc: /* Run each hook in HOOKS.
@@ -2592,9 +2531,7 @@ hook; they should use `run-mode-hooks' instead.
2592Do not use `make-local-variable' to make a hook variable buffer-local. 2531Do not use `make-local-variable' to make a hook variable buffer-local.
2593Instead, use `add-hook' and specify t for the LOCAL argument. 2532Instead, use `add-hook' and specify t for the LOCAL argument.
2594usage: (run-hooks &rest HOOKS) */) 2533usage: (run-hooks &rest HOOKS) */)
2595 (nargs, args) 2534 (int nargs, Lisp_Object *args)
2596 int nargs;
2597 Lisp_Object *args;
2598{ 2535{
2599 Lisp_Object hook[1]; 2536 Lisp_Object hook[1];
2600 register int i; 2537 register int i;
@@ -2623,9 +2560,7 @@ as that may change.
2623Do not use `make-local-variable' to make a hook variable buffer-local. 2560Do not use `make-local-variable' to make a hook variable buffer-local.
2624Instead, use `add-hook' and specify t for the LOCAL argument. 2561Instead, use `add-hook' and specify t for the LOCAL argument.
2625usage: (run-hook-with-args HOOK &rest ARGS) */) 2562usage: (run-hook-with-args HOOK &rest ARGS) */)
2626 (nargs, args) 2563 (int nargs, Lisp_Object *args)
2627 int nargs;
2628 Lisp_Object *args;
2629{ 2564{
2630 return run_hook_with_args (nargs, args, to_completion); 2565 return run_hook_with_args (nargs, args, to_completion);
2631} 2566}
@@ -2645,9 +2580,7 @@ However, if they all return nil, we return nil.
2645Do not use `make-local-variable' to make a hook variable buffer-local. 2580Do not use `make-local-variable' to make a hook variable buffer-local.
2646Instead, use `add-hook' and specify t for the LOCAL argument. 2581Instead, use `add-hook' and specify t for the LOCAL argument.
2647usage: (run-hook-with-args-until-success HOOK &rest ARGS) */) 2582usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2648 (nargs, args) 2583 (int nargs, Lisp_Object *args)
2649 int nargs;
2650 Lisp_Object *args;
2651{ 2584{
2652 return run_hook_with_args (nargs, args, until_success); 2585 return run_hook_with_args (nargs, args, until_success);
2653} 2586}
@@ -2666,9 +2599,7 @@ Then we return nil. However, if they all return non-nil, we return non-nil.
2666Do not use `make-local-variable' to make a hook variable buffer-local. 2599Do not use `make-local-variable' to make a hook variable buffer-local.
2667Instead, use `add-hook' and specify t for the LOCAL argument. 2600Instead, use `add-hook' and specify t for the LOCAL argument.
2668usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */) 2601usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2669 (nargs, args) 2602 (int nargs, Lisp_Object *args)
2670 int nargs;
2671 Lisp_Object *args;
2672{ 2603{
2673 return run_hook_with_args (nargs, args, until_failure); 2604 return run_hook_with_args (nargs, args, until_failure);
2674} 2605}
@@ -2682,10 +2613,7 @@ usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2682 except that it isn't necessary to gcpro ARGS[0]. */ 2613 except that it isn't necessary to gcpro ARGS[0]. */
2683 2614
2684static Lisp_Object 2615static Lisp_Object
2685run_hook_with_args (nargs, args, cond) 2616run_hook_with_args (int nargs, Lisp_Object *args, enum run_hooks_condition cond)
2686 int nargs;
2687 Lisp_Object *args;
2688 enum run_hooks_condition cond;
2689{ 2617{
2690 Lisp_Object sym, val, ret; 2618 Lisp_Object sym, val, ret;
2691 struct gcpro gcpro1, gcpro2, gcpro3; 2619 struct gcpro gcpro1, gcpro2, gcpro3;
@@ -2765,10 +2693,7 @@ run_hook_with_args (nargs, args, cond)
2765 except that it isn't necessary to gcpro ARGS[0]. */ 2693 except that it isn't necessary to gcpro ARGS[0]. */
2766 2694
2767Lisp_Object 2695Lisp_Object
2768run_hook_list_with_args (funlist, nargs, args) 2696run_hook_list_with_args (Lisp_Object funlist, int nargs, Lisp_Object *args)
2769 Lisp_Object funlist;
2770 int nargs;
2771 Lisp_Object *args;
2772{ 2697{
2773 Lisp_Object sym; 2698 Lisp_Object sym;
2774 Lisp_Object val; 2699 Lisp_Object val;
@@ -2810,8 +2735,7 @@ run_hook_list_with_args (funlist, nargs, args)
2810/* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */ 2735/* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
2811 2736
2812void 2737void
2813run_hook_with_args_2 (hook, arg1, arg2) 2738run_hook_with_args_2 (Lisp_Object hook, Lisp_Object arg1, Lisp_Object arg2)
2814 Lisp_Object hook, arg1, arg2;
2815{ 2739{
2816 Lisp_Object temp[3]; 2740 Lisp_Object temp[3];
2817 temp[0] = hook; 2741 temp[0] = hook;
@@ -2823,8 +2747,7 @@ run_hook_with_args_2 (hook, arg1, arg2)
2823 2747
2824/* Apply fn to arg */ 2748/* Apply fn to arg */
2825Lisp_Object 2749Lisp_Object
2826apply1 (fn, arg) 2750apply1 (Lisp_Object fn, Lisp_Object arg)
2827 Lisp_Object fn, arg;
2828{ 2751{
2829 struct gcpro gcpro1; 2752 struct gcpro gcpro1;
2830 2753
@@ -2843,8 +2766,7 @@ apply1 (fn, arg)
2843 2766
2844/* Call function fn on no arguments */ 2767/* Call function fn on no arguments */
2845Lisp_Object 2768Lisp_Object
2846call0 (fn) 2769call0 (Lisp_Object fn)
2847 Lisp_Object fn;
2848{ 2770{
2849 struct gcpro gcpro1; 2771 struct gcpro gcpro1;
2850 2772
@@ -2855,8 +2777,7 @@ call0 (fn)
2855/* Call function fn with 1 argument arg1 */ 2777/* Call function fn with 1 argument arg1 */
2856/* ARGSUSED */ 2778/* ARGSUSED */
2857Lisp_Object 2779Lisp_Object
2858call1 (fn, arg1) 2780call1 (Lisp_Object fn, Lisp_Object arg1)
2859 Lisp_Object fn, arg1;
2860{ 2781{
2861 struct gcpro gcpro1; 2782 struct gcpro gcpro1;
2862 Lisp_Object args[2]; 2783 Lisp_Object args[2];
@@ -2871,8 +2792,7 @@ call1 (fn, arg1)
2871/* Call function fn with 2 arguments arg1, arg2 */ 2792/* Call function fn with 2 arguments arg1, arg2 */
2872/* ARGSUSED */ 2793/* ARGSUSED */
2873Lisp_Object 2794Lisp_Object
2874call2 (fn, arg1, arg2) 2795call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
2875 Lisp_Object fn, arg1, arg2;
2876{ 2796{
2877 struct gcpro gcpro1; 2797 struct gcpro gcpro1;
2878 Lisp_Object args[3]; 2798 Lisp_Object args[3];
@@ -2887,8 +2807,7 @@ call2 (fn, arg1, arg2)
2887/* Call function fn with 3 arguments arg1, arg2, arg3 */ 2807/* Call function fn with 3 arguments arg1, arg2, arg3 */
2888/* ARGSUSED */ 2808/* ARGSUSED */
2889Lisp_Object 2809Lisp_Object
2890call3 (fn, arg1, arg2, arg3) 2810call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
2891 Lisp_Object fn, arg1, arg2, arg3;
2892{ 2811{
2893 struct gcpro gcpro1; 2812 struct gcpro gcpro1;
2894 Lisp_Object args[4]; 2813 Lisp_Object args[4];
@@ -2904,8 +2823,8 @@ call3 (fn, arg1, arg2, arg3)
2904/* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */ 2823/* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
2905/* ARGSUSED */ 2824/* ARGSUSED */
2906Lisp_Object 2825Lisp_Object
2907call4 (fn, arg1, arg2, arg3, arg4) 2826call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2908 Lisp_Object fn, arg1, arg2, arg3, arg4; 2827 Lisp_Object arg4)
2909{ 2828{
2910 struct gcpro gcpro1; 2829 struct gcpro gcpro1;
2911 Lisp_Object args[5]; 2830 Lisp_Object args[5];
@@ -2922,8 +2841,8 @@ call4 (fn, arg1, arg2, arg3, arg4)
2922/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */ 2841/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
2923/* ARGSUSED */ 2842/* ARGSUSED */
2924Lisp_Object 2843Lisp_Object
2925call5 (fn, arg1, arg2, arg3, arg4, arg5) 2844call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2926 Lisp_Object fn, arg1, arg2, arg3, arg4, arg5; 2845 Lisp_Object arg4, Lisp_Object arg5)
2927{ 2846{
2928 struct gcpro gcpro1; 2847 struct gcpro gcpro1;
2929 Lisp_Object args[6]; 2848 Lisp_Object args[6];
@@ -2941,8 +2860,8 @@ call5 (fn, arg1, arg2, arg3, arg4, arg5)
2941/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */ 2860/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
2942/* ARGSUSED */ 2861/* ARGSUSED */
2943Lisp_Object 2862Lisp_Object
2944call6 (fn, arg1, arg2, arg3, arg4, arg5, arg6) 2863call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2945 Lisp_Object fn, arg1, arg2, arg3, arg4, arg5, arg6; 2864 Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6)
2946{ 2865{
2947 struct gcpro gcpro1; 2866 struct gcpro gcpro1;
2948 Lisp_Object args[7]; 2867 Lisp_Object args[7];
@@ -2961,8 +2880,8 @@ call6 (fn, arg1, arg2, arg3, arg4, arg5, arg6)
2961/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7 */ 2880/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7 */
2962/* ARGSUSED */ 2881/* ARGSUSED */
2963Lisp_Object 2882Lisp_Object
2964call7 (fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7) 2883call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2965 Lisp_Object fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7; 2884 Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7)
2966{ 2885{
2967 struct gcpro gcpro1; 2886 struct gcpro gcpro1;
2968 Lisp_Object args[8]; 2887 Lisp_Object args[8];
@@ -2986,9 +2905,7 @@ DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
2986Return the value that function returns. 2905Return the value that function returns.
2987Thus, (funcall 'cons 'x 'y) returns (x . y). 2906Thus, (funcall 'cons 'x 'y) returns (x . y).
2988usage: (funcall FUNCTION &rest ARGUMENTS) */) 2907usage: (funcall FUNCTION &rest ARGUMENTS) */)
2989 (nargs, args) 2908 (int nargs, Lisp_Object *args)
2990 int nargs;
2991 Lisp_Object *args;
2992{ 2909{
2993 Lisp_Object fun, original_fun; 2910 Lisp_Object fun, original_fun;
2994 Lisp_Object funcar; 2911 Lisp_Object funcar;
@@ -3051,14 +2968,14 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
3051 2968
3052 if (XSUBR (fun)->max_args == MANY) 2969 if (XSUBR (fun)->max_args == MANY)
3053 { 2970 {
3054 val = (*XSUBR (fun)->function) (numargs, args + 1); 2971 val = (XSUBR (fun)->function.aMANY) (numargs, args + 1);
3055 goto done; 2972 goto done;
3056 } 2973 }
3057 2974
3058 if (XSUBR (fun)->max_args > numargs) 2975 if (XSUBR (fun)->max_args > numargs)
3059 { 2976 {
3060 internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object)); 2977 internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object));
3061 bcopy (args + 1, internal_args, numargs * sizeof (Lisp_Object)); 2978 memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object));
3062 for (i = numargs; i < XSUBR (fun)->max_args; i++) 2979 for (i = numargs; i < XSUBR (fun)->max_args; i++)
3063 internal_args[i] = Qnil; 2980 internal_args[i] = Qnil;
3064 } 2981 }
@@ -3067,44 +2984,44 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
3067 switch (XSUBR (fun)->max_args) 2984 switch (XSUBR (fun)->max_args)
3068 { 2985 {
3069 case 0: 2986 case 0:
3070 val = (*XSUBR (fun)->function) (); 2987 val = (XSUBR (fun)->function.a0) ();
3071 goto done; 2988 goto done;
3072 case 1: 2989 case 1:
3073 val = (*XSUBR (fun)->function) (internal_args[0]); 2990 val = (XSUBR (fun)->function.a1) (internal_args[0]);
3074 goto done; 2991 goto done;
3075 case 2: 2992 case 2:
3076 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1]); 2993 val = (XSUBR (fun)->function.a2) (internal_args[0], internal_args[1]);
3077 goto done; 2994 goto done;
3078 case 3: 2995 case 3:
3079 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1], 2996 val = (XSUBR (fun)->function.a3) (internal_args[0], internal_args[1],
3080 internal_args[2]); 2997 internal_args[2]);
3081 goto done; 2998 goto done;
3082 case 4: 2999 case 4:
3083 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1], 3000 val = (XSUBR (fun)->function.a4) (internal_args[0], internal_args[1],
3084 internal_args[2], internal_args[3]); 3001 internal_args[2], internal_args[3]);
3085 goto done; 3002 goto done;
3086 case 5: 3003 case 5:
3087 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1], 3004 val = (XSUBR (fun)->function.a5) (internal_args[0], internal_args[1],
3088 internal_args[2], internal_args[3], 3005 internal_args[2], internal_args[3],
3089 internal_args[4]); 3006 internal_args[4]);
3090 goto done; 3007 goto done;
3091 case 6: 3008 case 6:
3092 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1], 3009 val = (XSUBR (fun)->function.a6) (internal_args[0], internal_args[1],
3093 internal_args[2], internal_args[3], 3010 internal_args[2], internal_args[3],
3094 internal_args[4], internal_args[5]); 3011 internal_args[4], internal_args[5]);
3095 goto done; 3012 goto done;
3096 case 7: 3013 case 7:
3097 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1], 3014 val = (XSUBR (fun)->function.a7) (internal_args[0], internal_args[1],
3098 internal_args[2], internal_args[3], 3015 internal_args[2], internal_args[3],
3099 internal_args[4], internal_args[5], 3016 internal_args[4], internal_args[5],
3100 internal_args[6]); 3017 internal_args[6]);
3101 goto done; 3018 goto done;
3102 3019
3103 case 8: 3020 case 8:
3104 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1], 3021 val = (XSUBR (fun)->function.a8) (internal_args[0], internal_args[1],
3105 internal_args[2], internal_args[3], 3022 internal_args[2], internal_args[3],
3106 internal_args[4], internal_args[5], 3023 internal_args[4], internal_args[5],
3107 internal_args[6], internal_args[7]); 3024 internal_args[6], internal_args[7]);
3108 goto done; 3025 goto done;
3109 3026
3110 default: 3027 default:
@@ -3147,9 +3064,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
3147} 3064}
3148 3065
3149Lisp_Object 3066Lisp_Object
3150apply_lambda (fun, args, eval_flag) 3067apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag)
3151 Lisp_Object fun, args;
3152 int eval_flag;
3153{ 3068{
3154 Lisp_Object args_left; 3069 Lisp_Object args_left;
3155 Lisp_Object numargs; 3070 Lisp_Object numargs;
@@ -3157,9 +3072,10 @@ apply_lambda (fun, args, eval_flag)
3157 struct gcpro gcpro1, gcpro2, gcpro3; 3072 struct gcpro gcpro1, gcpro2, gcpro3;
3158 register int i; 3073 register int i;
3159 register Lisp_Object tem; 3074 register Lisp_Object tem;
3075 USE_SAFE_ALLOCA;
3160 3076
3161 numargs = Flength (args); 3077 numargs = Flength (args);
3162 arg_vector = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object)); 3078 SAFE_ALLOCA_LISP (arg_vector, XINT (numargs));
3163 args_left = args; 3079 args_left = args;
3164 3080
3165 GCPRO3 (*arg_vector, args_left, fun); 3081 GCPRO3 (*arg_vector, args_left, fun);
@@ -3188,6 +3104,7 @@ apply_lambda (fun, args, eval_flag)
3188 tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil))); 3104 tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil)));
3189 /* Don't do it again when we return to eval. */ 3105 /* Don't do it again when we return to eval. */
3190 backtrace_list->debug_on_exit = 0; 3106 backtrace_list->debug_on_exit = 0;
3107 SAFE_FREE ();
3191 return tem; 3108 return tem;
3192} 3109}
3193 3110
@@ -3196,10 +3113,7 @@ apply_lambda (fun, args, eval_flag)
3196 FUN must be either a lambda-expression or a compiled-code object. */ 3113 FUN must be either a lambda-expression or a compiled-code object. */
3197 3114
3198static Lisp_Object 3115static Lisp_Object
3199funcall_lambda (fun, nargs, arg_vector) 3116funcall_lambda (Lisp_Object fun, int nargs, register Lisp_Object *arg_vector)
3200 Lisp_Object fun;
3201 int nargs;
3202 register Lisp_Object *arg_vector;
3203{ 3117{
3204 Lisp_Object val, syms_left, next; 3118 Lisp_Object val, syms_left, next;
3205 int count = SPECPDL_INDEX (); 3119 int count = SPECPDL_INDEX ();
@@ -3268,8 +3182,7 @@ funcall_lambda (fun, nargs, arg_vector)
3268DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, 3182DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
3269 1, 1, 0, 3183 1, 1, 0,
3270 doc: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */) 3184 doc: /* If byte-compiled OBJECT is lazy-loaded, fetch it now. */)
3271 (object) 3185 (Lisp_Object object)
3272 Lisp_Object object;
3273{ 3186{
3274 Lisp_Object tem; 3187 Lisp_Object tem;
3275 3188
@@ -3291,7 +3204,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
3291} 3204}
3292 3205
3293void 3206void
3294grow_specpdl () 3207grow_specpdl (void)
3295{ 3208{
3296 register int count = SPECPDL_INDEX (); 3209 register int count = SPECPDL_INDEX ();
3297 if (specpdl_size >= max_specpdl_size) 3210 if (specpdl_size >= max_specpdl_size)
@@ -3324,8 +3237,7 @@ grow_specpdl ()
3324 BUFFER did not yet have a buffer-local value). */ 3237 BUFFER did not yet have a buffer-local value). */
3325 3238
3326void 3239void
3327specbind (symbol, value) 3240specbind (Lisp_Object symbol, Lisp_Object value)
3328 Lisp_Object symbol, value;
3329{ 3241{
3330 struct Lisp_Symbol *sym; 3242 struct Lisp_Symbol *sym;
3331 3243
@@ -3342,18 +3254,17 @@ specbind (symbol, value)
3342 case SYMBOL_VARALIAS: 3254 case SYMBOL_VARALIAS:
3343 sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start; 3255 sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start;
3344 case SYMBOL_PLAINVAL: 3256 case SYMBOL_PLAINVAL:
3345 { /* The most common case is that of a non-constant symbol with a 3257 /* The most common case is that of a non-constant symbol with a
3346 trivial value. Make that as fast as we can. */ 3258 trivial value. Make that as fast as we can. */
3347 specpdl_ptr->symbol = symbol; 3259 specpdl_ptr->symbol = symbol;
3348 specpdl_ptr->old_value = SYMBOL_VAL (sym); 3260 specpdl_ptr->old_value = SYMBOL_VAL (sym);
3349 specpdl_ptr->func = NULL; 3261 specpdl_ptr->func = NULL;
3350 ++specpdl_ptr; 3262 ++specpdl_ptr;
3351 if (!sym->constant) 3263 if (!sym->constant)
3352 SET_SYMBOL_VAL (sym, value); 3264 SET_SYMBOL_VAL (sym, value);
3353 else 3265 else
3354 set_internal (symbol, value, Qnil, 1); 3266 set_internal (symbol, value, Qnil, 1);
3355 break; 3267 break;
3356 }
3357 case SYMBOL_LOCALIZED: 3268 case SYMBOL_LOCALIZED:
3358 if (SYMBOL_BLV (sym)->frame_local) 3269 if (SYMBOL_BLV (sym)->frame_local)
3359 error ("Frame-local vars cannot be let-bound"); 3270 error ("Frame-local vars cannot be let-bound");
@@ -3423,9 +3334,7 @@ specbind (symbol, value)
3423} 3334}
3424 3335
3425void 3336void
3426record_unwind_protect (function, arg) 3337record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
3427 Lisp_Object (*function) P_ ((Lisp_Object));
3428 Lisp_Object arg;
3429{ 3338{
3430 eassert (!handling_signal); 3339 eassert (!handling_signal);
3431 3340
@@ -3438,9 +3347,7 @@ record_unwind_protect (function, arg)
3438} 3347}
3439 3348
3440Lisp_Object 3349Lisp_Object
3441unbind_to (count, value) 3350unbind_to (int count, Lisp_Object value)
3442 int count;
3443 Lisp_Object value;
3444{ 3351{
3445 Lisp_Object quitf = Vquit_flag; 3352 Lisp_Object quitf = Vquit_flag;
3446 struct gcpro gcpro1, gcpro2; 3353 struct gcpro gcpro1, gcpro2;
@@ -3467,7 +3374,7 @@ unbind_to (count, value)
3467 bound a variable that had a buffer-local or frame-local 3374 bound a variable that had a buffer-local or frame-local
3468 binding. WHERE nil means that the variable had the default 3375 binding. WHERE nil means that the variable had the default
3469 value when it was bound. CURRENT-BUFFER is the buffer that 3376 value when it was bound. CURRENT-BUFFER is the buffer that
3470 was current when the variable was bound. */ 3377 was current when the variable was bound. */
3471 else if (CONSP (this_binding.symbol)) 3378 else if (CONSP (this_binding.symbol))
3472 { 3379 {
3473 Lisp_Object symbol, where; 3380 Lisp_Object symbol, where;
@@ -3506,8 +3413,7 @@ unbind_to (count, value)
3506DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, 3413DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
3507 doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG. 3414 doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
3508The debugger is entered when that frame exits, if the flag is non-nil. */) 3415The debugger is entered when that frame exits, if the flag is non-nil. */)
3509 (level, flag) 3416 (Lisp_Object level, Lisp_Object flag)
3510 Lisp_Object level, flag;
3511{ 3417{
3512 register struct backtrace *backlist = backtrace_list; 3418 register struct backtrace *backlist = backtrace_list;
3513 register int i; 3419 register int i;
@@ -3528,13 +3434,12 @@ The debugger is entered when that frame exits, if the flag is non-nil. */)
3528DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "", 3434DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
3529 doc: /* Print a trace of Lisp function calls currently active. 3435 doc: /* Print a trace of Lisp function calls currently active.
3530Output stream used is value of `standard-output'. */) 3436Output stream used is value of `standard-output'. */)
3531 () 3437 (void)
3532{ 3438{
3533 register struct backtrace *backlist = backtrace_list; 3439 register struct backtrace *backlist = backtrace_list;
3534 register int i; 3440 register int i;
3535 Lisp_Object tail; 3441 Lisp_Object tail;
3536 Lisp_Object tem; 3442 Lisp_Object tem;
3537 extern Lisp_Object Vprint_level;
3538 struct gcpro gcpro1; 3443 struct gcpro gcpro1;
3539 3444
3540 XSETFASTINT (Vprint_level, 3); 3445 XSETFASTINT (Vprint_level, 3);
@@ -3593,8 +3498,7 @@ A &rest arg is represented as the tail of the list ARG-VALUES.
3593FUNCTION is whatever was supplied as car of evaluated list, 3498FUNCTION is whatever was supplied as car of evaluated list,
3594or a lambda expression for macro calls. 3499or a lambda expression for macro calls.
3595If NFRAMES is more than the number of frames, the value is nil. */) 3500If NFRAMES is more than the number of frames, the value is nil. */)
3596 (nframes) 3501 (Lisp_Object nframes)
3597 Lisp_Object nframes;
3598{ 3502{
3599 register struct backtrace *backlist = backtrace_list; 3503 register struct backtrace *backlist = backtrace_list;
3600 register int i; 3504 register int i;
@@ -3623,7 +3527,7 @@ If NFRAMES is more than the number of frames, the value is nil. */)
3623 3527
3624 3528
3625void 3529void
3626mark_backtrace () 3530mark_backtrace (void)
3627{ 3531{
3628 register struct backtrace *backlist; 3532 register struct backtrace *backlist;
3629 register int i; 3533 register int i;
@@ -3642,7 +3546,7 @@ mark_backtrace ()
3642} 3546}
3643 3547
3644void 3548void
3645syms_of_eval () 3549syms_of_eval (void)
3646{ 3550{
3647 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size, 3551 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size,
3648 doc: /* *Limit on number of Lisp variable bindings and `unwind-protect's. 3552 doc: /* *Limit on number of Lisp variable bindings and `unwind-protect's.