diff options
| author | Joakim Verona | 2010-08-27 10:58:44 +0200 |
|---|---|---|
| committer | Joakim Verona | 2010-08-27 10:58:44 +0200 |
| commit | 362120833bcbbaea94976b6701633e2ed75f6051 (patch) | |
| tree | 632690a24a934bb51a32303add5172d63b6b9e00 /src/eval.c | |
| parent | 1800c4865b15a9e1154bf1f03d87d1aaf750a527 (diff) | |
| parent | 1a868076f51b5d6f1cf78117463e6f9c614551ec (diff) | |
| download | emacs-362120833bcbbaea94976b6701633e2ed75f6051.tar.gz emacs-362120833bcbbaea94976b6701633e2ed75f6051.zip | |
merge from trunk, fix conflicts
Diffstat (limited to 'src/eval.c')
| -rw-r--r-- | src/eval.c | 518 |
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 | ||
| 6 | This file is part of GNU Emacs. | 6 | This file is part of GNU Emacs. |
| 7 | 7 | ||
| @@ -63,7 +63,6 @@ Lisp_Object Qand_rest, Qand_optional; | |||
| 63 | Lisp_Object Qdebug_on_error; | 63 | Lisp_Object Qdebug_on_error; |
| 64 | Lisp_Object Qdeclare; | 64 | Lisp_Object Qdeclare; |
| 65 | Lisp_Object Qdebug; | 65 | Lisp_Object Qdebug; |
| 66 | extern 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 | ||
| 167 | Lisp_Object Vmacro_declaration_function; | 166 | Lisp_Object Vmacro_declaration_function; |
| 168 | 167 | ||
| 169 | extern Lisp_Object Qrisky_local_variable; | 168 | static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object*); |
| 170 | 169 | static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; | |
| 171 | extern Lisp_Object Qfunction; | ||
| 172 | |||
| 173 | static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*)); | ||
| 174 | static 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. */ | ||
| 180 | Lisp_Object apply1 () __attribute__((noinline)); | ||
| 181 | Lisp_Object call2 () __attribute__((noinline)); | ||
| 182 | #endif | ||
| 183 | 170 | ||
| 184 | void | 171 | void |
| 185 | init_eval_once () | 172 | init_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 | ||
| 197 | void | 184 | void |
| 198 | init_eval () | 185 | init_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 | ||
| 216 | static Lisp_Object | 203 | static Lisp_Object |
| 217 | restore_stack_limits (data) | 204 | restore_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 | ||
| 227 | Lisp_Object | 213 | Lisp_Object |
| 228 | call_debugger (arg) | 214 | call_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 | ||
| 284 | void | 269 | void |
| 285 | do_debug_on_call (code) | 270 | do_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, | |||
| 299 | The remaining args are not evalled at all. | 283 | The remaining args are not evalled at all. |
| 300 | If all args return nil, return nil. | 284 | If all args return nil, return nil. |
| 301 | usage: (or CONDITIONS...) */) | 285 | usage: (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, | |||
| 324 | The remaining args are not evalled at all. | 307 | The remaining args are not evalled at all. |
| 325 | If no arg yields nil, return the last arg's value. | 308 | If no arg yields nil, return the last arg's value. |
| 326 | usage: (and CONDITIONS...) */) | 309 | usage: (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. | |||
| 350 | THEN must be one expression, but ELSE... can be zero or more expressions. | 332 | THEN must be one expression, but ELSE... can be zero or more expressions. |
| 351 | If COND yields nil, and there are no ELSE's, the value is nil. | 333 | If COND yields nil, and there are no ELSE's, the value is nil. |
| 352 | usage: (if COND THEN ELSE...) */) | 334 | usage: (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. | |||
| 375 | If a clause has one element, as in (CONDITION), | 356 | If a clause has one element, as in (CONDITION), |
| 376 | CONDITION's value if non-nil is returned from the cond-form. | 357 | CONDITION's value if non-nil is returned from the cond-form. |
| 377 | usage: (cond CLAUSES...) */) | 358 | usage: (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...) */) | |||
| 403 | DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0, | 383 | DEFUN ("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. |
| 405 | usage: (progn BODY...) */) | 385 | usage: (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, | |||
| 426 | The value of FIRST is saved during the evaluation of the remaining args, | 405 | The value of FIRST is saved during the evaluation of the remaining args, |
| 427 | whose values are discarded. | 406 | whose values are discarded. |
| 428 | usage: (prog1 FIRST BODY...) */) | 407 | usage: (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, | |||
| 460 | The value of FORM2 is saved during the evaluation of the | 438 | The value of FORM2 is saved during the evaluation of the |
| 461 | remaining args, whose values are discarded. | 439 | remaining args, whose values are discarded. |
| 462 | usage: (prog2 FORM1 FORM2 BODY...) */) | 440 | usage: (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; | |||
| 500 | each VAL can use the new value of variables set earlier in the `setq'. | 477 | each VAL can use the new value of variables set earlier in the `setq'. |
| 501 | The return value of the `setq' form is the value of the last VAL. | 478 | The return value of the `setq' form is the value of the last VAL. |
| 502 | usage: (setq [SYM VAL]...) */) | 479 | usage: (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]...) */) | |||
| 529 | DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0, | 505 | DEFUN ("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'. |
| 531 | usage: (quote ARG) */) | 507 | usage: (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, | |||
| 542 | In byte compilation, `function' causes its argument to be compiled. | 517 | In byte compilation, `function' causes its argument to be compiled. |
| 543 | `quote' cannot do that. | 518 | `quote' cannot do that. |
| 544 | usage: (function ARG) */) | 519 | usage: (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', | |||
| 568 | either (i) add an extra optional argument and give it an `interactive' | 542 | either (i) add an extra optional argument and give it an `interactive' |
| 569 | spec that specifies non-nil unconditionally (such as \"p\"); or (ii) | 543 | spec that specifies non-nil unconditionally (such as \"p\"); or (ii) |
| 570 | use `called-interactively-p'. */) | 544 | use `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 | |||
| 594 | cleaner to give your function an extra optional argument whose | 568 | cleaner 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 |
| 596 | way to do this), or via (not (or executing-kbd-macro noninteractive)). */) | 570 | way 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 | ||
| 611 | int | 584 | int |
| 612 | interactive_p (exclude_subrs_p) | 585 | interactive_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, | |||
| 657 | The definition is (lambda ARGLIST [DOCSTRING] BODY...). | 629 | The definition is (lambda ARGLIST [DOCSTRING] BODY...). |
| 658 | See also the function `interactive'. | 630 | See also the function `interactive'. |
| 659 | usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */) | 631 | usage: (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 | ||
| 703 | usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) | 674 | usage: (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 | |||
| 760 | itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not, | 730 | itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not, |
| 761 | then the value of BASE-VARIABLE is set to that of NEW-ALIAS. | 731 | then the value of BASE-VARIABLE is set to that of NEW-ALIAS. |
| 762 | The return value is BASE-VARIABLE. */) | 732 | The 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 | |||
| 832 | for these variables. \(`defconst' and `defcustom' behave similarly in | 801 | for these variables. \(`defconst' and `defcustom' behave similarly in |
| 833 | this respect.) | 802 | this respect.) |
| 834 | usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) | 803 | usage: (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 | |||
| 905 | value. However, you should normally not make local bindings for | 873 | value. However, you should normally not make local bindings for |
| 906 | variables defined with this form. | 874 | variables defined with this form. |
| 907 | usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) | 875 | usage: (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. */ |
| 934 | static Lisp_Object | 901 | static Lisp_Object |
| 935 | user_variable_p_eh (ignore) | 902 | user_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. |
| 956 | Return nil if VARIABLE is an alias and there is a loop in the | 922 | Return nil if VARIABLE is an alias and there is a loop in the |
| 957 | chain of symbols. */) | 923 | chain 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) | |||
| 1003 | or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). | 968 | or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). |
| 1004 | Each VALUEFORM can refer to the symbols already bound by this VARLIST. | 969 | Each VALUEFORM can refer to the symbols already bound by this VARLIST. |
| 1005 | usage: (let* VARLIST BODY...) */) | 970 | usage: (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) | |||
| 1040 | or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). | 1004 | or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). |
| 1041 | All the VALUEFORMs are evalled before any symbols are bound. | 1005 | All the VALUEFORMs are evalled before any symbols are bound. |
| 1042 | usage: (let VARLIST BODY...) */) | 1006 | usage: (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, | |||
| 1094 | The order of execution is thus TEST, BODY, TEST, BODY and so on | 1059 | The order of execution is thus TEST, BODY, TEST, BODY and so on |
| 1095 | until TEST returns nil. | 1060 | until TEST returns nil. |
| 1096 | usage: (while TEST BODY...) */) | 1061 | usage: (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 | ||
| 1123 | The second optional arg ENVIRONMENT specifies an environment of macro | 1087 | The second optional arg ENVIRONMENT specifies an environment of macro |
| 1124 | definitions to shadow the loaded ones for use in file byte-compilation. */) | 1088 | definitions 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'. | |||
| 1202 | If no throw happens, `catch' returns the value of the last BODY form. | 1164 | If no throw happens, `catch' returns the value of the last BODY form. |
| 1203 | If a throw happens, it specifies the value to return from `catch'. | 1165 | If a throw happens, it specifies the value to return from `catch'. |
| 1204 | usage: (catch TAG BODY...) */) | 1166 | usage: (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 | ||
| 1221 | Lisp_Object | 1182 | Lisp_Object |
| 1222 | internal_catch (tag, func, arg) | 1183 | internal_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 | ||
| 1269 | static void | 1227 | static void |
| 1270 | unwind_to_catch (catch, value) | 1228 | unwind_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) | |||
| 1321 | DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0, | 1277 | DEFUN ("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. |
| 1323 | Both TAG and VALUE are evalled. */) | 1279 | Both 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 | |||
| 1342 | after executing the UNWINDFORMS. | 1297 | after executing the UNWINDFORMS. |
| 1343 | If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway. | 1298 | If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway. |
| 1344 | usage: (unwind-protect BODYFORM UNWINDFORMS...) */) | 1299 | usage: (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. | |||
| 1377 | When a handler handles an error, control returns to the `condition-case' | 1331 | When a handler handles an error, control returns to the `condition-case' |
| 1378 | and it executes the handler's BODY... | 1332 | and it executes the handler's BODY... |
| 1379 | with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error. | 1333 | with 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.) |
| 1381 | Then the value of the last BODY form is returned from the `condition-case' | 1335 | Then the value of the last BODY form is returned from the `condition-case' |
| 1382 | expression. | 1336 | expression. |
| 1383 | 1337 | ||
| 1384 | See also the function `signal' for more info. | 1338 | See also the function `signal' for more info. |
| 1385 | usage: (condition-case VAR BODYFORM &rest HANDLERS) */) | 1339 | usage: (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 | ||
| 1402 | Lisp_Object | 1355 | Lisp_Object |
| 1403 | internal_lisp_condition_case (var, bodyform, handlers) | 1356 | internal_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 | ||
| 1471 | Lisp_Object | 1423 | Lisp_Object |
| 1472 | internal_condition_case (bfun, handlers, hfun) | 1424 | internal_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 | ||
| 1518 | Lisp_Object | 1468 | Lisp_Object |
| 1519 | internal_condition_case_1 (bfun, arg, handlers, hfun) | 1469 | internal_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 | ||
| 1663 | static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object, | 1610 | static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object, |
| 1664 | Lisp_Object, Lisp_Object)); | 1611 | Lisp_Object, Lisp_Object); |
| 1665 | 1612 | ||
| 1666 | DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, | 1613 | DEFUN ("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 | |||
| 1677 | error message is constructed. | 1624 | error message is constructed. |
| 1678 | If the signal is handled, DATA is made available to the handler. | 1625 | If the signal is handled, DATA is made available to the handler. |
| 1679 | See also the function `condition-case'. */) | 1626 | See 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 | ||
| 1792 | void | 1736 | void |
| 1793 | xsignal (error_symbol, data) | 1737 | xsignal (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 | ||
| 1802 | void | 1745 | void |
| 1803 | xsignal0 (error_symbol) | 1746 | xsignal0 (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 | ||
| 1809 | void | 1751 | void |
| 1810 | xsignal1 (error_symbol, arg) | 1752 | xsignal1 (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 | ||
| 1816 | void | 1757 | void |
| 1817 | xsignal2 (error_symbol, arg1, arg2) | 1758 | xsignal2 (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 | ||
| 1823 | void | 1763 | void |
| 1824 | xsignal3 (error_symbol, arg1, arg2, arg3) | 1764 | xsignal3 (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 | ||
| 1833 | void | 1772 | void |
| 1834 | signal_error (s, arg) | 1773 | signal_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 | ||
| 1864 | static int | 1801 | static int |
| 1865 | wants_debugger (list, conditions) | 1802 | wants_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 | ||
| 1889 | static int | 1825 | static int |
| 1890 | skip_debugger (conditions, data) | 1826 | skip_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 | ||
| 1927 | static int | 1862 | static int |
| 1928 | maybe_call_debugger (conditions, sig, data) | 1863 | maybe_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 | ||
| 1964 | static Lisp_Object | 1898 | static Lisp_Object |
| 1965 | find_handler_clause (handlers, conditions, sig, data) | 1899 | find_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 */ |
| 2058 | void | 1991 | void |
| 2059 | error (m, a1, a2, a3) | 1992 | verror (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 */ | ||
| 2031 | void | ||
| 2032 | error (const char *m, ...) | ||
| 2033 | { | ||
| 2034 | va_list ap; | ||
| 2035 | va_start (ap, m); | ||
| 2036 | verror (m, ap); | ||
| 2037 | va_end (ap); | ||
| 2038 | } | ||
| 2098 | 2039 | ||
| 2099 | DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0, | 2040 | DEFUN ("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 | ||
| 2112 | If the optional argument FOR-CALL-INTERACTIVELY is non-nil, | 2053 | If the optional argument FOR-CALL-INTERACTIVELY is non-nil, |
| 2113 | then strings and vectors are not accepted. */) | 2054 | then 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. | |||
| 2176 | They default to nil. | 2116 | They default to nil. |
| 2177 | If FUNCTION is already defined other than as an autoload, | 2117 | If FUNCTION is already defined other than as an autoload, |
| 2178 | this does nothing and returns nil. */) | 2118 | this 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 | ||
| 2207 | Lisp_Object | 2146 | Lisp_Object |
| 2208 | un_autoload (oldqueue) | 2147 | un_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 | ||
| 2235 | void | 2173 | void |
| 2236 | do_autoload (fundef, funname) | 2174 | do_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 | ||
| 2281 | DEFUN ("eval", Feval, Seval, 1, 1, 0, | 2218 | DEFUN ("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, | |||
| 2491 | Then return the value FUNCTION returns. | 2429 | Then return the value FUNCTION returns. |
| 2492 | Thus, (apply '+ 1 2 '(3 4)) returns 10. | 2430 | Thus, (apply '+ 1 2 '(3 4)) returns 10. |
| 2493 | usage: (apply FUNCTION &rest ARGUMENTS) */) | 2431 | usage: (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 | ||
| 2576 | enum run_hooks_condition {to_completion, until_success, until_failure}; | 2515 | enum run_hooks_condition {to_completion, until_success, until_failure}; |
| 2577 | static Lisp_Object run_hook_with_args P_ ((int, Lisp_Object *, | 2516 | static Lisp_Object run_hook_with_args (int, Lisp_Object *, |
| 2578 | enum run_hooks_condition)); | 2517 | enum run_hooks_condition); |
| 2579 | 2518 | ||
| 2580 | DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0, | 2519 | DEFUN ("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. | |||
| 2592 | Do not use `make-local-variable' to make a hook variable buffer-local. | 2531 | Do not use `make-local-variable' to make a hook variable buffer-local. |
| 2593 | Instead, use `add-hook' and specify t for the LOCAL argument. | 2532 | Instead, use `add-hook' and specify t for the LOCAL argument. |
| 2594 | usage: (run-hooks &rest HOOKS) */) | 2533 | usage: (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. | |||
| 2623 | Do not use `make-local-variable' to make a hook variable buffer-local. | 2560 | Do not use `make-local-variable' to make a hook variable buffer-local. |
| 2624 | Instead, use `add-hook' and specify t for the LOCAL argument. | 2561 | Instead, use `add-hook' and specify t for the LOCAL argument. |
| 2625 | usage: (run-hook-with-args HOOK &rest ARGS) */) | 2562 | usage: (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. | |||
| 2645 | Do not use `make-local-variable' to make a hook variable buffer-local. | 2580 | Do not use `make-local-variable' to make a hook variable buffer-local. |
| 2646 | Instead, use `add-hook' and specify t for the LOCAL argument. | 2581 | Instead, use `add-hook' and specify t for the LOCAL argument. |
| 2647 | usage: (run-hook-with-args-until-success HOOK &rest ARGS) */) | 2582 | usage: (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. | |||
| 2666 | Do not use `make-local-variable' to make a hook variable buffer-local. | 2599 | Do not use `make-local-variable' to make a hook variable buffer-local. |
| 2667 | Instead, use `add-hook' and specify t for the LOCAL argument. | 2600 | Instead, use `add-hook' and specify t for the LOCAL argument. |
| 2668 | usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */) | 2601 | usage: (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 | ||
| 2684 | static Lisp_Object | 2615 | static Lisp_Object |
| 2685 | run_hook_with_args (nargs, args, cond) | 2616 | run_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 | ||
| 2767 | Lisp_Object | 2695 | Lisp_Object |
| 2768 | run_hook_list_with_args (funlist, nargs, args) | 2696 | run_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 | ||
| 2812 | void | 2737 | void |
| 2813 | run_hook_with_args_2 (hook, arg1, arg2) | 2738 | run_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 */ |
| 2825 | Lisp_Object | 2749 | Lisp_Object |
| 2826 | apply1 (fn, arg) | 2750 | apply1 (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 */ |
| 2845 | Lisp_Object | 2768 | Lisp_Object |
| 2846 | call0 (fn) | 2769 | call0 (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 */ |
| 2857 | Lisp_Object | 2779 | Lisp_Object |
| 2858 | call1 (fn, arg1) | 2780 | call1 (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 */ |
| 2873 | Lisp_Object | 2794 | Lisp_Object |
| 2874 | call2 (fn, arg1, arg2) | 2795 | call2 (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 */ |
| 2889 | Lisp_Object | 2809 | Lisp_Object |
| 2890 | call3 (fn, arg1, arg2, arg3) | 2810 | call3 (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 */ |
| 2906 | Lisp_Object | 2825 | Lisp_Object |
| 2907 | call4 (fn, arg1, arg2, arg3, arg4) | 2826 | call4 (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 */ |
| 2924 | Lisp_Object | 2843 | Lisp_Object |
| 2925 | call5 (fn, arg1, arg2, arg3, arg4, arg5) | 2844 | call5 (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 */ |
| 2943 | Lisp_Object | 2862 | Lisp_Object |
| 2944 | call6 (fn, arg1, arg2, arg3, arg4, arg5, arg6) | 2863 | call6 (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 */ |
| 2963 | Lisp_Object | 2882 | Lisp_Object |
| 2964 | call7 (fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7) | 2883 | call7 (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, | |||
| 2986 | Return the value that function returns. | 2905 | Return the value that function returns. |
| 2987 | Thus, (funcall 'cons 'x 'y) returns (x . y). | 2906 | Thus, (funcall 'cons 'x 'y) returns (x . y). |
| 2988 | usage: (funcall FUNCTION &rest ARGUMENTS) */) | 2907 | usage: (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 | ||
| 3149 | Lisp_Object | 3066 | Lisp_Object |
| 3150 | apply_lambda (fun, args, eval_flag) | 3067 | apply_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 | ||
| 3198 | static Lisp_Object | 3115 | static Lisp_Object |
| 3199 | funcall_lambda (fun, nargs, arg_vector) | 3116 | funcall_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) | |||
| 3268 | DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, | 3182 | DEFUN ("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 | ||
| 3293 | void | 3206 | void |
| 3294 | grow_specpdl () | 3207 | grow_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 | ||
| 3326 | void | 3239 | void |
| 3327 | specbind (symbol, value) | 3240 | specbind (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 | ||
| 3425 | void | 3336 | void |
| 3426 | record_unwind_protect (function, arg) | 3337 | record_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 | ||
| 3440 | Lisp_Object | 3349 | Lisp_Object |
| 3441 | unbind_to (count, value) | 3350 | unbind_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) | |||
| 3506 | DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, | 3413 | DEFUN ("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. |
| 3508 | The debugger is entered when that frame exits, if the flag is non-nil. */) | 3415 | The 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. */) | |||
| 3528 | DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "", | 3434 | DEFUN ("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. |
| 3530 | Output stream used is value of `standard-output'. */) | 3436 | Output 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. | |||
| 3593 | FUNCTION is whatever was supplied as car of evaluated list, | 3498 | FUNCTION is whatever was supplied as car of evaluated list, |
| 3594 | or a lambda expression for macro calls. | 3499 | or a lambda expression for macro calls. |
| 3595 | If NFRAMES is more than the number of frames, the value is nil. */) | 3500 | If 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 | ||
| 3625 | void | 3529 | void |
| 3626 | mark_backtrace () | 3530 | mark_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 | ||
| 3644 | void | 3548 | void |
| 3645 | syms_of_eval () | 3549 | syms_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. |