1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
20
21
22 #include <config.h>
23 #include <setjmp.h>
24 #include "lisp.h"
25 #include "blockinput.h"
26 #include "commands.h"
27 #include "keyboard.h"
28 #include "dispextern.h"
29 #include "frame.h"
30
31 #if HAVE_X_WINDOWS
32 #include "xterm.h"
33 #endif
34
35
36
37
38 struct backtrace
39 {
40 struct backtrace *next;
41 Lisp_Object *function;
42 Lisp_Object *args;
43 int nargs; 44 45
46 char evalargs;
47
48 char debug_on_exit;
49 };
50
51 struct backtrace *backtrace_list;
52
53 struct catchtag *catchlist;
54
55 #ifdef DEBUG_GCPRO
56
57 int gcpro_level;
58 #endif
59
60 Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
61 Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
62 Lisp_Object Qand_rest, Qand_optional;
63 Lisp_Object Qdebug_on_error;
64 Lisp_Object Qdeclare;
65 Lisp_Object Qdebug;
66 extern Lisp_Object Qinteractive_form;
67
68 69 70
71
72 Lisp_Object Vrun_hooks;
73
74 75 76 77
78
79 Lisp_Object Vautoload_queue;
80
81
82
83 int specpdl_size;
84
85
86
87 struct specbinding *specpdl;
88
89
90
91 struct specbinding *specpdl_ptr;
92
93
94
95 EMACS_INT max_specpdl_size;
96
97
98
99 int lisp_eval_depth;
100
101
102
103 EMACS_INT max_lisp_eval_depth;
104
105
106
107 int debug_on_next_call;
108
109 110 111
112
113 int debugger_may_continue;
114
115 116
117
118 Lisp_Object Vstack_trace_on_error;
119
120 121
122
123 Lisp_Object Vdebug_on_error;
124
125 126
127
128 Lisp_Object Vdebug_ignored_errors;
129
130
131
132 Lisp_Object Vdebug_on_signal;
133
134
135
136 Lisp_Object Vsignal_hook_function;
137
138 139
140
141 int debug_on_quit;
142
143 144 145 146 147 148
149
150 int when_entered_debugger;
151
152 Lisp_Object Vdebugger;
153
154 155
156
157 Lisp_Object Vsignaling_function;
158
159 160 161
162
163 int handling_signal;
164
165
166
167 Lisp_Object Vmacro_declaration_function;
168
169 extern Lisp_Object Qrisky_local_variable;
170
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 178 179
180 Lisp_Object apply1 () __attribute__((noinline));
181 Lisp_Object call2 () __attribute__((noinline));
182 #endif
183
184 void
185 init_eval_once ()
186 {
187 specpdl_size = 50;
188 specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
189 specpdl_ptr = specpdl;
190
191 max_specpdl_size = 1000;
192 max_lisp_eval_depth = 500;
193
194 Vrun_hooks = Qnil;
195 }
196
197 void
198 init_eval ()
199 {
200 specpdl_ptr = specpdl;
201 catchlist = 0;
202 handlerlist = 0;
203 backtrace_list = 0;
204 Vquit_flag = Qnil;
205 debug_on_next_call = 0;
206 lisp_eval_depth = 0;
207 #ifdef DEBUG_GCPRO
208 gcpro_level = 0;
209 #endif
210
211 when_entered_debugger = -1;
212 }
213
214
215
216 static Lisp_Object
217 restore_stack_limits (data)
218 Lisp_Object data;
219 {
220 max_specpdl_size = XINT (XCAR (data));
221 max_lisp_eval_depth = XINT (XCDR (data));
222 return Qnil;
223 }
224
225
226
227 Lisp_Object
228 call_debugger (arg)
229 Lisp_Object arg;
230 {
231 int debug_while_redisplaying;
232 int count = SPECPDL_INDEX ();
233 Lisp_Object val;
234 int old_max = max_specpdl_size;
235
236 237
238
239 max_specpdl_size += 1;
240 record_unwind_protect (restore_stack_limits,
241 Fcons (make_number (old_max),
242 make_number (max_lisp_eval_depth)));
243 max_specpdl_size = old_max;
244
245 if (lisp_eval_depth + 40 > max_lisp_eval_depth)
246 max_lisp_eval_depth = lisp_eval_depth + 40;
247
248 if (SPECPDL_INDEX () + 100 > max_specpdl_size)
249 max_specpdl_size = SPECPDL_INDEX () + 100;
250
251 #ifdef HAVE_WINDOW_SYSTEM
252 if (display_hourglass_p)
253 cancel_hourglass ();
254 #endif
255
256 debug_on_next_call = 0;
257 when_entered_debugger = num_nonmacro_input_events;
258
259 260
261 debug_while_redisplaying = redisplaying_p;
262 redisplaying_p = 0;
263 specbind (intern ("debugger-may-continue"),
264 debug_while_redisplaying ? Qnil : Qt);
265 specbind (Qinhibit_redisplay, Qnil);
266 specbind (Qdebug_on_error, Qnil);
267
268 #if 0 269
270 specbind (Qinhibit_eval_during_redisplay, Qt);
271 #endif
272
273 val = apply1 (Vdebugger, arg);
274
275 276 277
278 if (debug_while_redisplaying)
279 Ftop_level ();
280
281 return unbind_to (count, val);
282 }
283
284 void
285 do_debug_on_call (code)
286 Lisp_Object code;
287 {
288 debug_on_next_call = 0;
289 backtrace_list->debug_on_exit = 1;
290 call_debugger (Fcons (code, Qnil));
291 }
292
293 294 295
296
297 DEFUN ("or", For, Sor, 0, UNEVALLED, 0,
298 doc: 299 300 301 )
302 (args)
303 Lisp_Object args;
304 {
305 register Lisp_Object val = Qnil;
306 struct gcpro gcpro1;
307
308 GCPRO1 (args);
309
310 while (CONSP (args))
311 {
312 val = Feval (XCAR (args));
313 if (!NILP (val))
314 break;
315 args = XCDR (args);
316 }
317
318 UNGCPRO;
319 return val;
320 }
321
322 DEFUN ("and", Fand, Sand, 0, UNEVALLED, 0,
323 doc: 324 325 326 )
327 (args)
328 Lisp_Object args;
329 {
330 register Lisp_Object val = Qt;
331 struct gcpro gcpro1;
332
333 GCPRO1 (args);
334
335 while (CONSP (args))
336 {
337 val = Feval (XCAR (args));
338 if (NILP (val))
339 break;
340 args = XCDR (args);
341 }
342
343 UNGCPRO;
344 return val;
345 }
346
347 DEFUN ("if", Fif, Sif, 2, UNEVALLED, 0,
348 doc: 349 350 351 352 )
353 (args)
354 Lisp_Object args;
355 {
356 register Lisp_Object cond;
357 struct gcpro gcpro1;
358
359 GCPRO1 (args);
360 cond = Feval (Fcar (args));
361 UNGCPRO;
362
363 if (!NILP (cond))
364 return Feval (Fcar (Fcdr (args)));
365 return Fprogn (Fcdr (Fcdr (args)));
366 }
367
368 DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0,
369 doc: 370 371 372 373 374 375 376 377 )
378 (args)
379 Lisp_Object args;
380 {
381 register Lisp_Object clause, val;
382 struct gcpro gcpro1;
383
384 val = Qnil;
385 GCPRO1 (args);
386 while (!NILP (args))
387 {
388 clause = Fcar (args);
389 val = Feval (Fcar (clause));
390 if (!NILP (val))
391 {
392 if (!EQ (XCDR (clause), Qnil))
393 val = Fprogn (XCDR (clause));
394 break;
395 }
396 args = XCDR (args);
397 }
398 UNGCPRO;
399
400 return val;
401 }
402
403 DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
404 doc: 405 )
406 (args)
407 Lisp_Object args;
408 {
409 register Lisp_Object val = Qnil;
410 struct gcpro gcpro1;
411
412 GCPRO1 (args);
413
414 while (CONSP (args))
415 {
416 val = Feval (XCAR (args));
417 args = XCDR (args);
418 }
419
420 UNGCPRO;
421 return val;
422 }
423
424 DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0,
425 doc: 426 427 428 )
429 (args)
430 Lisp_Object args;
431 {
432 Lisp_Object val;
433 register Lisp_Object args_left;
434 struct gcpro gcpro1, gcpro2;
435 register int argnum = 0;
436
437 if (NILP (args))
438 return Qnil;
439
440 args_left = args;
441 val = Qnil;
442 GCPRO2 (args, val);
443
444 do
445 {
446 if (!(argnum++))
447 val = Feval (Fcar (args_left));
448 else
449 Feval (Fcar (args_left));
450 args_left = Fcdr (args_left);
451 }
452 while (!NILP(args_left));
453
454 UNGCPRO;
455 return val;
456 }
457
458 DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0,
459 doc: 460 461 462 )
463 (args)
464 Lisp_Object args;
465 {
466 Lisp_Object val;
467 register Lisp_Object args_left;
468 struct gcpro gcpro1, gcpro2;
469 register int argnum = -1;
470
471 val = Qnil;
472
473 if (NILP (args))
474 return Qnil;
475
476 args_left = args;
477 val = Qnil;
478 GCPRO2 (args, val);
479
480 do
481 {
482 if (!(argnum++))
483 val = Feval (Fcar (args_left));
484 else
485 Feval (Fcar (args_left));
486 args_left = Fcdr (args_left);
487 }
488 while (!NILP (args_left));
489
490 UNGCPRO;
491 return val;
492 }
493
494 DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0,
495 doc: 496 497 498 499 500 501 502 )
503 (args)
504 Lisp_Object args;
505 {
506 register Lisp_Object args_left;
507 register Lisp_Object val, sym;
508 struct gcpro gcpro1;
509
510 if (NILP (args))
511 return Qnil;
512
513 args_left = args;
514 GCPRO1 (args);
515
516 do
517 {
518 val = Feval (Fcar (Fcdr (args_left)));
519 sym = Fcar (args_left);
520 Fset (sym, val);
521 args_left = Fcdr (Fcdr (args_left));
522 }
523 while (!NILP(args_left));
524
525 UNGCPRO;
526 return val;
527 }
528
529 DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0,
530 doc: 531 )
532 (args)
533 Lisp_Object args;
534 {
535 if (!NILP (Fcdr (args)))
536 xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args));
537 return Fcar (args);
538 }
539
540 DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
541 doc: 542 543 544 )
545 (args)
546 Lisp_Object args;
547 {
548 if (!NILP (Fcdr (args)))
549 xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
550 return Fcar (args);
551 }
552
553
554 DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
555 doc: 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 )
571 ()
572 {
573 return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil;
574 }
575
576
577 DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 1, 0,
578 doc: 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 )
597 (kind)
598 Lisp_Object kind;
599 {
600 return ((INTERACTIVE || !EQ (kind, intern ("interactive")))
601 && interactive_p (1)) ? Qt : Qnil;
602 }
603
604
605 606 607 608 609
610
611 int
612 interactive_p (exclude_subrs_p)
613 int exclude_subrs_p;
614 {
615 struct backtrace *btp;
616 Lisp_Object fun;
617
618 btp = backtrace_list;
619
620 621
622 fun = Findirect_function (*btp->function, Qnil);
623 if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p
624 || XSUBR (fun) == &Scalled_interactively_p))
625 btp = btp->next;
626
627 628 629 630 631 632 633
634 while (btp
635 && (EQ (*btp->function, Qbytecode)
636 || btp->nargs == UNEVALLED))
637 btp = btp->next;
638
639 640 641 642
643 fun = Findirect_function (*btp->function, Qnil);
644 if (exclude_subrs_p && SUBRP (fun))
645 return 0;
646
647 648
649 if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
650 return 1;
651 return 0;
652 }
653
654
655 DEFUN ("defun", Fdefun, Sdefun, 2, UNEVALLED, 0,
656 doc: 657 658 659 )
660 (args)
661 Lisp_Object args;
662 {
663 register Lisp_Object fn_name;
664 register Lisp_Object defn;
665
666 fn_name = Fcar (args);
667 CHECK_SYMBOL (fn_name);
668 defn = Fcons (Qlambda, Fcdr (args));
669 if (!NILP (Vpurify_flag))
670 defn = Fpurecopy (defn);
671 if (CONSP (XSYMBOL (fn_name)->function)
672 && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
673 LOADHIST_ATTACH (Fcons (Qt, fn_name));
674 Ffset (fn_name, defn);
675 LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
676 return fn_name;
677 }
678
679 DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0,
680 doc: 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 )
704 (args)
705 Lisp_Object args;
706 {
707 register Lisp_Object fn_name;
708 register Lisp_Object defn;
709 Lisp_Object lambda_list, doc, tail;
710
711 fn_name = Fcar (args);
712 CHECK_SYMBOL (fn_name);
713 lambda_list = Fcar (Fcdr (args));
714 tail = Fcdr (Fcdr (args));
715
716 doc = Qnil;
717 if (STRINGP (Fcar (tail)))
718 {
719 doc = XCAR (tail);
720 tail = XCDR (tail);
721 }
722
723 while (CONSP (Fcar (tail))
724 && EQ (Fcar (Fcar (tail)), Qdeclare))
725 {
726 if (!NILP (Vmacro_declaration_function))
727 {
728 struct gcpro gcpro1;
729 GCPRO1 (args);
730 call2 (Vmacro_declaration_function, fn_name, Fcar (tail));
731 UNGCPRO;
732 }
733
734 tail = Fcdr (tail);
735 }
736
737 if (NILP (doc))
738 tail = Fcons (lambda_list, tail);
739 else
740 tail = Fcons (lambda_list, Fcons (doc, tail));
741 defn = Fcons (Qmacro, Fcons (Qlambda, tail));
742
743 if (!NILP (Vpurify_flag))
744 defn = Fpurecopy (defn);
745 if (CONSP (XSYMBOL (fn_name)->function)
746 && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
747 LOADHIST_ATTACH (Fcons (Qt, fn_name));
748 Ffset (fn_name, defn);
749 LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
750 return fn_name;
751 }
752
753
754 DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
755 doc: 756 757 758 759 760 761 762 )
763 (new_alias, base_variable, docstring)
764 Lisp_Object new_alias, base_variable, docstring;
765 {
766 struct Lisp_Symbol *sym;
767
768 CHECK_SYMBOL (new_alias);
769 CHECK_SYMBOL (base_variable);
770
771 sym = XSYMBOL (new_alias);
772
773 if (sym->constant)
774
775 error ("Cannot make a constant an alias");
776
777 switch (sym->redirect)
778 {
779 case SYMBOL_FORWARDED:
780 error ("Cannot make an internal variable an alias");
781 case SYMBOL_LOCALIZED:
782 error ("Don't know how to make a localized variable an alias");
783 }
784
785 786 787 788
789 if (NILP (Fboundp (base_variable)))
790 set_internal (base_variable, find_symbol_value (new_alias), Qnil, 1);
791
792 {
793 struct specbinding *p;
794
795 for (p = specpdl_ptr - 1; p >= specpdl; p--)
796 if (p->func == NULL
797 && (EQ (new_alias,
798 CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol)))
799 error ("Don't know how to make a let-bound variable an alias");
800 }
801
802 sym->redirect = SYMBOL_VARALIAS;
803 SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
804 sym->constant = SYMBOL_CONSTANT_P (base_variable);
805 LOADHIST_ATTACH (new_alias);
806
807 Fput (new_alias, Qvariable_documentation, docstring);
808
809 return base_variable;
810 }
811
812
813 DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0,
814 doc: 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 )
835 (args)
836 Lisp_Object args;
837 {
838 register Lisp_Object sym, tem, tail;
839
840 sym = Fcar (args);
841 tail = Fcdr (args);
842 if (!NILP (Fcdr (Fcdr (tail))))
843 error ("Too many arguments");
844
845 tem = Fdefault_boundp (sym);
846 if (!NILP (tail))
847 {
848 if (SYMBOL_CONSTANT_P (sym))
849 {
850
851 Lisp_Object tem = Fcar (tail);
852 if (! (CONSP (tem)
853 && EQ (XCAR (tem), Qquote)
854 && CONSP (XCDR (tem))
855 && EQ (XCAR (XCDR (tem)), sym)))
856 error ("Constant symbol `%s' specified in defvar",
857 SDATA (SYMBOL_NAME (sym)));
858 }
859
860 if (NILP (tem))
861 Fset_default (sym, Feval (Fcar (tail)));
862 else
863 { 864
865 volatile struct specbinding *pdl = specpdl_ptr;
866 while (--pdl >= specpdl)
867 {
868 if (EQ (pdl->symbol, sym) && !pdl->func
869 && EQ (pdl->old_value, Qunbound))
870 {
871 message_with_string ("Warning: defvar ignored because %s is let-bound",
872 SYMBOL_NAME (sym), 1);
873 break;
874 }
875 }
876 }
877 tail = Fcdr (tail);
878 tem = Fcar (tail);
879 if (!NILP (tem))
880 {
881 if (!NILP (Vpurify_flag))
882 tem = Fpurecopy (tem);
883 Fput (sym, Qvariable_documentation, tem);
884 }
885 LOADHIST_ATTACH (sym);
886 }
887 else
888 889 890
891 ;
892
893 return sym;
894 }
895
896 DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0,
897 doc: 898 899 900 901 902 903 904 905 906 907 )
908 (args)
909 Lisp_Object args;
910 {
911 register Lisp_Object sym, tem;
912
913 sym = Fcar (args);
914 if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
915 error ("Too many arguments");
916
917 tem = Feval (Fcar (Fcdr (args)));
918 if (!NILP (Vpurify_flag))
919 tem = Fpurecopy (tem);
920 Fset_default (sym, tem);
921 tem = Fcar (Fcdr (Fcdr (args)));
922 if (!NILP (tem))
923 {
924 if (!NILP (Vpurify_flag))
925 tem = Fpurecopy (tem);
926 Fput (sym, Qvariable_documentation, tem);
927 }
928 Fput (sym, Qrisky_local_variable, Qt);
929 LOADHIST_ATTACH (sym);
930 return sym;
931 }
932
933
934 static Lisp_Object
935 user_variable_p_eh (ignore)
936 Lisp_Object ignore;
937 {
938 return Qnil;
939 }
940
941 static Lisp_Object
942 lisp_indirect_variable (Lisp_Object sym)
943 {
944 XSETSYMBOL (sym, indirect_variable (XSYMBOL (sym)));
945 return sym;
946 }
947
948 DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0,
949 doc: 950 951 952 953 954 955 956 957 )
958 (variable)
959 Lisp_Object variable;
960 {
961 Lisp_Object documentation;
962
963 if (!SYMBOLP (variable))
964 return Qnil;
965
966
967 if (XSYMBOL (variable)->redirect == SYMBOL_VARALIAS
968 && NILP (internal_condition_case_1 (lisp_indirect_variable, variable,
969 Qt, user_variable_p_eh)))
970 return Qnil;
971
972 while (1)
973 {
974 documentation = Fget (variable, Qvariable_documentation);
975 if (INTEGERP (documentation) && XINT (documentation) < 0)
976 return Qt;
977 if (STRINGP (documentation)
978 && ((unsigned char) SREF (documentation, 0) == '*'))
979 return Qt;
980
981 if (CONSP (documentation)
982 && STRINGP (XCAR (documentation))
983 && INTEGERP (XCDR (documentation))
984 && XINT (XCDR (documentation)) < 0)
985 return Qt;
986
987 if ((!NILP (Fget (variable, intern ("standard-value"))))
988 || (!NILP (Fget (variable, intern ("custom-autoload")))))
989 return Qt;
990
991 if (!(XSYMBOL (variable)->redirect == SYMBOL_VARALIAS))
992 return Qnil;
993
994
995 XSETSYMBOL (variable, SYMBOL_ALIAS (XSYMBOL (variable)));
996 }
997 }
998
999 DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,
1000 doc: 1001 1002 1003 1004 1005 )
1006 (args)
1007 Lisp_Object args;
1008 {
1009 Lisp_Object varlist, val, elt;
1010 int count = SPECPDL_INDEX ();
1011 struct gcpro gcpro1, gcpro2, gcpro3;
1012
1013 GCPRO3 (args, elt, varlist);
1014
1015 varlist = Fcar (args);
1016 while (!NILP (varlist))
1017 {
1018 QUIT;
1019 elt = Fcar (varlist);
1020 if (SYMBOLP (elt))
1021 specbind (elt, Qnil);
1022 else if (! NILP (Fcdr (Fcdr (elt))))
1023 signal_error ("`let' bindings can have only one value-form", elt);
1024 else
1025 {
1026 val = Feval (Fcar (Fcdr (elt)));
1027 specbind (Fcar (elt), val);
1028 }
1029 varlist = Fcdr (varlist);
1030 }
1031 UNGCPRO;
1032 val = Fprogn (Fcdr (args));
1033 return unbind_to (count, val);
1034 }
1035
1036 DEFUN ("let", Flet, Slet, 1, UNEVALLED, 0,
1037 doc: 1038 1039 1040 1041 1042 )
1043 (args)
1044 Lisp_Object args;
1045 {
1046 Lisp_Object *temps, tem;
1047 register Lisp_Object elt, varlist;
1048 int count = SPECPDL_INDEX ();
1049 register int argnum;
1050 struct gcpro gcpro1, gcpro2;
1051
1052 varlist = Fcar (args);
1053
1054
1055 elt = Flength (varlist);
1056 temps = (Lisp_Object *) alloca (XFASTINT (elt) * sizeof (Lisp_Object));
1057
1058
1059
1060 GCPRO2 (args, *temps);
1061 gcpro2.nvars = 0;
1062
1063 for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
1064 {
1065 QUIT;
1066 elt = XCAR (varlist);
1067 if (SYMBOLP (elt))
1068 temps [argnum++] = Qnil;
1069 else if (! NILP (Fcdr (Fcdr (elt))))
1070 signal_error ("`let' bindings can have only one value-form", elt);
1071 else
1072 temps [argnum++] = Feval (Fcar (Fcdr (elt)));
1073 gcpro2.nvars = argnum;
1074 }
1075 UNGCPRO;
1076
1077 varlist = Fcar (args);
1078 for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
1079 {
1080 elt = XCAR (varlist);
1081 tem = temps[argnum++];
1082 if (SYMBOLP (elt))
1083 specbind (elt, tem);
1084 else
1085 specbind (Fcar (elt), tem);
1086 }
1087
1088 elt = Fprogn (Fcdr (args));
1089 return unbind_to (count, elt);
1090 }
1091
1092 DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0,
1093 doc: 1094 1095 1096 )
1097 (args)
1098 Lisp_Object args;
1099 {
1100 Lisp_Object test, body;
1101 struct gcpro gcpro1, gcpro2;
1102
1103 GCPRO2 (test, body);
1104
1105 test = Fcar (args);
1106 body = Fcdr (args);
1107 while (!NILP (Feval (test)))
1108 {
1109 QUIT;
1110 Fprogn (body);
1111 }
1112
1113 UNGCPRO;
1114 return Qnil;
1115 }
1116
1117 DEFUN ("macroexpand", Fmacroexpand, Smacroexpand, 1, 2, 0,
1118 doc: 1119 1120 1121 1122 1123 1124 )
1125 (form, environment)
1126 Lisp_Object form;
1127 Lisp_Object environment;
1128 {
1129
1130 register Lisp_Object expander, sym, def, tem;
1131
1132 while (1)
1133 {
1134 1135
1136 if (!CONSP (form))
1137 break;
1138
1139 def = sym = XCAR (form);
1140 tem = Qnil;
1141 1142
1143 while (SYMBOLP (def))
1144 {
1145 QUIT;
1146 sym = def;
1147 tem = Fassq (sym, environment);
1148 if (NILP (tem))
1149 {
1150 def = XSYMBOL (sym)->function;
1151 if (!EQ (def, Qunbound))
1152 continue;
1153 }
1154 break;
1155 }
1156 1157
1158 if (NILP (tem))
1159 {
1160 1161
1162 if (EQ (def, Qunbound) || !CONSP (def))
1163
1164 break;
1165 if (EQ (XCAR (def), Qautoload))
1166 {
1167
1168 tem = Fnth (make_number (4), def);
1169 if (EQ (tem, Qt) || EQ (tem, Qmacro))
1170
1171 {
1172 struct gcpro gcpro1;
1173 GCPRO1 (form);
1174 do_autoload (def, sym);
1175 UNGCPRO;
1176 continue;
1177 }
1178 else
1179 break;
1180 }
1181 else if (!EQ (XCAR (def), Qmacro))
1182 break;
1183 else expander = XCDR (def);
1184 }
1185 else
1186 {
1187 expander = XCDR (tem);
1188 if (NILP (expander))
1189 break;
1190 }
1191 form = apply1 (expander, XCDR (form));
1192 }
1193 return form;
1194 }
1195
1196 DEFUN ("catch", Fcatch, Scatch, 1, UNEVALLED, 0,
1197 doc: 1198 1199 1200 1201 1202 1203 1204 )
1205 (args)
1206 Lisp_Object args;
1207 {
1208 register Lisp_Object tag;
1209 struct gcpro gcpro1;
1210
1211 GCPRO1 (args);
1212 tag = Feval (Fcar (args));
1213 UNGCPRO;
1214 return internal_catch (tag, Fprogn, Fcdr (args));
1215 }
1216
1217 1218 1219
1220
1221 Lisp_Object
1222 internal_catch (tag, func, arg)
1223 Lisp_Object tag;
1224 Lisp_Object (*func) ();
1225 Lisp_Object arg;
1226 {
1227
1228 struct catchtag c;
1229
1230
1231 c.next = catchlist;
1232 c.tag = tag;
1233 c.val = Qnil;
1234 c.backlist = backtrace_list;
1235 c.handlerlist = handlerlist;
1236 c.lisp_eval_depth = lisp_eval_depth;
1237 c.pdlcount = SPECPDL_INDEX ();
1238 c.poll_suppress_count = poll_suppress_count;
1239 c.interrupt_input_blocked = interrupt_input_blocked;
1240 c.gcpro = gcprolist;
1241 c.byte_stack = byte_stack_list;
1242 catchlist = &c;
1243
1244
1245 if (! _setjmp (c.jmp))
1246 c.val = (*func) (arg);
1247
1248
1249 catchlist = c.next;
1250 return c.val;
1251 }
1252
1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267
1268
1269 static void
1270 unwind_to_catch (catch, value)
1271 struct catchtag *catch;
1272 Lisp_Object value;
1273 {
1274 register int last_time;
1275
1276
1277 catch->val = value;
1278
1279
1280 set_poll_suppress_count (catch->poll_suppress_count);
1281 UNBLOCK_INPUT_TO (catch->interrupt_input_blocked);
1282 handling_signal = 0;
1283 immediate_quit = 0;
1284
1285 do
1286 {
1287 last_time = catchlist == catch;
1288
1289 1290
1291 unbind_to (catchlist->pdlcount, Qnil);
1292 handlerlist = catchlist->handlerlist;
1293 catchlist = catchlist->next;
1294 }
1295 while (! last_time);
1296
1297 #if HAVE_X_WINDOWS
1298 1299
1300 #if 0 1301 1302
1303 x_fully_uncatch_errors ();
1304 #endif
1305 #endif
1306
1307 byte_stack_list = catch->byte_stack;
1308 gcprolist = catch->gcpro;
1309 #ifdef DEBUG_GCPRO
1310 if (gcprolist != 0)
1311 gcpro_level = gcprolist->level + 1;
1312 else
1313 gcpro_level = 0;
1314 #endif
1315 backtrace_list = catch->backlist;
1316 lisp_eval_depth = catch->lisp_eval_depth;
1317
1318 _longjmp (catch->jmp, 1);
1319 }
1320
1321 DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
1322 doc: 1323 )
1324 (tag, value)
1325 register Lisp_Object tag, value;
1326 {
1327 register struct catchtag *c;
1328
1329 if (!NILP (tag))
1330 for (c = catchlist; c; c = c->next)
1331 {
1332 if (EQ (c->tag, tag))
1333 unwind_to_catch (c, value);
1334 }
1335 xsignal2 (Qno_catch, tag, value);
1336 }
1337
1338
1339 DEFUN ("unwind-protect", Funwind_protect, Sunwind_protect, 1, UNEVALLED, 0,
1340 doc: 1341 1342 1343 1344 )
1345 (args)
1346 Lisp_Object args;
1347 {
1348 Lisp_Object val;
1349 int count = SPECPDL_INDEX ();
1350
1351 record_unwind_protect (Fprogn, Fcdr (args));
1352 val = Feval (Fcar (args));
1353 return unbind_to (count, val);
1354 }
1355
1356 1357 1358 1359 1360
1361
1362 struct handler *handlerlist;
1363
1364 DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
1365 doc: 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 )
1386 (args)
1387 Lisp_Object args;
1388 {
1389 register Lisp_Object bodyform, handlers;
1390 volatile Lisp_Object var;
1391
1392 var = Fcar (args);
1393 bodyform = Fcar (Fcdr (args));
1394 handlers = Fcdr (Fcdr (args));
1395
1396 return internal_lisp_condition_case (var, bodyform, handlers);
1397 }
1398
1399 1400
1401
1402 Lisp_Object
1403 internal_lisp_condition_case (var, bodyform, handlers)
1404 volatile Lisp_Object var;
1405 Lisp_Object bodyform, handlers;
1406 {
1407 Lisp_Object val;
1408 struct catchtag c;
1409 struct handler h;
1410
1411 CHECK_SYMBOL (var);
1412
1413 for (val = handlers; CONSP (val); val = XCDR (val))
1414 {
1415 Lisp_Object tem;
1416 tem = XCAR (val);
1417 if (! (NILP (tem)
1418 || (CONSP (tem)
1419 && (SYMBOLP (XCAR (tem))
1420 || CONSP (XCAR (tem))))))
1421 error ("Invalid condition handler", tem);
1422 }
1423
1424 c.tag = Qnil;
1425 c.val = Qnil;
1426 c.backlist = backtrace_list;
1427 c.handlerlist = handlerlist;
1428 c.lisp_eval_depth = lisp_eval_depth;
1429 c.pdlcount = SPECPDL_INDEX ();
1430 c.poll_suppress_count = poll_suppress_count;
1431 c.interrupt_input_blocked = interrupt_input_blocked;
1432 c.gcpro = gcprolist;
1433 c.byte_stack = byte_stack_list;
1434 if (_setjmp (c.jmp))
1435 {
1436 if (!NILP (h.var))
1437 specbind (h.var, c.val);
1438 val = Fprogn (Fcdr (h.chosen_clause));
1439
1440 1441 1442
1443 unbind_to (c.pdlcount, Qnil);
1444 return val;
1445 }
1446 c.next = catchlist;
1447 catchlist = &c;
1448
1449 h.var = var;
1450 h.handler = handlers;
1451 h.next = handlerlist;
1452 h.tag = &c;
1453 handlerlist = &h;
1454
1455 val = Feval (bodyform);
1456 catchlist = c.next;
1457 handlerlist = h.next;
1458 return val;
1459 }
1460
1461 1462 1463 1464 1465 1466 1467 1468 1469
1470
1471 Lisp_Object
1472 internal_condition_case (bfun, handlers, hfun)
1473 Lisp_Object (*bfun) ();
1474 Lisp_Object handlers;
1475 Lisp_Object (*hfun) ();
1476 {
1477 Lisp_Object val;
1478 struct catchtag c;
1479 struct handler h;
1480
1481 1482
1483 #if HAVE_X_WINDOWS
1484 if (x_catching_errors ())
1485 abort ();
1486 #endif
1487
1488 c.tag = Qnil;
1489 c.val = Qnil;
1490 c.backlist = backtrace_list;
1491 c.handlerlist = handlerlist;
1492 c.lisp_eval_depth = lisp_eval_depth;
1493 c.pdlcount = SPECPDL_INDEX ();
1494 c.poll_suppress_count = poll_suppress_count;
1495 c.interrupt_input_blocked = interrupt_input_blocked;
1496 c.gcpro = gcprolist;
1497 c.byte_stack = byte_stack_list;
1498 if (_setjmp (c.jmp))
1499 {
1500 return (*hfun) (c.val);
1501 }
1502 c.next = catchlist;
1503 catchlist = &c;
1504 h.handler = handlers;
1505 h.var = Qnil;
1506 h.next = handlerlist;
1507 h.tag = &c;
1508 handlerlist = &h;
1509
1510 val = (*bfun) ();
1511 catchlist = c.next;
1512 handlerlist = h.next;
1513 return val;
1514 }
1515
1516
1517
1518 Lisp_Object
1519 internal_condition_case_1 (bfun, arg, handlers, hfun)
1520 Lisp_Object (*bfun) ();
1521 Lisp_Object arg;
1522 Lisp_Object handlers;
1523 Lisp_Object (*hfun) ();
1524 {
1525 Lisp_Object val;
1526 struct catchtag c;
1527 struct handler h;
1528
1529 1530
1531 #if HAVE_X_WINDOWS
1532 if (x_catching_errors ())
1533 abort ();
1534 #endif
1535
1536 c.tag = Qnil;
1537 c.val = Qnil;
1538 c.backlist = backtrace_list;
1539 c.handlerlist = handlerlist;
1540 c.lisp_eval_depth = lisp_eval_depth;
1541 c.pdlcount = SPECPDL_INDEX ();
1542 c.poll_suppress_count = poll_suppress_count;
1543 c.interrupt_input_blocked = interrupt_input_blocked;
1544 c.gcpro = gcprolist;
1545 c.byte_stack = byte_stack_list;
1546 if (_setjmp (c.jmp))
1547 {
1548 return (*hfun) (c.val);
1549 }
1550 c.next = catchlist;
1551 catchlist = &c;
1552 h.handler = handlers;
1553 h.var = Qnil;
1554 h.next = handlerlist;
1555 h.tag = &c;
1556 handlerlist = &h;
1557
1558 val = (*bfun) (arg);
1559 catchlist = c.next;
1560 handlerlist = h.next;
1561 return val;
1562 }
1563
1564 1565
1566
1567 Lisp_Object
1568 internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object),
1569 Lisp_Object arg1,
1570 Lisp_Object arg2,
1571 Lisp_Object handlers,
1572 Lisp_Object (*hfun) (Lisp_Object))
1573 {
1574 Lisp_Object val;
1575 struct catchtag c;
1576 struct handler h;
1577
1578 1579
1580 #if HAVE_X_WINDOWS
1581 if (x_catching_errors ())
1582 abort ();
1583 #endif
1584
1585 c.tag = Qnil;
1586 c.val = Qnil;
1587 c.backlist = backtrace_list;
1588 c.handlerlist = handlerlist;
1589 c.lisp_eval_depth = lisp_eval_depth;
1590 c.pdlcount = SPECPDL_INDEX ();
1591 c.poll_suppress_count = poll_suppress_count;
1592 c.interrupt_input_blocked = interrupt_input_blocked;
1593 c.gcpro = gcprolist;
1594 c.byte_stack = byte_stack_list;
1595 if (_setjmp (c.jmp))
1596 {
1597 return (*hfun) (c.val);
1598 }
1599 c.next = catchlist;
1600 catchlist = &c;
1601 h.handler = handlers;
1602 h.var = Qnil;
1603 h.next = handlerlist;
1604 h.tag = &c;
1605 handlerlist = &h;
1606
1607 val = (*bfun) (arg1, arg2);
1608 catchlist = c.next;
1609 handlerlist = h.next;
1610 return val;
1611 }
1612
1613 1614
1615
1616 Lisp_Object
1617 internal_condition_case_n (Lisp_Object (*bfun) (int, Lisp_Object*),
1618 int nargs,
1619 Lisp_Object *args,
1620 Lisp_Object handlers,
1621 Lisp_Object (*hfun) (Lisp_Object))
1622 {
1623 Lisp_Object val;
1624 struct catchtag c;
1625 struct handler h;
1626
1627 1628
1629 #if HAVE_X_WINDOWS
1630 if (x_catching_errors ())
1631 abort ();
1632 #endif
1633
1634 c.tag = Qnil;
1635 c.val = Qnil;
1636 c.backlist = backtrace_list;
1637 c.handlerlist = handlerlist;
1638 c.lisp_eval_depth = lisp_eval_depth;
1639 c.pdlcount = SPECPDL_INDEX ();
1640 c.poll_suppress_count = poll_suppress_count;
1641 c.interrupt_input_blocked = interrupt_input_blocked;
1642 c.gcpro = gcprolist;
1643 c.byte_stack = byte_stack_list;
1644 if (_setjmp (c.jmp))
1645 {
1646 return (*hfun) (c.val);
1647 }
1648 c.next = catchlist;
1649 catchlist = &c;
1650 h.handler = handlers;
1651 h.var = Qnil;
1652 h.next = handlerlist;
1653 h.tag = &c;
1654 handlerlist = &h;
1655
1656 val = (*bfun) (nargs, args);
1657 catchlist = c.next;
1658 handlerlist = h.next;
1659 return val;
1660 }
1661
1662
1663 static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object,
1664 Lisp_Object, Lisp_Object));
1665
1666 DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
1667 doc: 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 )
1680 (error_symbol, data)
1681 Lisp_Object error_symbol, data;
1682 {
1683 1684 1685
1686 register struct handler *allhandlers = handlerlist;
1687 Lisp_Object conditions;
1688 extern int gc_in_progress;
1689 extern int waiting_for_input;
1690 Lisp_Object string;
1691 Lisp_Object real_error_symbol;
1692 struct backtrace *bp;
1693
1694 immediate_quit = handling_signal = 0;
1695 abort_on_gc = 0;
1696 if (gc_in_progress || waiting_for_input)
1697 abort ();
1698
1699 if (NILP (error_symbol))
1700 real_error_symbol = Fcar (data);
1701 else
1702 real_error_symbol = error_symbol;
1703
1704 #if 0 1705
1706 #ifdef HAVE_WINDOW_SYSTEM
1707 if (display_hourglass_p)
1708 cancel_hourglass ();
1709 #endif
1710 #endif
1711
1712
1713 if (! NILP (Vsignal_hook_function)
1714 && ! NILP (error_symbol))
1715 {
1716
1717 if (lisp_eval_depth + 20 > max_lisp_eval_depth)
1718 max_lisp_eval_depth = lisp_eval_depth + 20;
1719
1720 if (SPECPDL_INDEX () + 40 > max_specpdl_size)
1721 max_specpdl_size = SPECPDL_INDEX () + 40;
1722
1723 call2 (Vsignal_hook_function, error_symbol, data);
1724 }
1725
1726 conditions = Fget (real_error_symbol, Qerror_conditions);
1727
1728 1729 1730 1731
1732 Vsignaling_function = Qnil;
1733 if (backtrace_list && !NILP (error_symbol))
1734 {
1735 bp = backtrace_list->next;
1736 if (bp && bp->function && EQ (*bp->function, Qerror))
1737 bp = bp->next;
1738 if (bp && bp->function)
1739 Vsignaling_function = *bp->function;
1740 }
1741
1742 for (; handlerlist; handlerlist = handlerlist->next)
1743 {
1744 register Lisp_Object clause;
1745
1746 clause = find_handler_clause (handlerlist->handler, conditions,
1747 error_symbol, data);
1748
1749 if (EQ (clause, Qlambda))
1750 {
1751 1752
1753 if (EQ (real_error_symbol, Qquit))
1754 return Qnil;
1755 else
1756 error ("Cannot return from the debugger in an error");
1757 }
1758
1759 if (!NILP (clause))
1760 {
1761 Lisp_Object unwind_data;
1762 struct handler *h = handlerlist;
1763
1764 handlerlist = allhandlers;
1765
1766 if (NILP (error_symbol))
1767 unwind_data = data;
1768 else
1769 unwind_data = Fcons (error_symbol, data);
1770 h->chosen_clause = clause;
1771 unwind_to_catch (h->tag, unwind_data);
1772 }
1773 }
1774
1775 handlerlist = allhandlers;
1776 1777
1778 find_handler_clause (Qerror, conditions, error_symbol, data);
1779 if (catchlist != 0)
1780 Fthrow (Qtop_level, Qt);
1781
1782 if (! NILP (error_symbol))
1783 data = Fcons (error_symbol, data);
1784
1785 string = Ferror_message_string (data);
1786 fatal ("%s", SDATA (string), 0);
1787 }
1788
1789 1790
1791
1792 void
1793 xsignal (error_symbol, data)
1794 Lisp_Object error_symbol, data;
1795 {
1796 Fsignal (error_symbol, data);
1797 abort ();
1798 }
1799
1800
1801
1802 void
1803 xsignal0 (error_symbol)
1804 Lisp_Object error_symbol;
1805 {
1806 xsignal (error_symbol, Qnil);
1807 }
1808
1809 void
1810 xsignal1 (error_symbol, arg)
1811 Lisp_Object error_symbol, arg;
1812 {
1813 xsignal (error_symbol, list1 (arg));
1814 }
1815
1816 void
1817 xsignal2 (error_symbol, arg1, arg2)
1818 Lisp_Object error_symbol, arg1, arg2;
1819 {
1820 xsignal (error_symbol, list2 (arg1, arg2));
1821 }
1822
1823 void
1824 xsignal3 (error_symbol, arg1, arg2, arg3)
1825 Lisp_Object error_symbol, arg1, arg2, arg3;
1826 {
1827 xsignal (error_symbol, list3 (arg1, arg2, arg3));
1828 }
1829
1830 1831
1832
1833 void
1834 signal_error (s, arg)
1835 char *s;
1836 Lisp_Object arg;
1837 {
1838 Lisp_Object tortoise, hare;
1839
1840 hare = tortoise = arg;
1841 while (CONSP (hare))
1842 {
1843 hare = XCDR (hare);
1844 if (!CONSP (hare))
1845 break;
1846
1847 hare = XCDR (hare);
1848 tortoise = XCDR (tortoise);
1849
1850 if (EQ (hare, tortoise))
1851 break;
1852 }
1853
1854 if (!NILP (hare))
1855 arg = Fcons (arg, Qnil);
1856
1857 xsignal (Qerror, Fcons (build_string (s), arg));
1858 }
1859
1860
1861 1862
1863
1864 static int
1865 wants_debugger (list, conditions)
1866 Lisp_Object list, conditions;
1867 {
1868 if (NILP (list))
1869 return 0;
1870 if (! CONSP (list))
1871 return 1;
1872
1873 while (CONSP (conditions))
1874 {
1875 Lisp_Object this, tail;
1876 this = XCAR (conditions);
1877 for (tail = list; CONSP (tail); tail = XCDR (tail))
1878 if (EQ (XCAR (tail), this))
1879 return 1;
1880 conditions = XCDR (conditions);
1881 }
1882 return 0;
1883 }
1884
1885 1886 1887
1888
1889 static int
1890 skip_debugger (conditions, data)
1891 Lisp_Object conditions, data;
1892 {
1893 Lisp_Object tail;
1894 int first_string = 1;
1895 Lisp_Object error_message;
1896
1897 error_message = Qnil;
1898 for (tail = Vdebug_ignored_errors; CONSP (tail); tail = XCDR (tail))
1899 {
1900 if (STRINGP (XCAR (tail)))
1901 {
1902 if (first_string)
1903 {
1904 error_message = Ferror_message_string (data);
1905 first_string = 0;
1906 }
1907
1908 if (fast_string_match (XCAR (tail), error_message) >= 0)
1909 return 1;
1910 }
1911 else
1912 {
1913 Lisp_Object contail;
1914
1915 for (contail = conditions; CONSP (contail); contail = XCDR (contail))
1916 if (EQ (XCAR (tail), XCAR (contail)))
1917 return 1;
1918 }
1919 }
1920
1921 return 0;
1922 }
1923
1924 1925
1926
1927 static int
1928 maybe_call_debugger (conditions, sig, data)
1929 Lisp_Object conditions, sig, data;
1930 {
1931 Lisp_Object combined_data;
1932
1933 combined_data = Fcons (sig, data);
1934
1935 if (
1936 1937
1938 ! INPUT_BLOCKED_P
1939
1940 && (EQ (sig, Qquit)
1941 ? debug_on_quit
1942 : wants_debugger (Vdebug_on_error, conditions))
1943 && ! skip_debugger (conditions, combined_data)
1944
1945 && when_entered_debugger < num_nonmacro_input_events)
1946 {
1947 call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil)));
1948 return 1;
1949 }
1950
1951 return 0;
1952 }
1953
1954 1955 1956 1957 1958 1959 1960 1961 1962
1963
1964 static Lisp_Object
1965 find_handler_clause (handlers, conditions, sig, data)
1966 Lisp_Object handlers, conditions, sig, data;
1967 {
1968 register Lisp_Object h;
1969 register Lisp_Object tem;
1970 int debugger_called = 0;
1971 int debugger_considered = 0;
1972
1973
1974 if (EQ (handlers, Qt))
1975 return Qt;
1976
1977 1978
1979 if (NILP (sig))
1980 debugger_considered = 1;
1981
1982 1983
1984 if (EQ (handlers, Qerror)
1985 || !NILP (Vdebug_on_signal)) 1986
1987 {
1988 if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions))
1989 {
1990 max_lisp_eval_depth += 15;
1991 max_specpdl_size++;
1992 if (noninteractive)
1993 Fbacktrace ();
1994 else
1995 internal_with_output_to_temp_buffer
1996 ("*Backtrace*",
1997 (Lisp_Object (*) (Lisp_Object)) Fbacktrace,
1998 Qnil);
1999 max_specpdl_size--;
2000 max_lisp_eval_depth -= 15;
2001 }
2002
2003 if (!debugger_considered)
2004 {
2005 debugger_considered = 1;
2006 debugger_called = maybe_call_debugger (conditions, sig, data);
2007 }
2008
2009
2010 if (EQ (handlers, Qerror))
2011 {
2012 if (debugger_called)
2013 return Qlambda;
2014 return Qt;
2015 }
2016 }
2017
2018 for (h = handlers; CONSP (h); h = Fcdr (h))
2019 {
2020 Lisp_Object handler, condit;
2021
2022 handler = Fcar (h);
2023 if (!CONSP (handler))
2024 continue;
2025 condit = Fcar (handler);
2026
2027 if (SYMBOLP (condit))
2028 {
2029 tem = Fmemq (Fcar (handler), conditions);
2030 if (!NILP (tem))
2031 return handler;
2032 }
2033
2034 else if (CONSP (condit))
2035 {
2036 Lisp_Object tail;
2037 for (tail = condit; CONSP (tail); tail = XCDR (tail))
2038 {
2039 tem = Fmemq (Fcar (tail), conditions);
2040 if (!NILP (tem))
2041 {
2042 2043
2044 if (! debugger_considered && !NILP (Fmemq (Qdebug, condit)))
2045 maybe_call_debugger (conditions, sig, data);
2046 return handler;
2047 }
2048 }
2049 }
2050 }
2051
2052 return Qnil;
2053 }
2054
2055
2056
2057
2058 void
2059 error (m, a1, a2, a3)
2060 char *m;
2061 char *a1, *a2, *a3;
2062 {
2063 char buf[200];
2064 int size = 200;
2065 int mlen;
2066 char *buffer = buf;
2067 char *args[3];
2068 int allocated = 0;
2069 Lisp_Object string;
2070
2071 args[0] = a1;
2072 args[1] = a2;
2073 args[2] = a3;
2074
2075 mlen = strlen (m);
2076
2077 while (1)
2078 {
2079 int used = doprnt (buffer, size, m, m + mlen, 3, args);
2080 if (used < size)
2081 break;
2082 size *= 2;
2083 if (allocated)
2084 buffer = (char *) xrealloc (buffer, size);
2085 else
2086 {
2087 buffer = (char *) xmalloc (size);
2088 allocated = 1;
2089 }
2090 }
2091
2092 string = build_string (buffer);
2093 if (allocated)
2094 xfree (buffer);
2095
2096 xsignal1 (Qerror, string);
2097 }
2098
2099 DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
2100 doc: 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 )
2114 (function, for_call_interactively)
2115 Lisp_Object function, for_call_interactively;
2116 {
2117 register Lisp_Object fun;
2118 register Lisp_Object funcar;
2119 Lisp_Object if_prop = Qnil;
2120
2121 fun = function;
2122
2123 fun = indirect_function (fun);
2124 if (NILP (fun) || EQ (fun, Qunbound))
2125 return Qnil;
2126
2127 2128
2129 fun = function;
2130 while (SYMBOLP (fun))
2131 {
2132 Lisp_Object tmp = Fget (fun, Qinteractive_form);
2133 if (!NILP (tmp))
2134 if_prop = Qt;
2135 fun = Fsymbol_function (fun);
2136 }
2137
2138 2139
2140 if (SUBRP (fun))
2141 return XSUBR (fun)->intspec ? Qt : if_prop;
2142
2143 2144 2145
2146 else if (COMPILEDP (fun))
2147 return ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE
2148 ? Qt : if_prop);
2149
2150
2151 if (STRINGP (fun) || VECTORP (fun))
2152 return (NILP (for_call_interactively) ? Qt : Qnil);
2153
2154
2155 if (!CONSP (fun))
2156 return Qnil;
2157 funcar = XCAR (fun);
2158 if (EQ (funcar, Qlambda))
2159 return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop;
2160 if (EQ (funcar, Qautoload))
2161 return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop;
2162 else
2163 return Qnil;
2164 }
2165
2166 DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0,
2167 doc: 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 )
2179 (function, file, docstring, interactive, type)
2180 Lisp_Object function, file, docstring, interactive, type;
2181 {
2182 CHECK_SYMBOL (function);
2183 CHECK_STRING (file);
2184
2185
2186 if (!EQ (XSYMBOL (function)->function, Qunbound)
2187 && !(CONSP (XSYMBOL (function)->function)
2188 && EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
2189 return Qnil;
2190
2191 if (NILP (Vpurify_flag))
2192 2193
2194 LOADHIST_ATTACH (Fcons (Qautoload, function));
2195 else
2196 2197 2198 2199 2200
2201 docstring = make_number (XHASH (function));
2202 return Ffset (function,
2203 Fpurecopy (list5 (Qautoload, file, docstring,
2204 interactive, type)));
2205 }
2206
2207 Lisp_Object
2208 un_autoload (oldqueue)
2209 Lisp_Object oldqueue;
2210 {
2211 register Lisp_Object queue, first, second;
2212
2213 2214
2215 queue = Vautoload_queue;
2216 Vautoload_queue = oldqueue;
2217 while (CONSP (queue))
2218 {
2219 first = XCAR (queue);
2220 second = Fcdr (first);
2221 first = Fcar (first);
2222 if (EQ (first, make_number (0)))
2223 Vfeatures = second;
2224 else
2225 Ffset (first, second);
2226 queue = XCDR (queue);
2227 }
2228 return Qnil;
2229 }
2230
2231 2232 2233
2234
2235 void
2236 do_autoload (fundef, funname)
2237 Lisp_Object fundef, funname;
2238 {
2239 int count = SPECPDL_INDEX ();
2240 Lisp_Object fun;
2241 struct gcpro gcpro1, gcpro2, gcpro3;
2242
2243 2244
2245 if (! NILP (Vpurify_flag))
2246 error ("Attempt to autoload %s while preparing to dump",
2247 SDATA (SYMBOL_NAME (funname)));
2248
2249 fun = funname;
2250 CHECK_SYMBOL (funname);
2251 GCPRO3 (fun, funname, fundef);
2252
2253
2254 record_unwind_save_match_data ();
2255
2256 2257 2258 2259 2260 2261 2262 2263
2264 record_unwind_protect (un_autoload, Vautoload_queue);
2265 Vautoload_queue = Qt;
2266 Fload (Fcar (Fcdr (fundef)), Qnil, Qt, Qnil, Qt);
2267
2268
2269 Vautoload_queue = Qt;
2270 unbind_to (count, Qnil);
2271
2272 fun = Findirect_function (fun, Qnil);
2273
2274 if (!NILP (Fequal (fun, fundef)))
2275 error ("Autoloading failed to define function %s",
2276 SDATA (SYMBOL_NAME (funname)));
2277 UNGCPRO;
2278 }
2279
2280
2281 DEFUN ("eval", Feval, Seval, 1, 1, 0,
2282 doc: )
2283 (form)
2284 Lisp_Object form;
2285 {
2286 Lisp_Object fun, val, original_fun, original_args;
2287 Lisp_Object funcar;
2288 struct backtrace backtrace;
2289 struct gcpro gcpro1, gcpro2, gcpro3;
2290
2291 if (handling_signal)
2292 abort ();
2293
2294 if (SYMBOLP (form))
2295 return Fsymbol_value (form);
2296 if (!CONSP (form))
2297 return form;
2298
2299 QUIT;
2300 if ((consing_since_gc > gc_cons_threshold
2301 && consing_since_gc > gc_relative_threshold)
2302 ||
2303 (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
2304 {
2305 GCPRO1 (form);
2306 Fgarbage_collect ();
2307 UNGCPRO;
2308 }
2309
2310 if (++lisp_eval_depth > max_lisp_eval_depth)
2311 {
2312 if (max_lisp_eval_depth < 100)
2313 max_lisp_eval_depth = 100;
2314 if (lisp_eval_depth > max_lisp_eval_depth)
2315 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2316 }
2317
2318 original_fun = Fcar (form);
2319 original_args = Fcdr (form);
2320
2321 backtrace.next = backtrace_list;
2322 backtrace_list = &backtrace;
2323 backtrace.function = &original_fun;
2324 backtrace.args = &original_args;
2325 backtrace.nargs = UNEVALLED;
2326 backtrace.evalargs = 1;
2327 backtrace.debug_on_exit = 0;
2328
2329 if (debug_on_next_call)
2330 do_debug_on_call (Qt);
2331
2332 2333
2334 retry:
2335
2336
2337 fun = original_fun;
2338 if (SYMBOLP (fun) && !EQ (fun, Qunbound)
2339 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
2340 fun = indirect_function (fun);
2341
2342 if (SUBRP (fun))
2343 {
2344 Lisp_Object numargs;
2345 Lisp_Object argvals[8];
2346 Lisp_Object args_left;
2347 register int i, maxargs;
2348
2349 args_left = original_args;
2350 numargs = Flength (args_left);
2351
2352 CHECK_CONS_LIST ();
2353
2354 if (XINT (numargs) < XSUBR (fun)->min_args ||
2355 (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs)))
2356 xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
2357
2358 if (XSUBR (fun)->max_args == UNEVALLED)
2359 {
2360 backtrace.evalargs = 0;
2361 val = (*XSUBR (fun)->function) (args_left);
2362 goto done;
2363 }
2364
2365 if (XSUBR (fun)->max_args == MANY)
2366 {
2367
2368 Lisp_Object *vals;
2369 register int argnum = 0;
2370
2371 vals = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object));
2372
2373 GCPRO3 (args_left, fun, fun);
2374 gcpro3.var = vals;
2375 gcpro3.nvars = 0;
2376
2377 while (!NILP (args_left))
2378 {
2379 vals[argnum++] = Feval (Fcar (args_left));
2380 args_left = Fcdr (args_left);
2381 gcpro3.nvars = argnum;
2382 }
2383
2384 backtrace.args = vals;
2385 backtrace.nargs = XINT (numargs);
2386
2387 val = (*XSUBR (fun)->function) (XINT (numargs), vals);
2388 UNGCPRO;
2389 goto done;
2390 }
2391
2392 GCPRO3 (args_left, fun, fun);
2393 gcpro3.var = argvals;
2394 gcpro3.nvars = 0;
2395
2396 maxargs = XSUBR (fun)->max_args;
2397 for (i = 0; i < maxargs; args_left = Fcdr (args_left))
2398 {
2399 argvals[i] = Feval (Fcar (args_left));
2400 gcpro3.nvars = ++i;
2401 }
2402
2403 UNGCPRO;
2404
2405 backtrace.args = argvals;
2406 backtrace.nargs = XINT (numargs);
2407
2408 switch (i)
2409 {
2410 case 0:
2411 val = (*XSUBR (fun)->function) ();
2412 goto done;
2413 case 1:
2414 val = (*XSUBR (fun)->function) (argvals[0]);
2415 goto done;
2416 case 2:
2417 val = (*XSUBR (fun)->function) (argvals[0], argvals[1]);
2418 goto done;
2419 case 3:
2420 val = (*XSUBR (fun)->function) (argvals[0], argvals[1],
2421 argvals[2]);
2422 goto done;
2423 case 4:
2424 val = (*XSUBR (fun)->function) (argvals[0], argvals[1],
2425 argvals[2], argvals[3]);
2426 goto done;
2427 case 5:
2428 val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
2429 argvals[3], argvals[4]);
2430 goto done;
2431 case 6:
2432 val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
2433 argvals[3], argvals[4], argvals[5]);
2434 goto done;
2435 case 7:
2436 val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
2437 argvals[3], argvals[4], argvals[5],
2438 argvals[6]);
2439 goto done;
2440
2441 case 8:
2442 val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
2443 argvals[3], argvals[4], argvals[5],
2444 argvals[6], argvals[7]);
2445 goto done;
2446
2447 default:
2448 2449 2450 2451
2452 abort ();
2453 }
2454 }
2455 if (COMPILEDP (fun))
2456 val = apply_lambda (fun, original_args, 1);
2457 else
2458 {
2459 if (EQ (fun, Qunbound))
2460 xsignal1 (Qvoid_function, original_fun);
2461 if (!CONSP (fun))
2462 xsignal1 (Qinvalid_function, original_fun);
2463 funcar = XCAR (fun);
2464 if (!SYMBOLP (funcar))
2465 xsignal1 (Qinvalid_function, original_fun);
2466 if (EQ (funcar, Qautoload))
2467 {
2468 do_autoload (fun, original_fun);
2469 goto retry;
2470 }
2471 if (EQ (funcar, Qmacro))
2472 val = Feval (apply1 (Fcdr (fun), original_args));
2473 else if (EQ (funcar, Qlambda))
2474 val = apply_lambda (fun, original_args, 1);
2475 else
2476 xsignal1 (Qinvalid_function, original_fun);
2477 }
2478 done:
2479 CHECK_CONS_LIST ();
2480
2481 lisp_eval_depth--;
2482 if (backtrace.debug_on_exit)
2483 val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
2484 backtrace_list = backtrace.next;
2485
2486 return val;
2487 }
2488
2489 DEFUN ("apply", Fapply, Sapply, 2, MANY, 0,
2490 doc: 2491 2492 2493 )
2494 (nargs, args)
2495 int nargs;
2496 Lisp_Object *args;
2497 {
2498 register int i, numargs;
2499 register Lisp_Object spread_arg;
2500 register Lisp_Object *funcall_args;
2501 Lisp_Object fun;
2502 struct gcpro gcpro1;
2503
2504 fun = args [0];
2505 funcall_args = 0;
2506 spread_arg = args [nargs - 1];
2507 CHECK_LIST (spread_arg);
2508
2509 numargs = XINT (Flength (spread_arg));
2510
2511 if (numargs == 0)
2512 return Ffuncall (nargs - 1, args);
2513 else if (numargs == 1)
2514 {
2515 args [nargs - 1] = XCAR (spread_arg);
2516 return Ffuncall (nargs, args);
2517 }
2518
2519 numargs += nargs - 2;
2520
2521
2522 if (SYMBOLP (fun) && !EQ (fun, Qunbound)
2523 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
2524 fun = indirect_function (fun);
2525 if (EQ (fun, Qunbound))
2526 {
2527
2528 fun = args[0];
2529 goto funcall;
2530 }
2531
2532 if (SUBRP (fun))
2533 {
2534 if (numargs < XSUBR (fun)->min_args
2535 || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
2536 goto funcall;
2537 else if (XSUBR (fun)->max_args > numargs)
2538 {
2539 2540
2541 funcall_args = (Lisp_Object *) alloca ((1 + XSUBR (fun)->max_args)
2542 * sizeof (Lisp_Object));
2543 for (i = numargs; i < XSUBR (fun)->max_args;)
2544 funcall_args[++i] = Qnil;
2545 GCPRO1 (*funcall_args);
2546 gcpro1.nvars = 1 + XSUBR (fun)->max_args;
2547 }
2548 }
2549 funcall:
2550 2551
2552 if (!funcall_args)
2553 {
2554 funcall_args = (Lisp_Object *) alloca ((1 + numargs)
2555 * sizeof (Lisp_Object));
2556 GCPRO1 (*funcall_args);
2557 gcpro1.nvars = 1 + numargs;
2558 }
2559
2560 bcopy (args, funcall_args, nargs * sizeof (Lisp_Object));
2561 2562
2563 i = nargs - 1;
2564 while (!NILP (spread_arg))
2565 {
2566 funcall_args [i++] = XCAR (spread_arg);
2567 spread_arg = XCDR (spread_arg);
2568 }
2569
2570
2571 RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args));
2572 }
2573
2574
2575
2576 enum run_hooks_condition {to_completion, until_success, until_failure};
2577 static Lisp_Object run_hook_with_args P_ ((int, Lisp_Object *,
2578 enum run_hooks_condition));
2579
2580 DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
2581 doc: 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 )
2595 (nargs, args)
2596 int nargs;
2597 Lisp_Object *args;
2598 {
2599 Lisp_Object hook[1];
2600 register int i;
2601
2602 for (i = 0; i < nargs; i++)
2603 {
2604 hook[0] = args[i];
2605 run_hook_with_args (1, hook, to_completion);
2606 }
2607
2608 return Qnil;
2609 }
2610
2611 DEFUN ("run-hook-with-args", Frun_hook_with_args,
2612 Srun_hook_with_args, 1, MANY, 0,
2613 doc: 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 )
2626 (nargs, args)
2627 int nargs;
2628 Lisp_Object *args;
2629 {
2630 return run_hook_with_args (nargs, args, to_completion);
2631 }
2632
2633 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success,
2634 Srun_hook_with_args_until_success, 1, MANY, 0,
2635 doc: 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 )
2648 (nargs, args)
2649 int nargs;
2650 Lisp_Object *args;
2651 {
2652 return run_hook_with_args (nargs, args, until_success);
2653 }
2654
2655 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
2656 Srun_hook_with_args_until_failure, 1, MANY, 0,
2657 doc: 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 )
2669 (nargs, args)
2670 int nargs;
2671 Lisp_Object *args;
2672 {
2673 return run_hook_with_args (nargs, args, until_failure);
2674 }
2675
2676 2677 2678 2679 2680 2681 2682
2683
2684 static Lisp_Object
2685 run_hook_with_args (nargs, args, cond)
2686 int nargs;
2687 Lisp_Object *args;
2688 enum run_hooks_condition cond;
2689 {
2690 Lisp_Object sym, val, ret;
2691 struct gcpro gcpro1, gcpro2, gcpro3;
2692
2693 2694
2695 if (NILP (Vrun_hooks))
2696 return Qnil;
2697
2698 sym = args[0];
2699 val = find_symbol_value (sym);
2700 ret = (cond == until_failure ? Qt : Qnil);
2701
2702 if (EQ (val, Qunbound) || NILP (val))
2703 return ret;
2704 else if (!CONSP (val) || EQ (XCAR (val), Qlambda))
2705 {
2706 args[0] = val;
2707 return Ffuncall (nargs, args);
2708 }
2709 else
2710 {
2711 Lisp_Object globals = Qnil;
2712 GCPRO3 (sym, val, globals);
2713
2714 for (;
2715 CONSP (val) && ((cond == to_completion)
2716 || (cond == until_success ? NILP (ret)
2717 : !NILP (ret)));
2718 val = XCDR (val))
2719 {
2720 if (EQ (XCAR (val), Qt))
2721 {
2722 2723
2724 globals = Fdefault_value (sym);
2725 if (NILP (globals)) continue;
2726
2727 if (!CONSP (globals) || EQ (XCAR (globals), Qlambda))
2728 {
2729 args[0] = globals;
2730 ret = Ffuncall (nargs, args);
2731 }
2732 else
2733 {
2734 for (;
2735 CONSP (globals) && ((cond == to_completion)
2736 || (cond == until_success ? NILP (ret)
2737 : !NILP (ret)));
2738 globals = XCDR (globals))
2739 {
2740 args[0] = XCAR (globals);
2741 2742
2743 if (!EQ (args[0], Qt))
2744 ret = Ffuncall (nargs, args);
2745 }
2746 }
2747 }
2748 else
2749 {
2750 args[0] = XCAR (val);
2751 ret = Ffuncall (nargs, args);
2752 }
2753 }
2754
2755 UNGCPRO;
2756 return ret;
2757 }
2758 }
2759
2760 2761 2762 2763 2764 2765
2766
2767 Lisp_Object
2768 run_hook_list_with_args (funlist, nargs, args)
2769 Lisp_Object funlist;
2770 int nargs;
2771 Lisp_Object *args;
2772 {
2773 Lisp_Object sym;
2774 Lisp_Object val;
2775 Lisp_Object globals;
2776 struct gcpro gcpro1, gcpro2, gcpro3;
2777
2778 sym = args[0];
2779 globals = Qnil;
2780 GCPRO3 (sym, val, globals);
2781
2782 for (val = funlist; CONSP (val); val = XCDR (val))
2783 {
2784 if (EQ (XCAR (val), Qt))
2785 {
2786 2787
2788
2789 for (globals = Fdefault_value (sym);
2790 CONSP (globals);
2791 globals = XCDR (globals))
2792 {
2793 args[0] = XCAR (globals);
2794 2795
2796 if (!EQ (args[0], Qt))
2797 Ffuncall (nargs, args);
2798 }
2799 }
2800 else
2801 {
2802 args[0] = XCAR (val);
2803 Ffuncall (nargs, args);
2804 }
2805 }
2806 UNGCPRO;
2807 return Qnil;
2808 }
2809
2810
2811
2812 void
2813 run_hook_with_args_2 (hook, arg1, arg2)
2814 Lisp_Object hook, arg1, arg2;
2815 {
2816 Lisp_Object temp[3];
2817 temp[0] = hook;
2818 temp[1] = arg1;
2819 temp[2] = arg2;
2820
2821 Frun_hook_with_args (3, temp);
2822 }
2823
2824
2825 Lisp_Object
2826 apply1 (fn, arg)
2827 Lisp_Object fn, arg;
2828 {
2829 struct gcpro gcpro1;
2830
2831 GCPRO1 (fn);
2832 if (NILP (arg))
2833 RETURN_UNGCPRO (Ffuncall (1, &fn));
2834 gcpro1.nvars = 2;
2835 {
2836 Lisp_Object args[2];
2837 args[0] = fn;
2838 args[1] = arg;
2839 gcpro1.var = args;
2840 RETURN_UNGCPRO (Fapply (2, args));
2841 }
2842 }
2843
2844
2845 Lisp_Object
2846 call0 (fn)
2847 Lisp_Object fn;
2848 {
2849 struct gcpro gcpro1;
2850
2851 GCPRO1 (fn);
2852 RETURN_UNGCPRO (Ffuncall (1, &fn));
2853 }
2854
2855
2856
2857 Lisp_Object
2858 call1 (fn, arg1)
2859 Lisp_Object fn, arg1;
2860 {
2861 struct gcpro gcpro1;
2862 Lisp_Object args[2];
2863
2864 args[0] = fn;
2865 args[1] = arg1;
2866 GCPRO1 (args[0]);
2867 gcpro1.nvars = 2;
2868 RETURN_UNGCPRO (Ffuncall (2, args));
2869 }
2870
2871
2872
2873 Lisp_Object
2874 call2 (fn, arg1, arg2)
2875 Lisp_Object fn, arg1, arg2;
2876 {
2877 struct gcpro gcpro1;
2878 Lisp_Object args[3];
2879 args[0] = fn;
2880 args[1] = arg1;
2881 args[2] = arg2;
2882 GCPRO1 (args[0]);
2883 gcpro1.nvars = 3;
2884 RETURN_UNGCPRO (Ffuncall (3, args));
2885 }
2886
2887
2888
2889 Lisp_Object
2890 call3 (fn, arg1, arg2, arg3)
2891 Lisp_Object fn, arg1, arg2, arg3;
2892 {
2893 struct gcpro gcpro1;
2894 Lisp_Object args[4];
2895 args[0] = fn;
2896 args[1] = arg1;
2897 args[2] = arg2;
2898 args[3] = arg3;
2899 GCPRO1 (args[0]);
2900 gcpro1.nvars = 4;
2901 RETURN_UNGCPRO (Ffuncall (4, args));
2902 }
2903
2904
2905
2906 Lisp_Object
2907 call4 (fn, arg1, arg2, arg3, arg4)
2908 Lisp_Object fn, arg1, arg2, arg3, arg4;
2909 {
2910 struct gcpro gcpro1;
2911 Lisp_Object args[5];
2912 args[0] = fn;
2913 args[1] = arg1;
2914 args[2] = arg2;
2915 args[3] = arg3;
2916 args[4] = arg4;
2917 GCPRO1 (args[0]);
2918 gcpro1.nvars = 5;
2919 RETURN_UNGCPRO (Ffuncall (5, args));
2920 }
2921
2922
2923
2924 Lisp_Object
2925 call5 (fn, arg1, arg2, arg3, arg4, arg5)
2926 Lisp_Object fn, arg1, arg2, arg3, arg4, arg5;
2927 {
2928 struct gcpro gcpro1;
2929 Lisp_Object args[6];
2930 args[0] = fn;
2931 args[1] = arg1;
2932 args[2] = arg2;
2933 args[3] = arg3;
2934 args[4] = arg4;
2935 args[5] = arg5;
2936 GCPRO1 (args[0]);
2937 gcpro1.nvars = 6;
2938 RETURN_UNGCPRO (Ffuncall (6, args));
2939 }
2940
2941
2942
2943 Lisp_Object
2944 call6 (fn, arg1, arg2, arg3, arg4, arg5, arg6)
2945 Lisp_Object fn, arg1, arg2, arg3, arg4, arg5, arg6;
2946 {
2947 struct gcpro gcpro1;
2948 Lisp_Object args[7];
2949 args[0] = fn;
2950 args[1] = arg1;
2951 args[2] = arg2;
2952 args[3] = arg3;
2953 args[4] = arg4;
2954 args[5] = arg5;
2955 args[6] = arg6;
2956 GCPRO1 (args[0]);
2957 gcpro1.nvars = 7;
2958 RETURN_UNGCPRO (Ffuncall (7, args));
2959 }
2960
2961
2962
2963 Lisp_Object
2964 call7 (fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7)
2965 Lisp_Object fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7;
2966 {
2967 struct gcpro gcpro1;
2968 Lisp_Object args[8];
2969 args[0] = fn;
2970 args[1] = arg1;
2971 args[2] = arg2;
2972 args[3] = arg3;
2973 args[4] = arg4;
2974 args[5] = arg5;
2975 args[6] = arg6;
2976 args[7] = arg7;
2977 GCPRO1 (args[0]);
2978 gcpro1.nvars = 8;
2979 RETURN_UNGCPRO (Ffuncall (8, args));
2980 }
2981
2982
2983
2984 DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
2985 doc: 2986 2987 2988 )
2989 (nargs, args)
2990 int nargs;
2991 Lisp_Object *args;
2992 {
2993 Lisp_Object fun, original_fun;
2994 Lisp_Object funcar;
2995 int numargs = nargs - 1;
2996 Lisp_Object lisp_numargs;
2997 Lisp_Object val;
2998 struct backtrace backtrace;
2999 register Lisp_Object *internal_args;
3000 register int i;
3001
3002 QUIT;
3003 if ((consing_since_gc > gc_cons_threshold
3004 && consing_since_gc > gc_relative_threshold)
3005 ||
3006 (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
3007 Fgarbage_collect ();
3008
3009 if (++lisp_eval_depth > max_lisp_eval_depth)
3010 {
3011 if (max_lisp_eval_depth < 100)
3012 max_lisp_eval_depth = 100;
3013 if (lisp_eval_depth > max_lisp_eval_depth)
3014 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
3015 }
3016
3017 backtrace.next = backtrace_list;
3018 backtrace_list = &backtrace;
3019 backtrace.function = &args[0];
3020 backtrace.args = &args[1];
3021 backtrace.nargs = nargs - 1;
3022 backtrace.evalargs = 0;
3023 backtrace.debug_on_exit = 0;
3024
3025 if (debug_on_next_call)
3026 do_debug_on_call (Qlambda);
3027
3028 CHECK_CONS_LIST ();
3029
3030 original_fun = args[0];
3031
3032 retry:
3033
3034
3035 fun = original_fun;
3036 if (SYMBOLP (fun) && !EQ (fun, Qunbound)
3037 && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
3038 fun = indirect_function (fun);
3039
3040 if (SUBRP (fun))
3041 {
3042 if (numargs < XSUBR (fun)->min_args
3043 || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
3044 {
3045 XSETFASTINT (lisp_numargs, numargs);
3046 xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs);
3047 }
3048
3049 if (XSUBR (fun)->max_args == UNEVALLED)
3050 xsignal1 (Qinvalid_function, original_fun);
3051
3052 if (XSUBR (fun)->max_args == MANY)
3053 {
3054 val = (*XSUBR (fun)->function) (numargs, args + 1);
3055 goto done;
3056 }
3057
3058 if (XSUBR (fun)->max_args > numargs)
3059 {
3060 internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object));
3061 bcopy (args + 1, internal_args, numargs * sizeof (Lisp_Object));
3062 for (i = numargs; i < XSUBR (fun)->max_args; i++)
3063 internal_args[i] = Qnil;
3064 }
3065 else
3066 internal_args = args + 1;
3067 switch (XSUBR (fun)->max_args)
3068 {
3069 case 0:
3070 val = (*XSUBR (fun)->function) ();
3071 goto done;
3072 case 1:
3073 val = (*XSUBR (fun)->function) (internal_args[0]);
3074 goto done;
3075 case 2:
3076 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1]);
3077 goto done;
3078 case 3:
3079 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
3080 internal_args[2]);
3081 goto done;
3082 case 4:
3083 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
3084 internal_args[2], internal_args[3]);
3085 goto done;
3086 case 5:
3087 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
3088 internal_args[2], internal_args[3],
3089 internal_args[4]);
3090 goto done;
3091 case 6:
3092 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
3093 internal_args[2], internal_args[3],
3094 internal_args[4], internal_args[5]);
3095 goto done;
3096 case 7:
3097 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
3098 internal_args[2], internal_args[3],
3099 internal_args[4], internal_args[5],
3100 internal_args[6]);
3101 goto done;
3102
3103 case 8:
3104 val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
3105 internal_args[2], internal_args[3],
3106 internal_args[4], internal_args[5],
3107 internal_args[6], internal_args[7]);
3108 goto done;
3109
3110 default:
3111
3112 3113 3114
3115 abort ();
3116 }
3117 }
3118 if (COMPILEDP (fun))
3119 val = funcall_lambda (fun, numargs, args + 1);
3120 else
3121 {
3122 if (EQ (fun, Qunbound))
3123 xsignal1 (Qvoid_function, original_fun);
3124 if (!CONSP (fun))
3125 xsignal1 (Qinvalid_function, original_fun);
3126 funcar = XCAR (fun);
3127 if (!SYMBOLP (funcar))
3128 xsignal1 (Qinvalid_function, original_fun);
3129 if (EQ (funcar, Qlambda))
3130 val = funcall_lambda (fun, numargs, args + 1);
3131 else if (EQ (funcar, Qautoload))
3132 {
3133 do_autoload (fun, original_fun);
3134 CHECK_CONS_LIST ();
3135 goto retry;
3136 }
3137 else
3138 xsignal1 (Qinvalid_function, original_fun);
3139 }
3140 done:
3141 CHECK_CONS_LIST ();
3142 lisp_eval_depth--;
3143 if (backtrace.debug_on_exit)
3144 val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
3145 backtrace_list = backtrace.next;
3146 return val;
3147 }
3148
3149 Lisp_Object
3150 apply_lambda (fun, args, eval_flag)
3151 Lisp_Object fun, args;
3152 int eval_flag;
3153 {
3154 Lisp_Object args_left;
3155 Lisp_Object numargs;
3156 register Lisp_Object *arg_vector;
3157 struct gcpro gcpro1, gcpro2, gcpro3;
3158 register int i;
3159 register Lisp_Object tem;
3160
3161 numargs = Flength (args);
3162 arg_vector = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object));
3163 args_left = args;
3164
3165 GCPRO3 (*arg_vector, args_left, fun);
3166 gcpro1.nvars = 0;
3167
3168 for (i = 0; i < XINT (numargs);)
3169 {
3170 tem = Fcar (args_left), args_left = Fcdr (args_left);
3171 if (eval_flag) tem = Feval (tem);
3172 arg_vector[i++] = tem;
3173 gcpro1.nvars = i;
3174 }
3175
3176 UNGCPRO;
3177
3178 if (eval_flag)
3179 {
3180 backtrace_list->args = arg_vector;
3181 backtrace_list->nargs = i;
3182 }
3183 backtrace_list->evalargs = 0;
3184 tem = funcall_lambda (fun, XINT (numargs), arg_vector);
3185
3186
3187 if (backtrace_list->debug_on_exit)
3188 tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil)));
3189
3190 backtrace_list->debug_on_exit = 0;
3191 return tem;
3192 }
3193
3194 3195 3196
3197
3198 static Lisp_Object
3199 funcall_lambda (fun, nargs, arg_vector)
3200 Lisp_Object fun;
3201 int nargs;
3202 register Lisp_Object *arg_vector;
3203 {
3204 Lisp_Object val, syms_left, next;
3205 int count = SPECPDL_INDEX ();
3206 int i, optional, rest;
3207
3208 if (CONSP (fun))
3209 {
3210 syms_left = XCDR (fun);
3211 if (CONSP (syms_left))
3212 syms_left = XCAR (syms_left);
3213 else
3214 xsignal1 (Qinvalid_function, fun);
3215 }
3216 else if (COMPILEDP (fun))
3217 syms_left = AREF (fun, COMPILED_ARGLIST);
3218 else
3219 abort ();
3220
3221 i = optional = rest = 0;
3222 for (; CONSP (syms_left); syms_left = XCDR (syms_left))
3223 {
3224 QUIT;
3225
3226 next = XCAR (syms_left);
3227 if (!SYMBOLP (next))
3228 xsignal1 (Qinvalid_function, fun);
3229
3230 if (EQ (next, Qand_rest))
3231 rest = 1;
3232 else if (EQ (next, Qand_optional))
3233 optional = 1;
3234 else if (rest)
3235 {
3236 specbind (next, Flist (nargs - i, &arg_vector[i]));
3237 i = nargs;
3238 }
3239 else if (i < nargs)
3240 specbind (next, arg_vector[i++]);
3241 else if (!optional)
3242 xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
3243 else
3244 specbind (next, Qnil);
3245 }
3246
3247 if (!NILP (syms_left))
3248 xsignal1 (Qinvalid_function, fun);
3249 else if (i < nargs)
3250 xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
3251
3252 if (CONSP (fun))
3253 val = Fprogn (XCDR (XCDR (fun)));
3254 else
3255 {
3256 3257
3258 if (CONSP (AREF (fun, COMPILED_BYTECODE)))
3259 Ffetch_bytecode (fun);
3260 val = Fbyte_code (AREF (fun, COMPILED_BYTECODE),
3261 AREF (fun, COMPILED_CONSTANTS),
3262 AREF (fun, COMPILED_STACK_DEPTH));
3263 }
3264
3265 return unbind_to (count, val);
3266 }
3267
3268 DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
3269 1, 1, 0,
3270 doc: )
3271 (object)
3272 Lisp_Object object;
3273 {
3274 Lisp_Object tem;
3275
3276 if (COMPILEDP (object) && CONSP (AREF (object, COMPILED_BYTECODE)))
3277 {
3278 tem = read_doc_string (AREF (object, COMPILED_BYTECODE));
3279 if (!CONSP (tem))
3280 {
3281 tem = AREF (object, COMPILED_BYTECODE);
3282 if (CONSP (tem) && STRINGP (XCAR (tem)))
3283 error ("Invalid byte code in %s", SDATA (XCAR (tem)));
3284 else
3285 error ("Invalid byte code");
3286 }
3287 ASET (object, COMPILED_BYTECODE, XCAR (tem));
3288 ASET (object, COMPILED_CONSTANTS, XCDR (tem));
3289 }
3290 return object;
3291 }
3292
3293 void
3294 grow_specpdl ()
3295 {
3296 register int count = SPECPDL_INDEX ();
3297 if (specpdl_size >= max_specpdl_size)
3298 {
3299 if (max_specpdl_size < 400)
3300 max_specpdl_size = 400;
3301 if (specpdl_size >= max_specpdl_size)
3302 signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil);
3303 }
3304 specpdl_size *= 2;
3305 if (specpdl_size > max_specpdl_size)
3306 specpdl_size = max_specpdl_size;
3307 specpdl = (struct specbinding *) xrealloc (specpdl, specpdl_size * sizeof (struct specbinding));
3308 specpdl_ptr = specpdl + count;
3309 }
3310
3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324
3325
3326 void
3327 specbind (symbol, value)
3328 Lisp_Object symbol, value;
3329 {
3330 struct Lisp_Symbol *sym;
3331
3332 eassert (!handling_signal);
3333
3334 CHECK_SYMBOL (symbol);
3335 sym = XSYMBOL (symbol);
3336 if (specpdl_ptr == specpdl + specpdl_size)
3337 grow_specpdl ();
3338
3339 start:
3340 switch (sym->redirect)
3341 {
3342 case SYMBOL_VARALIAS:
3343 sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start;
3344 case SYMBOL_PLAINVAL:
3345 { 3346
3347 specpdl_ptr->symbol = symbol;
3348 specpdl_ptr->old_value = SYMBOL_VAL (sym);
3349 specpdl_ptr->func = NULL;
3350 ++specpdl_ptr;
3351 if (!sym->constant)
3352 SET_SYMBOL_VAL (sym, value);
3353 else
3354 set_internal (symbol, value, Qnil, 1);
3355 break;
3356 }
3357 case SYMBOL_LOCALIZED:
3358 if (SYMBOL_BLV (sym)->frame_local)
3359 error ("Frame-local vars cannot be let-bound");
3360 case SYMBOL_FORWARDED:
3361 {
3362 Lisp_Object ovalue = find_symbol_value (symbol);
3363 specpdl_ptr->func = 0;
3364 specpdl_ptr->old_value = ovalue;
3365
3366 eassert (sym->redirect != SYMBOL_LOCALIZED
3367 || (EQ (SYMBOL_BLV (sym)->where,
3368 SYMBOL_BLV (sym)->frame_local ?
3369 Fselected_frame () : Fcurrent_buffer ())));
3370
3371 if (sym->redirect == SYMBOL_LOCALIZED
3372 || BUFFER_OBJFWDP (SYMBOL_FWD (sym)))
3373 {
3374 Lisp_Object where, cur_buf = Fcurrent_buffer ();
3375
3376 3377
3378 if (!NILP (Flocal_variable_p (symbol, Qnil)))
3379 {
3380 eassert (sym->redirect != SYMBOL_LOCALIZED
3381 || (BLV_FOUND (SYMBOL_BLV (sym))
3382 && EQ (cur_buf, SYMBOL_BLV (sym)->where)));
3383 where = cur_buf;
3384 }
3385 else if (sym->redirect == SYMBOL_LOCALIZED
3386 && BLV_FOUND (SYMBOL_BLV (sym)))
3387 where = SYMBOL_BLV (sym)->where;
3388 else
3389 where = Qnil;
3390
3391 3392 3393
3394 3395 3396
3397 eassert (NILP (where) || EQ (where, cur_buf));
3398 specpdl_ptr->symbol = Fcons (symbol, Fcons (where, cur_buf));
3399
3400 3401 3402 3403 3404
3405 if (NILP (where)
3406 && sym->redirect == SYMBOL_FORWARDED)
3407 {
3408 eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym)));
3409 ++specpdl_ptr;
3410 Fset_default (symbol, value);
3411 return;
3412 }
3413 }
3414 else
3415 specpdl_ptr->symbol = symbol;
3416
3417 specpdl_ptr++;
3418 set_internal (symbol, value, Qnil, 1);
3419 break;
3420 }
3421 default: abort ();
3422 }
3423 }
3424
3425 void
3426 record_unwind_protect (function, arg)
3427 Lisp_Object (*function) P_ ((Lisp_Object));
3428 Lisp_Object arg;
3429 {
3430 eassert (!handling_signal);
3431
3432 if (specpdl_ptr == specpdl + specpdl_size)
3433 grow_specpdl ();
3434 specpdl_ptr->func = function;
3435 specpdl_ptr->symbol = Qnil;
3436 specpdl_ptr->old_value = arg;
3437 specpdl_ptr++;
3438 }
3439
3440 Lisp_Object
3441 unbind_to (count, value)
3442 int count;
3443 Lisp_Object value;
3444 {
3445 Lisp_Object quitf = Vquit_flag;
3446 struct gcpro gcpro1, gcpro2;
3447
3448 GCPRO2 (value, quitf);
3449 Vquit_flag = Qnil;
3450
3451 while (specpdl_ptr != specpdl + count)
3452 {
3453 3454 3455 3456 3457
3458
3459 struct specbinding this_binding;
3460 this_binding = *--specpdl_ptr;
3461
3462 if (this_binding.func != 0)
3463 (*this_binding.func) (this_binding.old_value);
3464 3465 3466 3467 3468 3469 3470
3471 else if (CONSP (this_binding.symbol))
3472 {
3473 Lisp_Object symbol, where;
3474
3475 symbol = XCAR (this_binding.symbol);
3476 where = XCAR (XCDR (this_binding.symbol));
3477
3478 if (NILP (where))
3479 Fset_default (symbol, this_binding.old_value);
3480 3481
3482 else if (BUFFERP (where)
3483 ? !NILP (Flocal_variable_p (symbol, where))
3484 : !NILP (Fassq (symbol, XFRAME (where)->param_alist)))
3485 set_internal (symbol, this_binding.old_value, where, 1);
3486 }
3487 3488 3489
3490 else if (XSYMBOL (this_binding.symbol)->redirect == SYMBOL_PLAINVAL)
3491 SET_SYMBOL_VAL (XSYMBOL (this_binding.symbol),
3492 this_binding.old_value);
3493 else
3494 3495
3496 Fset_default (this_binding.symbol, this_binding.old_value);
3497 }
3498
3499 if (NILP (Vquit_flag) && !NILP (quitf))
3500 Vquit_flag = quitf;
3501
3502 UNGCPRO;
3503 return value;
3504 }
3505
3506 DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
3507 doc: 3508 )
3509 (level, flag)
3510 Lisp_Object level, flag;
3511 {
3512 register struct backtrace *backlist = backtrace_list;
3513 register int i;
3514
3515 CHECK_NUMBER (level);
3516
3517 for (i = 0; backlist && i < XINT (level); i++)
3518 {
3519 backlist = backlist->next;
3520 }
3521
3522 if (backlist)
3523 backlist->debug_on_exit = !NILP (flag);
3524
3525 return flag;
3526 }
3527
3528 DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
3529 doc: 3530 )
3531 ()
3532 {
3533 register struct backtrace *backlist = backtrace_list;
3534 register int i;
3535 Lisp_Object tail;
3536 Lisp_Object tem;
3537 extern Lisp_Object Vprint_level;
3538 struct gcpro gcpro1;
3539
3540 XSETFASTINT (Vprint_level, 3);
3541
3542 tail = Qnil;
3543 GCPRO1 (tail);
3544
3545 while (backlist)
3546 {
3547 write_string (backlist->debug_on_exit ? "* " : " ", 2);
3548 if (backlist->nargs == UNEVALLED)
3549 {
3550 Fprin1 (Fcons (*backlist->function, *backlist->args), Qnil);
3551 write_string ("\n", -1);
3552 }
3553 else
3554 {
3555 tem = *backlist->function;
3556 Fprin1 (tem, Qnil);
3557 write_string ("(", -1);
3558 if (backlist->nargs == MANY)
3559 {
3560 for (tail = *backlist->args, i = 0;
3561 !NILP (tail);
3562 tail = Fcdr (tail), i++)
3563 {
3564 if (i) write_string (" ", -1);
3565 Fprin1 (Fcar (tail), Qnil);
3566 }
3567 }
3568 else
3569 {
3570 for (i = 0; i < backlist->nargs; i++)
3571 {
3572 if (i) write_string (" ", -1);
3573 Fprin1 (backlist->args[i], Qnil);
3574 }
3575 }
3576 write_string (")\n", -1);
3577 }
3578 backlist = backlist->next;
3579 }
3580
3581 Vprint_level = Qnil;
3582 UNGCPRO;
3583 return Qnil;
3584 }
3585
3586 DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 1, NULL,
3587 doc: 3588 3589 3590 3591 3592 3593 3594 3595 )
3596 (nframes)
3597 Lisp_Object nframes;
3598 {
3599 register struct backtrace *backlist = backtrace_list;
3600 register int i;
3601 Lisp_Object tem;
3602
3603 CHECK_NATNUM (nframes);
3604
3605
3606 for (i = 0; backlist && i < XFASTINT (nframes); i++)
3607 backlist = backlist->next;
3608
3609 if (!backlist)
3610 return Qnil;
3611 if (backlist->nargs == UNEVALLED)
3612 return Fcons (Qnil, Fcons (*backlist->function, *backlist->args));
3613 else
3614 {
3615 if (backlist->nargs == MANY)
3616 tem = *backlist->args;
3617 else
3618 tem = Flist (backlist->nargs, backlist->args);
3619
3620 return Fcons (Qt, Fcons (*backlist->function, tem));
3621 }
3622 }
3623
3624
3625 void
3626 mark_backtrace ()
3627 {
3628 register struct backtrace *backlist;
3629 register int i;
3630
3631 for (backlist = backtrace_list; backlist; backlist = backlist->next)
3632 {
3633 mark_object (*backlist->function);
3634
3635 if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
3636 i = 0;
3637 else
3638 i = backlist->nargs - 1;
3639 for (; i >= 0; i--)
3640 mark_object (backlist->args[i]);
3641 }
3642 }
3643
3644 void
3645 syms_of_eval ()
3646 {
3647 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size,
3648 doc: 3649 3650 3651 3652 3653 );
3654
3655 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth,
3656 doc: 3657 3658 3659 3660 3661 3662 );
3663
3664 DEFVAR_LISP ("quit-flag", &Vquit_flag,
3665 doc: 3666 3667 3668 3669 3670 );
3671 Vquit_flag = Qnil;
3672
3673 DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit,
3674 doc: 3675 3676 3677 3678 );
3679 Vinhibit_quit = Qnil;
3680
3681 Qinhibit_quit = intern_c_string ("inhibit-quit");
3682 staticpro (&Qinhibit_quit);
3683
3684 Qautoload = intern_c_string ("autoload");
3685 staticpro (&Qautoload);
3686
3687 Qdebug_on_error = intern_c_string ("debug-on-error");
3688 staticpro (&Qdebug_on_error);
3689
3690 Qmacro = intern_c_string ("macro");
3691 staticpro (&Qmacro);
3692
3693 Qdeclare = intern_c_string ("declare");
3694 staticpro (&Qdeclare);
3695
3696 3697
3698 Qexit = intern_c_string ("exit");
3699 staticpro (&Qexit);
3700
3701 Qinteractive = intern_c_string ("interactive");
3702 staticpro (&Qinteractive);
3703
3704 Qcommandp = intern_c_string ("commandp");
3705 staticpro (&Qcommandp);
3706
3707 Qdefun = intern_c_string ("defun");
3708 staticpro (&Qdefun);
3709
3710 Qand_rest = intern_c_string ("&rest");
3711 staticpro (&Qand_rest);
3712
3713 Qand_optional = intern_c_string ("&optional");
3714 staticpro (&Qand_optional);
3715
3716 Qdebug = intern_c_string ("debug");
3717 staticpro (&Qdebug);
3718
3719 DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error,
3720 doc: 3721 3722 3723 3724 );
3725 Vstack_trace_on_error = Qnil;
3726
3727 DEFVAR_LISP ("debug-on-error", &Vdebug_on_error,
3728 doc: 3729 3730 3731 3732 3733 3734 3735 3736 );
3737 Vdebug_on_error = Qnil;
3738
3739 DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors,
3740 doc: 3741 3742 3743 3744 3745 );
3746 Vdebug_ignored_errors = Qnil;
3747
3748 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit,
3749 doc: 3750 );
3751 debug_on_quit = 0;
3752
3753 DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call,
3754 doc: );
3755
3756 DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue,
3757 doc: 3758 3759 );
3760 debugger_may_continue = 1;
3761
3762 DEFVAR_LISP ("debugger", &Vdebugger,
3763 doc: 3764 3765 3766 3767 3768 );
3769 Vdebugger = Qnil;
3770
3771 DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function,
3772 doc: 3773 3774 );
3775 Vsignal_hook_function = Qnil;
3776
3777 DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal,
3778 doc: 3779 3780 );
3781 Vdebug_on_signal = Qnil;
3782
3783 DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function,
3784 doc: 3785 3786 3787 3788 );
3789 Vmacro_declaration_function = Qnil;
3790
3791 Vrun_hooks = intern_c_string ("run-hooks");
3792 staticpro (&Vrun_hooks);
3793
3794 staticpro (&Vautoload_queue);
3795 Vautoload_queue = Qnil;
3796 staticpro (&Vsignaling_function);
3797 Vsignaling_function = Qnil;
3798
3799 defsubr (&Sor);
3800 defsubr (&Sand);
3801 defsubr (&Sif);
3802 defsubr (&Scond);
3803 defsubr (&Sprogn);
3804 defsubr (&Sprog1);
3805 defsubr (&Sprog2);
3806 defsubr (&Ssetq);
3807 defsubr (&Squote);
3808 defsubr (&Sfunction);
3809 defsubr (&Sdefun);
3810 defsubr (&Sdefmacro);
3811 defsubr (&Sdefvar);
3812 defsubr (&Sdefvaralias);
3813 defsubr (&Sdefconst);
3814 defsubr (&Suser_variable_p);
3815 defsubr (&Slet);
3816 defsubr (&SletX);
3817 defsubr (&Swhile);
3818 defsubr (&Smacroexpand);
3819 defsubr (&Scatch);
3820 defsubr (&Sthrow);
3821 defsubr (&Sunwind_protect);
3822 defsubr (&Scondition_case);
3823 defsubr (&Ssignal);
3824 defsubr (&Sinteractive_p);
3825 defsubr (&Scalled_interactively_p);
3826 defsubr (&Scommandp);
3827 defsubr (&Sautoload);
3828 defsubr (&Seval);
3829 defsubr (&Sapply);
3830 defsubr (&Sfuncall);
3831 defsubr (&Srun_hooks);
3832 defsubr (&Srun_hook_with_args);
3833 defsubr (&Srun_hook_with_args_until_success);
3834 defsubr (&Srun_hook_with_args_until_failure);
3835 defsubr (&Sfetch_bytecode);
3836 defsubr (&Sbacktrace_debug);
3837 defsubr (&Sbacktrace);
3838 defsubr (&Sbacktrace_frame);
3839 }
3840
3841 3842