aboutsummaryrefslogtreecommitdiffstats
path: root/src/data.c
diff options
context:
space:
mode:
authorBill Wohler2012-11-24 19:43:02 -0800
committerBill Wohler2012-11-24 19:43:02 -0800
commit5244bc019bf7376caff3bb198ff674e0ad9fb0e6 (patch)
tree02ee1615e904771f692ec2957c79a08ae029a13d /src/data.c
parent9f7e719509474e92f85955e22e57ffeebd4e96f3 (diff)
parentc07a6ded1df2f4156badc9add2953579622c3722 (diff)
downloademacs-5244bc019bf7376caff3bb198ff674e0ad9fb0e6.tar.gz
emacs-5244bc019bf7376caff3bb198ff674e0ad9fb0e6.zip
Merge from trunk.
Diffstat (limited to 'src/data.c')
-rw-r--r--src/data.c634
1 files changed, 255 insertions, 379 deletions
diff --git a/src/data.c b/src/data.c
index 0ebb17a2e01..5fc6afaaa03 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1,5 +1,5 @@
1/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter. 1/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2011 2 Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2012
3 Free Software Foundation, Inc. 3 Free Software Foundation, Inc.
4 4
5This file is part of GNU Emacs. 5This file is part of GNU Emacs.
@@ -19,9 +19,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19 19
20 20
21#include <config.h> 21#include <config.h>
22#include <signal.h>
23#include <stdio.h> 22#include <stdio.h>
24#include <setjmp.h>
25 23
26#include <intprops.h> 24#include <intprops.h>
27 25
@@ -34,24 +32,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
34#include "syssignal.h" 32#include "syssignal.h"
35#include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */ 33#include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */
36#include "font.h" 34#include "font.h"
37 35#include "keymap.h"
38#include <float.h>
39/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
40#ifndef IEEE_FLOATING_POINT
41#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
42 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
43#define IEEE_FLOATING_POINT 1
44#else
45#define IEEE_FLOATING_POINT 0
46#endif
47#endif
48
49#include <math.h>
50 36
51Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound; 37Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
52static Lisp_Object Qsubr; 38static Lisp_Object Qsubr;
53Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; 39Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
54Lisp_Object Qerror, Qquit, Qargs_out_of_range; 40Lisp_Object Qerror, Quser_error, Qquit, Qargs_out_of_range;
55static Lisp_Object Qwrong_type_argument; 41static Lisp_Object Qwrong_type_argument;
56Lisp_Object Qvoid_variable, Qvoid_function; 42Lisp_Object Qvoid_variable, Qvoid_function;
57static Lisp_Object Qcyclic_function_indirection; 43static Lisp_Object Qcyclic_function_indirection;
@@ -76,24 +62,26 @@ Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
76Lisp_Object Qcdr; 62Lisp_Object Qcdr;
77static Lisp_Object Qad_advice_info, Qad_activate_internal; 63static Lisp_Object Qad_advice_info, Qad_activate_internal;
78 64
79Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error; 65static Lisp_Object Qdomain_error, Qsingularity_error, Qunderflow_error;
80Lisp_Object Qoverflow_error, Qunderflow_error; 66Lisp_Object Qrange_error, Qoverflow_error;
81 67
82Lisp_Object Qfloatp; 68Lisp_Object Qfloatp;
83Lisp_Object Qnumberp, Qnumber_or_marker_p; 69Lisp_Object Qnumberp, Qnumber_or_marker_p;
84 70
85Lisp_Object Qinteger; 71Lisp_Object Qinteger, Qsymbol;
86static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; 72static Lisp_Object Qcons, Qfloat, Qmisc, Qstring, Qvector;
87Lisp_Object Qwindow; 73Lisp_Object Qwindow;
88static Lisp_Object Qfloat, Qwindow_configuration; 74static Lisp_Object Qoverlay, Qwindow_configuration;
89static Lisp_Object Qprocess; 75static Lisp_Object Qprocess, Qmarker;
90static Lisp_Object Qcompiled_function, Qframe, Qvector; 76static Lisp_Object Qcompiled_function, Qframe;
91Lisp_Object Qbuffer; 77Lisp_Object Qbuffer;
92static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; 78static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
93static Lisp_Object Qsubrp, Qmany, Qunevalled; 79static Lisp_Object Qsubrp, Qmany, Qunevalled;
94Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; 80Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
81static Lisp_Object Qdefun;
95 82
96Lisp_Object Qinteractive_form; 83Lisp_Object Qinteractive_form;
84static Lisp_Object Qdefalias_fset_function;
97 85
98static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *); 86static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
99 87
@@ -106,7 +94,7 @@ wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
106 to try and do that by checking the tagbits, but nowadays all 94 to try and do that by checking the tagbits, but nowadays all
107 tagbits are potentially valid. */ 95 tagbits are potentially valid. */
108 /* if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit) 96 /* if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit)
109 * abort (); */ 97 * emacs_abort (); */
110 98
111 xsignal2 (Qwrong_type_argument, predicate, value); 99 xsignal2 (Qwrong_type_argument, predicate, value);
112} 100}
@@ -130,7 +118,7 @@ args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
130} 118}
131 119
132 120
133/* Data type predicates */ 121/* Data type predicates. */
134 122
135DEFUN ("eq", Feq, Seq, 2, 2, 0, 123DEFUN ("eq", Feq, Seq, 2, 2, 0,
136 doc: /* Return t if the two args are the same Lisp object. */) 124 doc: /* Return t if the two args are the same Lisp object. */)
@@ -180,7 +168,7 @@ for example, (type-of 1) returns `integer'. */)
180 case Lisp_Misc_Float: 168 case Lisp_Misc_Float:
181 return Qfloat; 169 return Qfloat;
182 } 170 }
183 abort (); 171 emacs_abort ();
184 172
185 case Lisp_Vectorlike: 173 case Lisp_Vectorlike:
186 if (WINDOW_CONFIGURATIONP (object)) 174 if (WINDOW_CONFIGURATIONP (object))
@@ -215,7 +203,7 @@ for example, (type-of 1) returns `integer'. */)
215 return Qfloat; 203 return Qfloat;
216 204
217 default: 205 default:
218 abort (); 206 emacs_abort ();
219 } 207 }
220} 208}
221 209
@@ -457,7 +445,7 @@ DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
457} 445}
458 446
459 447
460/* Extract and set components of lists */ 448/* Extract and set components of lists. */
461 449
462DEFUN ("car", Fcar, Scar, 1, 1, 0, 450DEFUN ("car", Fcar, Scar, 1, 1, 0,
463 doc: /* Return the car of LIST. If arg is nil, return nil. 451 doc: /* Return the car of LIST. If arg is nil, return nil.
@@ -515,7 +503,7 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
515 return newcdr; 503 return newcdr;
516} 504}
517 505
518/* Extract and set components of symbols */ 506/* Extract and set components of symbols. */
519 507
520DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, 508DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
521 doc: /* Return t if SYMBOL's value is not void. */) 509 doc: /* Return t if SYMBOL's value is not void. */)
@@ -541,7 +529,7 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
541 else 529 else
542 { 530 {
543 swap_in_symval_forwarding (sym, blv); 531 swap_in_symval_forwarding (sym, blv);
544 valcontents = BLV_VALUE (blv); 532 valcontents = blv_value (blv);
545 } 533 }
546 break; 534 break;
547 } 535 }
@@ -549,18 +537,19 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
549 /* In set_internal, we un-forward vars when their value is 537 /* In set_internal, we un-forward vars when their value is
550 set to Qunbound. */ 538 set to Qunbound. */
551 return Qt; 539 return Qt;
552 default: abort (); 540 default: emacs_abort ();
553 } 541 }
554 542
555 return (EQ (valcontents, Qunbound) ? Qnil : Qt); 543 return (EQ (valcontents, Qunbound) ? Qnil : Qt);
556} 544}
557 545
546/* FIXME: Make it an alias for function-symbol! */
558DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, 547DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
559 doc: /* Return t if SYMBOL's function definition is not void. */) 548 doc: /* Return t if SYMBOL's function definition is not void. */)
560 (register Lisp_Object symbol) 549 (register Lisp_Object symbol)
561{ 550{
562 CHECK_SYMBOL (symbol); 551 CHECK_SYMBOL (symbol);
563 return (EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt); 552 return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt;
564} 553}
565 554
566DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, 555DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
@@ -576,14 +565,14 @@ Return SYMBOL. */)
576} 565}
577 566
578DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, 567DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
579 doc: /* Make SYMBOL's function definition be void. 568 doc: /* Make SYMBOL's function definition be nil.
580Return SYMBOL. */) 569Return SYMBOL. */)
581 (register Lisp_Object symbol) 570 (register Lisp_Object symbol)
582{ 571{
583 CHECK_SYMBOL (symbol); 572 CHECK_SYMBOL (symbol);
584 if (NILP (symbol) || EQ (symbol, Qt)) 573 if (NILP (symbol) || EQ (symbol, Qt))
585 xsignal1 (Qsetting_constant, symbol); 574 xsignal1 (Qsetting_constant, symbol);
586 XSYMBOL (symbol)->function = Qunbound; 575 set_symbol_function (symbol, Qnil);
587 return symbol; 576 return symbol;
588} 577}
589 578
@@ -592,9 +581,7 @@ DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
592 (register Lisp_Object symbol) 581 (register Lisp_Object symbol)
593{ 582{
594 CHECK_SYMBOL (symbol); 583 CHECK_SYMBOL (symbol);
595 if (!EQ (XSYMBOL (symbol)->function, Qunbound))
596 return XSYMBOL (symbol)->function; 584 return XSYMBOL (symbol)->function;
597 xsignal1 (Qvoid_function, symbol);
598} 585}
599 586
600DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, 587DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
@@ -621,46 +608,63 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
621 (register Lisp_Object symbol, Lisp_Object definition) 608 (register Lisp_Object symbol, Lisp_Object definition)
622{ 609{
623 register Lisp_Object function; 610 register Lisp_Object function;
624
625 CHECK_SYMBOL (symbol); 611 CHECK_SYMBOL (symbol);
626 if (NILP (symbol) || EQ (symbol, Qt))
627 xsignal1 (Qsetting_constant, symbol);
628 612
629 function = XSYMBOL (symbol)->function; 613 function = XSYMBOL (symbol)->function;
630 614
631 if (!NILP (Vautoload_queue) && !EQ (function, Qunbound)) 615 if (!NILP (Vautoload_queue) && !NILP (function))
632 Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue); 616 Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
633 617
634 if (CONSP (function) && EQ (XCAR (function), Qautoload)) 618 if (AUTOLOADP (function))
635 Fput (symbol, Qautoload, XCDR (function)); 619 Fput (symbol, Qautoload, XCDR (function));
636 620
637 XSYMBOL (symbol)->function = definition; 621 set_symbol_function (symbol, definition);
638 /* Handle automatic advice activation */ 622
639 if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info)))
640 {
641 call2 (Qad_activate_internal, symbol, Qnil);
642 definition = XSYMBOL (symbol)->function;
643 }
644 return definition; 623 return definition;
645} 624}
646 625
647DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0, 626DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0,
648 doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. 627 doc: /* Set SYMBOL's function definition to DEFINITION.
649Associates the function with the current load file, if any. 628Associates the function with the current load file, if any.
650The optional third argument DOCSTRING specifies the documentation string 629The optional third argument DOCSTRING specifies the documentation string
651for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string 630for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string
652determined by DEFINITION. */) 631determined by DEFINITION.
632The return value is undefined. */)
653 (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring) 633 (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
654{ 634{
655 CHECK_SYMBOL (symbol); 635 CHECK_SYMBOL (symbol);
656 if (CONSP (XSYMBOL (symbol)->function) 636 if (!NILP (Vpurify_flag)
657 && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload)) 637 /* If `definition' is a keymap, immutable (and copying) is wrong. */
658 LOADHIST_ATTACH (Fcons (Qt, symbol)); 638 && !KEYMAPP (definition))
659 definition = Ffset (symbol, definition); 639 definition = Fpurecopy (definition);
660 LOADHIST_ATTACH (Fcons (Qdefun, symbol)); 640
641 {
642 bool autoload = AUTOLOADP (definition);
643 if (NILP (Vpurify_flag) || !autoload)
644 { /* Only add autoload entries after dumping, because the ones before are
645 not useful and else we get loads of them from the loaddefs.el. */
646
647 if (AUTOLOADP (XSYMBOL (symbol)->function))
648 /* Remember that the function was already an autoload. */
649 LOADHIST_ATTACH (Fcons (Qt, symbol));
650 LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
651 }
652 }
653
654 { /* Handle automatic advice activation. */
655 Lisp_Object hook = Fget (symbol, Qdefalias_fset_function);
656 if (!NILP (hook))
657 call2 (hook, symbol, definition);
658 else
659 Ffset (symbol, definition);
660 }
661
661 if (!NILP (docstring)) 662 if (!NILP (docstring))
662 Fput (symbol, Qfunction_documentation, docstring); 663 Fput (symbol, Qfunction_documentation, docstring);
663 return definition; 664 /* We used to return `definition', but now that `defun' and `defmacro' expand
665 to a call to `defalias', we return `symbol' for backward compatibility
666 (bug#11686). */
667 return symbol;
664} 668}
665 669
666DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0, 670DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
@@ -668,7 +672,7 @@ DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
668 (register Lisp_Object symbol, Lisp_Object newplist) 672 (register Lisp_Object symbol, Lisp_Object newplist)
669{ 673{
670 CHECK_SYMBOL (symbol); 674 CHECK_SYMBOL (symbol);
671 XSYMBOL (symbol)->plist = newplist; 675 set_symbol_plist (symbol, newplist);
672 return newplist; 676 return newplist;
673} 677}
674 678
@@ -684,12 +688,10 @@ function with `&rest' args, or `unevalled' for a special form. */)
684 CHECK_SUBR (subr); 688 CHECK_SUBR (subr);
685 minargs = XSUBR (subr)->min_args; 689 minargs = XSUBR (subr)->min_args;
686 maxargs = XSUBR (subr)->max_args; 690 maxargs = XSUBR (subr)->max_args;
687 if (maxargs == MANY) 691 return Fcons (make_number (minargs),
688 return Fcons (make_number (minargs), Qmany); 692 maxargs == MANY ? Qmany
689 else if (maxargs == UNEVALLED) 693 : maxargs == UNEVALLED ? Qunevalled
690 return Fcons (make_number (minargs), Qunevalled); 694 : make_number (maxargs));
691 else
692 return Fcons (make_number (minargs), make_number (maxargs));
693} 695}
694 696
695DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0, 697DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
@@ -711,11 +713,11 @@ Value, if non-nil, is a list \(interactive SPEC). */)
711{ 713{
712 Lisp_Object fun = indirect_function (cmd); /* Check cycles. */ 714 Lisp_Object fun = indirect_function (cmd); /* Check cycles. */
713 715
714 if (NILP (fun) || EQ (fun, Qunbound)) 716 if (NILP (fun))
715 return Qnil; 717 return Qnil;
716 718
717 /* Use an `interactive-form' property if present, analogous to the 719 /* Use an `interactive-form' property if present, analogous to the
718 function-documentation property. */ 720 function-documentation property. */
719 fun = cmd; 721 fun = cmd;
720 while (SYMBOLP (fun)) 722 while (SYMBOLP (fun))
721 { 723 {
@@ -739,6 +741,8 @@ Value, if non-nil, is a list \(interactive SPEC). */)
739 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE) 741 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
740 return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE)); 742 return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
741 } 743 }
744 else if (AUTOLOADP (fun))
745 return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
742 else if (CONSP (fun)) 746 else if (CONSP (fun))
743 { 747 {
744 Lisp_Object funcar = XCAR (fun); 748 Lisp_Object funcar = XCAR (fun);
@@ -746,14 +750,6 @@ Value, if non-nil, is a list \(interactive SPEC). */)
746 return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))); 750 return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
747 else if (EQ (funcar, Qlambda)) 751 else if (EQ (funcar, Qlambda))
748 return Fassq (Qinteractive, Fcdr (XCDR (fun))); 752 return Fassq (Qinteractive, Fcdr (XCDR (fun)));
749 else if (EQ (funcar, Qautoload))
750 {
751 struct gcpro gcpro1;
752 GCPRO1 (cmd);
753 do_autoload (fun, cmd);
754 UNGCPRO;
755 return Finteractive_form (cmd);
756 }
757 } 753 }
758 return Qnil; 754 return Qnil;
759} 755}
@@ -797,10 +793,12 @@ indirect_variable (struct Lisp_Symbol *symbol)
797 793
798DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0, 794DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0,
799 doc: /* Return the variable at the end of OBJECT's variable chain. 795 doc: /* Return the variable at the end of OBJECT's variable chain.
800If OBJECT is a symbol, follow all variable indirections and return the final 796If OBJECT is a symbol, follow its variable indirections (if any), and
801variable. If OBJECT is not a symbol, just return it. 797return the variable at the end of the chain of aliases. See Info node
802Signal a cyclic-variable-indirection error if there is a loop in the 798`(elisp)Variable Aliases'.
803variable chain of symbols. */) 799
800If OBJECT is not a symbol, just return it. If there is a loop in the
801chain of aliases, signal a `cyclic-variable-indirection' error. */)
804 (Lisp_Object object) 802 (Lisp_Object object)
805{ 803{
806 if (SYMBOLP (object)) 804 if (SYMBOLP (object))
@@ -834,7 +832,7 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents)
834 return *XOBJFWD (valcontents)->objvar; 832 return *XOBJFWD (valcontents)->objvar;
835 833
836 case Lisp_Fwd_Buffer_Obj: 834 case Lisp_Fwd_Buffer_Obj:
837 return PER_BUFFER_VALUE (current_buffer, 835 return per_buffer_value (current_buffer,
838 XBUFFER_OBJFWD (valcontents)->offset); 836 XBUFFER_OBJFWD (valcontents)->offset);
839 837
840 case Lisp_Fwd_Kboard_Obj: 838 case Lisp_Fwd_Kboard_Obj:
@@ -851,7 +849,7 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents)
851 don't think anything will break. --lorentey */ 849 don't think anything will break. --lorentey */
852 return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset 850 return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
853 + (char *)FRAME_KBOARD (SELECTED_FRAME ())); 851 + (char *)FRAME_KBOARD (SELECTED_FRAME ()));
854 default: abort (); 852 default: emacs_abort ();
855 } 853 }
856} 854}
857 855
@@ -906,7 +904,7 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
906 b = XBUFFER (lbuf); 904 b = XBUFFER (lbuf);
907 905
908 if (! PER_BUFFER_VALUE_P (b, idx)) 906 if (! PER_BUFFER_VALUE_P (b, idx))
909 PER_BUFFER_VALUE (b, offset) = newval; 907 set_per_buffer_value (b, offset, newval);
910 } 908 }
911 } 909 }
912 break; 910 break;
@@ -917,14 +915,14 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
917 Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype; 915 Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype;
918 916
919 if (!(NILP (type) || NILP (newval) 917 if (!(NILP (type) || NILP (newval)
920 || (XINT (type) == LISP_INT_TAG 918 || (XINT (type) == Lisp_Int0
921 ? INTEGERP (newval) 919 ? INTEGERP (newval)
922 : XTYPE (newval) == XINT (type)))) 920 : XTYPE (newval) == XINT (type))))
923 buffer_slot_type_mismatch (newval, XINT (type)); 921 buffer_slot_type_mismatch (newval, XINT (type));
924 922
925 if (buf == NULL) 923 if (buf == NULL)
926 buf = current_buffer; 924 buf = current_buffer;
927 PER_BUFFER_VALUE (buf, offset) = newval; 925 set_per_buffer_value (buf, offset, newval);
928 } 926 }
929 break; 927 break;
930 928
@@ -937,12 +935,14 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
937 break; 935 break;
938 936
939 default: 937 default:
940 abort (); /* goto def; */ 938 emacs_abort (); /* goto def; */
941 } 939 }
942} 940}
943 941
944/* Set up SYMBOL to refer to its global binding. 942/* Set up SYMBOL to refer to its global binding. This makes it safe
945 This makes it safe to alter the status of other bindings. */ 943 to alter the status of other bindings. BEWARE: this may be called
944 during the mark phase of GC, where we assume that Lisp_Object slots
945 of BLV are marked after this function has changed them. */
946 946
947void 947void
948swap_in_global_binding (struct Lisp_Symbol *symbol) 948swap_in_global_binding (struct Lisp_Symbol *symbol)
@@ -951,16 +951,16 @@ swap_in_global_binding (struct Lisp_Symbol *symbol)
951 951
952 /* Unload the previously loaded binding. */ 952 /* Unload the previously loaded binding. */
953 if (blv->fwd) 953 if (blv->fwd)
954 SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd)); 954 set_blv_value (blv, do_symval_forwarding (blv->fwd));
955 955
956 /* Select the global binding in the symbol. */ 956 /* Select the global binding in the symbol. */
957 blv->valcell = blv->defcell; 957 set_blv_valcell (blv, blv->defcell);
958 if (blv->fwd) 958 if (blv->fwd)
959 store_symval_forwarding (blv->fwd, XCDR (blv->defcell), NULL); 959 store_symval_forwarding (blv->fwd, XCDR (blv->defcell), NULL);
960 960
961 /* Indicate that the global binding is set up now. */ 961 /* Indicate that the global binding is set up now. */
962 blv->where = Qnil; 962 set_blv_where (blv, Qnil);
963 SET_BLV_FOUND (blv, 0); 963 set_blv_found (blv, 0);
964} 964}
965 965
966/* Set up the buffer-local symbol SYMBOL for validity in the current buffer. 966/* Set up the buffer-local symbol SYMBOL for validity in the current buffer.
@@ -988,7 +988,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_
988 /* Unload the previously loaded binding. */ 988 /* Unload the previously loaded binding. */
989 tem1 = blv->valcell; 989 tem1 = blv->valcell;
990 if (blv->fwd) 990 if (blv->fwd)
991 SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd)); 991 set_blv_value (blv, do_symval_forwarding (blv->fwd));
992 /* Choose the new binding. */ 992 /* Choose the new binding. */
993 { 993 {
994 Lisp_Object var; 994 Lisp_Object var;
@@ -996,21 +996,21 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_
996 if (blv->frame_local) 996 if (blv->frame_local)
997 { 997 {
998 tem1 = assq_no_quit (var, XFRAME (selected_frame)->param_alist); 998 tem1 = assq_no_quit (var, XFRAME (selected_frame)->param_alist);
999 blv->where = selected_frame; 999 set_blv_where (blv, selected_frame);
1000 } 1000 }
1001 else 1001 else
1002 { 1002 {
1003 tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist)); 1003 tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist));
1004 XSETBUFFER (blv->where, current_buffer); 1004 set_blv_where (blv, Fcurrent_buffer ());
1005 } 1005 }
1006 } 1006 }
1007 if (!(blv->found = !NILP (tem1))) 1007 if (!(blv->found = !NILP (tem1)))
1008 tem1 = blv->defcell; 1008 tem1 = blv->defcell;
1009 1009
1010 /* Load the new binding. */ 1010 /* Load the new binding. */
1011 blv->valcell = tem1; 1011 set_blv_valcell (blv, tem1);
1012 if (blv->fwd) 1012 if (blv->fwd)
1013 store_symval_forwarding (blv->fwd, BLV_VALUE (blv), NULL); 1013 store_symval_forwarding (blv->fwd, blv_value (blv), NULL);
1014 } 1014 }
1015} 1015}
1016 1016
@@ -1037,12 +1037,12 @@ find_symbol_value (Lisp_Object symbol)
1037 { 1037 {
1038 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); 1038 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
1039 swap_in_symval_forwarding (sym, blv); 1039 swap_in_symval_forwarding (sym, blv);
1040 return blv->fwd ? do_symval_forwarding (blv->fwd) : BLV_VALUE (blv); 1040 return blv->fwd ? do_symval_forwarding (blv->fwd) : blv_value (blv);
1041 } 1041 }
1042 /* FALLTHROUGH */ 1042 /* FALLTHROUGH */
1043 case SYMBOL_FORWARDED: 1043 case SYMBOL_FORWARDED:
1044 return do_symval_forwarding (SYMBOL_FWD (sym)); 1044 return do_symval_forwarding (SYMBOL_FWD (sym));
1045 default: abort (); 1045 default: emacs_abort ();
1046 } 1046 }
1047} 1047}
1048 1048
@@ -1067,52 +1067,53 @@ DEFUN ("set", Fset, Sset, 2, 2, 0,
1067 return newval; 1067 return newval;
1068} 1068}
1069 1069
1070/* Return 1 if SYMBOL currently has a let-binding 1070/* Return true if SYMBOL currently has a let-binding
1071 which was made in the buffer that is now current. */ 1071 which was made in the buffer that is now current. */
1072 1072
1073static int 1073static bool
1074let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) 1074let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
1075{ 1075{
1076 struct specbinding *p; 1076 struct specbinding *p;
1077 1077
1078 for (p = specpdl_ptr - 1; p >= specpdl; p--) 1078 for (p = specpdl_ptr; p > specpdl; )
1079 if (p->func == NULL 1079 if ((--p)->func == NULL
1080 && CONSP (p->symbol)) 1080 && CONSP (p->symbol))
1081 { 1081 {
1082 struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol)); 1082 struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol));
1083 eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS); 1083 eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS);
1084 if (symbol == let_bound_symbol 1084 if (symbol == let_bound_symbol
1085 && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer) 1085 && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer)
1086 break; 1086 return 1;
1087 } 1087 }
1088 1088
1089 return p >= specpdl; 1089 return 0;
1090} 1090}
1091 1091
1092static int 1092static bool
1093let_shadows_global_binding_p (Lisp_Object symbol) 1093let_shadows_global_binding_p (Lisp_Object symbol)
1094{ 1094{
1095 struct specbinding *p; 1095 struct specbinding *p;
1096 1096
1097 for (p = specpdl_ptr - 1; p >= specpdl; p--) 1097 for (p = specpdl_ptr; p > specpdl; )
1098 if (p->func == NULL && EQ (p->symbol, symbol)) 1098 if ((--p)->func == NULL && EQ (p->symbol, symbol))
1099 break; 1099 return 1;
1100 1100
1101 return p >= specpdl; 1101 return 0;
1102} 1102}
1103 1103
1104/* Store the value NEWVAL into SYMBOL. 1104/* Store the value NEWVAL into SYMBOL.
1105 If buffer/frame-locality is an issue, WHERE specifies which context to use. 1105 If buffer/frame-locality is an issue, WHERE specifies which context to use.
1106 (nil stands for the current buffer/frame). 1106 (nil stands for the current buffer/frame).
1107 1107
1108 If BINDFLAG is zero, then if this symbol is supposed to become 1108 If BINDFLAG is false, then if this symbol is supposed to become
1109 local in every buffer where it is set, then we make it local. 1109 local in every buffer where it is set, then we make it local.
1110 If BINDFLAG is nonzero, we don't do that. */ 1110 If BINDFLAG is true, we don't do that. */
1111 1111
1112void 1112void
1113set_internal (register Lisp_Object symbol, register Lisp_Object newval, register Lisp_Object where, int bindflag) 1113set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
1114 bool bindflag)
1114{ 1115{
1115 int voide = EQ (newval, Qunbound); 1116 bool voide = EQ (newval, Qunbound);
1116 struct Lisp_Symbol *sym; 1117 struct Lisp_Symbol *sym;
1117 Lisp_Object tem1; 1118 Lisp_Object tem1;
1118 1119
@@ -1154,7 +1155,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
1154 the default binding is loaded, the loaded binding may be the 1155 the default binding is loaded, the loaded binding may be the
1155 wrong one. */ 1156 wrong one. */
1156 if (!EQ (blv->where, where) 1157 if (!EQ (blv->where, where)
1157 /* Also unload a global binding (if the var is local_if_set). */ 1158 /* Also unload a global binding (if the var is local_if_set). */
1158 || (EQ (blv->valcell, blv->defcell))) 1159 || (EQ (blv->valcell, blv->defcell)))
1159 { 1160 {
1160 /* The currently loaded binding is not necessarily valid. 1161 /* The currently loaded binding is not necessarily valid.
@@ -1162,7 +1163,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
1162 1163
1163 /* Write out `realvalue' to the old loaded binding. */ 1164 /* Write out `realvalue' to the old loaded binding. */
1164 if (blv->fwd) 1165 if (blv->fwd)
1165 SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd)); 1166 set_blv_value (blv, do_symval_forwarding (blv->fwd));
1166 1167
1167 /* Find the new binding. */ 1168 /* Find the new binding. */
1168 XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */ 1169 XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */
@@ -1170,7 +1171,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
1170 (blv->frame_local 1171 (blv->frame_local
1171 ? XFRAME (where)->param_alist 1172 ? XFRAME (where)->param_alist
1172 : BVAR (XBUFFER (where), local_var_alist))); 1173 : BVAR (XBUFFER (where), local_var_alist)));
1173 blv->where = where; 1174 set_blv_where (blv, where);
1174 blv->found = 1; 1175 blv->found = 1;
1175 1176
1176 if (NILP (tem1)) 1177 if (NILP (tem1))
@@ -1200,17 +1201,18 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
1200 bindings, not for frame-local bindings. */ 1201 bindings, not for frame-local bindings. */
1201 eassert (!blv->frame_local); 1202 eassert (!blv->frame_local);
1202 tem1 = Fcons (symbol, XCDR (blv->defcell)); 1203 tem1 = Fcons (symbol, XCDR (blv->defcell));
1203 BVAR (XBUFFER (where), local_var_alist) 1204 bset_local_var_alist
1204 = Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)); 1205 (XBUFFER (where),
1206 Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)));
1205 } 1207 }
1206 } 1208 }
1207 1209
1208 /* Record which binding is now loaded. */ 1210 /* Record which binding is now loaded. */
1209 blv->valcell = tem1; 1211 set_blv_valcell (blv, tem1);
1210 } 1212 }
1211 1213
1212 /* Store the new value in the cons cell. */ 1214 /* Store the new value in the cons cell. */
1213 SET_BLV_VALUE (blv, newval); 1215 set_blv_value (blv, newval);
1214 1216
1215 if (blv->fwd) 1217 if (blv->fwd)
1216 { 1218 {
@@ -1250,7 +1252,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
1250 store_symval_forwarding (/* sym, */ innercontents, newval, buf); 1252 store_symval_forwarding (/* sym, */ innercontents, newval, buf);
1251 break; 1253 break;
1252 } 1254 }
1253 default: abort (); 1255 default: emacs_abort ();
1254 } 1256 }
1255 return; 1257 return;
1256} 1258}
@@ -1295,13 +1297,13 @@ default_value (Lisp_Object symbol)
1295 { 1297 {
1296 int offset = XBUFFER_OBJFWD (valcontents)->offset; 1298 int offset = XBUFFER_OBJFWD (valcontents)->offset;
1297 if (PER_BUFFER_IDX (offset) != 0) 1299 if (PER_BUFFER_IDX (offset) != 0)
1298 return PER_BUFFER_DEFAULT (offset); 1300 return per_buffer_default (offset);
1299 } 1301 }
1300 1302
1301 /* For other variables, get the current value. */ 1303 /* For other variables, get the current value. */
1302 return do_symval_forwarding (valcontents); 1304 return do_symval_forwarding (valcontents);
1303 } 1305 }
1304 default: abort (); 1306 default: emacs_abort ();
1305 } 1307 }
1306} 1308}
1307 1309
@@ -1382,7 +1384,7 @@ for this variable. */)
1382 int offset = XBUFFER_OBJFWD (valcontents)->offset; 1384 int offset = XBUFFER_OBJFWD (valcontents)->offset;
1383 int idx = PER_BUFFER_IDX (offset); 1385 int idx = PER_BUFFER_IDX (offset);
1384 1386
1385 PER_BUFFER_DEFAULT (offset) = value; 1387 set_per_buffer_default (offset, value);
1386 1388
1387 /* If this variable is not always local in all buffers, 1389 /* If this variable is not always local in all buffers,
1388 set it in the buffers that don't nominally have a local value. */ 1390 set it in the buffers that don't nominally have a local value. */
@@ -1390,16 +1392,16 @@ for this variable. */)
1390 { 1392 {
1391 struct buffer *b; 1393 struct buffer *b;
1392 1394
1393 for (b = all_buffers; b; b = b->header.next.buffer) 1395 FOR_EACH_BUFFER (b)
1394 if (!PER_BUFFER_VALUE_P (b, idx)) 1396 if (!PER_BUFFER_VALUE_P (b, idx))
1395 PER_BUFFER_VALUE (b, offset) = value; 1397 set_per_buffer_value (b, offset, value);
1396 } 1398 }
1397 return value; 1399 return value;
1398 } 1400 }
1399 else 1401 else
1400 return Fset (symbol, value); 1402 return Fset (symbol, value);
1401 } 1403 }
1402 default: abort (); 1404 default: emacs_abort ();
1403 } 1405 }
1404} 1406}
1405 1407
@@ -1450,10 +1452,10 @@ union Lisp_Val_Fwd
1450 }; 1452 };
1451 1453
1452static struct Lisp_Buffer_Local_Value * 1454static struct Lisp_Buffer_Local_Value *
1453make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents) 1455make_blv (struct Lisp_Symbol *sym, bool forwarded,
1456 union Lisp_Val_Fwd valcontents)
1454{ 1457{
1455 struct Lisp_Buffer_Local_Value *blv 1458 struct Lisp_Buffer_Local_Value *blv = xmalloc (sizeof *blv);
1456 = xmalloc (sizeof (struct Lisp_Buffer_Local_Value));
1457 Lisp_Object symbol; 1459 Lisp_Object symbol;
1458 Lisp_Object tem; 1460 Lisp_Object tem;
1459 1461
@@ -1467,12 +1469,12 @@ make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents
1467 eassert (!(forwarded && BUFFER_OBJFWDP (valcontents.fwd))); 1469 eassert (!(forwarded && BUFFER_OBJFWDP (valcontents.fwd)));
1468 eassert (!(forwarded && KBOARD_OBJFWDP (valcontents.fwd))); 1470 eassert (!(forwarded && KBOARD_OBJFWDP (valcontents.fwd)));
1469 blv->fwd = forwarded ? valcontents.fwd : NULL; 1471 blv->fwd = forwarded ? valcontents.fwd : NULL;
1470 blv->where = Qnil; 1472 set_blv_where (blv, Qnil);
1471 blv->frame_local = 0; 1473 blv->frame_local = 0;
1472 blv->local_if_set = 0; 1474 blv->local_if_set = 0;
1473 blv->defcell = tem; 1475 set_blv_defcell (blv, tem);
1474 blv->valcell = tem; 1476 set_blv_valcell (blv, tem);
1475 SET_BLV_FOUND (blv, 0); 1477 set_blv_found (blv, 0);
1476 return blv; 1478 return blv;
1477} 1479}
1478 1480
@@ -1494,8 +1496,8 @@ The function `default-value' gets the default value and `set-default' sets it.
1494{ 1496{
1495 struct Lisp_Symbol *sym; 1497 struct Lisp_Symbol *sym;
1496 struct Lisp_Buffer_Local_Value *blv = NULL; 1498 struct Lisp_Buffer_Local_Value *blv = NULL;
1497 union Lisp_Val_Fwd valcontents IF_LINT (= {0}); 1499 union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
1498 int forwarded IF_LINT (= 0); 1500 bool forwarded IF_LINT (= 0);
1499 1501
1500 CHECK_SYMBOL (variable); 1502 CHECK_SYMBOL (variable);
1501 sym = XSYMBOL (variable); 1503 sym = XSYMBOL (variable);
@@ -1523,7 +1525,7 @@ The function `default-value' gets the default value and `set-default' sets it.
1523 else if (BUFFER_OBJFWDP (valcontents.fwd)) 1525 else if (BUFFER_OBJFWDP (valcontents.fwd))
1524 return variable; 1526 return variable;
1525 break; 1527 break;
1526 default: abort (); 1528 default: emacs_abort ();
1527 } 1529 }
1528 1530
1529 if (sym->constant) 1531 if (sym->constant)
@@ -1567,11 +1569,11 @@ See also `make-variable-buffer-local'.
1567 1569
1568Do not use `make-local-variable' to make a hook variable buffer-local. 1570Do not use `make-local-variable' to make a hook variable buffer-local.
1569Instead, use `add-hook' and specify t for the LOCAL argument. */) 1571Instead, use `add-hook' and specify t for the LOCAL argument. */)
1570 (register Lisp_Object variable) 1572 (Lisp_Object variable)
1571{ 1573{
1572 register Lisp_Object tem; 1574 Lisp_Object tem;
1573 int forwarded IF_LINT (= 0); 1575 bool forwarded IF_LINT (= 0);
1574 union Lisp_Val_Fwd valcontents IF_LINT (= {0}); 1576 union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
1575 struct Lisp_Symbol *sym; 1577 struct Lisp_Symbol *sym;
1576 struct Lisp_Buffer_Local_Value *blv = NULL; 1578 struct Lisp_Buffer_Local_Value *blv = NULL;
1577 1579
@@ -1596,7 +1598,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
1596 error ("Symbol %s may not be buffer-local", 1598 error ("Symbol %s may not be buffer-local",
1597 SDATA (SYMBOL_NAME (variable))); 1599 SDATA (SYMBOL_NAME (variable)));
1598 break; 1600 break;
1599 default: abort (); 1601 default: emacs_abort ();
1600 } 1602 }
1601 1603
1602 if (sym->constant) 1604 if (sym->constant)
@@ -1641,17 +1643,16 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
1641 default value. */ 1643 default value. */
1642 find_symbol_value (variable); 1644 find_symbol_value (variable);
1643 1645
1644 BVAR (current_buffer, local_var_alist) 1646 bset_local_var_alist
1645 = Fcons (Fcons (variable, XCDR (blv->defcell)), 1647 (current_buffer,
1646 BVAR (current_buffer, local_var_alist)); 1648 Fcons (Fcons (variable, XCDR (blv->defcell)),
1649 BVAR (current_buffer, local_var_alist)));
1647 1650
1648 /* Make sure symbol does not think it is set up for this buffer; 1651 /* Make sure symbol does not think it is set up for this buffer;
1649 force it to look once again for this buffer's value. */ 1652 force it to look once again for this buffer's value. */
1650 if (current_buffer == XBUFFER (blv->where)) 1653 if (current_buffer == XBUFFER (blv->where))
1651 blv->where = Qnil; 1654 set_blv_where (blv, Qnil);
1652 /* blv->valcell = blv->defcell; 1655 set_blv_found (blv, 0);
1653 * SET_BLV_FOUND (blv, 0); */
1654 blv->found = 0;
1655 } 1656 }
1656 1657
1657 /* If the symbol forwards into a C variable, then load the binding 1658 /* If the symbol forwards into a C variable, then load the binding
@@ -1693,8 +1694,8 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
1693 if (idx > 0) 1694 if (idx > 0)
1694 { 1695 {
1695 SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0); 1696 SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0);
1696 PER_BUFFER_VALUE (current_buffer, offset) 1697 set_per_buffer_value (current_buffer, offset,
1697 = PER_BUFFER_DEFAULT (offset); 1698 per_buffer_default (offset));
1698 } 1699 }
1699 } 1700 }
1700 return variable; 1701 return variable;
@@ -1704,15 +1705,16 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
1704 if (blv->frame_local) 1705 if (blv->frame_local)
1705 return variable; 1706 return variable;
1706 break; 1707 break;
1707 default: abort (); 1708 default: emacs_abort ();
1708 } 1709 }
1709 1710
1710 /* Get rid of this buffer's alist element, if any. */ 1711 /* Get rid of this buffer's alist element, if any. */
1711 XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ 1712 XSETSYMBOL (variable, sym); /* Propagate variable indirection. */
1712 tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); 1713 tem = Fassq (variable, BVAR (current_buffer, local_var_alist));
1713 if (!NILP (tem)) 1714 if (!NILP (tem))
1714 BVAR (current_buffer, local_var_alist) 1715 bset_local_var_alist
1715 = Fdelq (tem, BVAR (current_buffer, local_var_alist)); 1716 (current_buffer,
1717 Fdelq (tem, BVAR (current_buffer, local_var_alist)));
1716 1718
1717 /* If the symbol is set up with the current buffer's binding 1719 /* If the symbol is set up with the current buffer's binding
1718 loaded, recompute its value. We have to do it now, or else 1720 loaded, recompute its value. We have to do it now, or else
@@ -1721,9 +1723,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
1721 Lisp_Object buf; XSETBUFFER (buf, current_buffer); 1723 Lisp_Object buf; XSETBUFFER (buf, current_buffer);
1722 if (EQ (buf, blv->where)) 1724 if (EQ (buf, blv->where))
1723 { 1725 {
1724 blv->where = Qnil; 1726 set_blv_where (blv, Qnil);
1725 /* blv->valcell = blv->defcell;
1726 * SET_BLV_FOUND (blv, 0); */
1727 blv->found = 0; 1727 blv->found = 0;
1728 find_symbol_value (variable); 1728 find_symbol_value (variable);
1729 } 1729 }
@@ -1756,9 +1756,9 @@ is to set the VARIABLE frame parameter of that frame. See
1756Note that since Emacs 23.1, variables cannot be both buffer-local and 1756Note that since Emacs 23.1, variables cannot be both buffer-local and
1757frame-local any more (buffer-local bindings used to take precedence over 1757frame-local any more (buffer-local bindings used to take precedence over
1758frame-local bindings). */) 1758frame-local bindings). */)
1759 (register Lisp_Object variable) 1759 (Lisp_Object variable)
1760{ 1760{
1761 int forwarded; 1761 bool forwarded;
1762 union Lisp_Val_Fwd valcontents; 1762 union Lisp_Val_Fwd valcontents;
1763 struct Lisp_Symbol *sym; 1763 struct Lisp_Symbol *sym;
1764 struct Lisp_Buffer_Local_Value *blv = NULL; 1764 struct Lisp_Buffer_Local_Value *blv = NULL;
@@ -1787,7 +1787,7 @@ frame-local bindings). */)
1787 error ("Symbol %s may not be frame-local", 1787 error ("Symbol %s may not be frame-local",
1788 SDATA (SYMBOL_NAME (variable))); 1788 SDATA (SYMBOL_NAME (variable)));
1789 break; 1789 break;
1790 default: abort (); 1790 default: emacs_abort ();
1791 } 1791 }
1792 1792
1793 if (sym->constant) 1793 if (sym->constant)
@@ -1845,11 +1845,11 @@ BUFFER defaults to the current buffer. */)
1845 if (EQ (variable, XCAR (elt))) 1845 if (EQ (variable, XCAR (elt)))
1846 { 1846 {
1847 eassert (!blv->frame_local); 1847 eassert (!blv->frame_local);
1848 eassert (BLV_FOUND (blv) || !EQ (blv->where, tmp)); 1848 eassert (blv_found (blv) || !EQ (blv->where, tmp));
1849 return Qt; 1849 return Qt;
1850 } 1850 }
1851 } 1851 }
1852 eassert (!BLV_FOUND (blv) || !EQ (blv->where, tmp)); 1852 eassert (!blv_found (blv) || !EQ (blv->where, tmp));
1853 return Qnil; 1853 return Qnil;
1854 } 1854 }
1855 case SYMBOL_FORWARDED: 1855 case SYMBOL_FORWARDED:
@@ -1864,18 +1864,18 @@ BUFFER defaults to the current buffer. */)
1864 } 1864 }
1865 return Qnil; 1865 return Qnil;
1866 } 1866 }
1867 default: abort (); 1867 default: emacs_abort ();
1868 } 1868 }
1869} 1869}
1870 1870
1871DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p, 1871DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p,
1872 1, 2, 0, 1872 1, 2, 0,
1873 doc: /* Non-nil if VARIABLE will be local in buffer BUFFER when set there. 1873 doc: /* Non-nil if VARIABLE is local in buffer BUFFER when set there.
1874More precisely, this means that setting the variable \(with `set' or`setq'), 1874BUFFER defaults to the current buffer.
1875while it does not have a `let'-style binding that was made in BUFFER, 1875
1876will produce a buffer local binding. See Info node 1876More precisely, return non-nil if either VARIABLE already has a local
1877`(elisp)Creating Buffer-Local'. 1877value in BUFFER, or if VARIABLE is automatically buffer-local (see
1878BUFFER defaults to the current buffer. */) 1878`make-variable-buffer-local'). */)
1879 (register Lisp_Object variable, Lisp_Object buffer) 1879 (register Lisp_Object variable, Lisp_Object buffer)
1880{ 1880{
1881 struct Lisp_Symbol *sym; 1881 struct Lisp_Symbol *sym;
@@ -1899,7 +1899,7 @@ BUFFER defaults to the current buffer. */)
1899 case SYMBOL_FORWARDED: 1899 case SYMBOL_FORWARDED:
1900 /* All BUFFER_OBJFWD slots become local if they are set. */ 1900 /* All BUFFER_OBJFWD slots become local if they are set. */
1901 return (BUFFER_OBJFWDP (SYMBOL_FWD (sym)) ? Qt : Qnil); 1901 return (BUFFER_OBJFWDP (SYMBOL_FWD (sym)) ? Qt : Qnil);
1902 default: abort (); 1902 default: emacs_abort ();
1903 } 1903 }
1904} 1904}
1905 1905
@@ -1939,11 +1939,11 @@ If the current binding is global (the default), the value is nil. */)
1939 if (!NILP (Flocal_variable_p (variable, Qnil))) 1939 if (!NILP (Flocal_variable_p (variable, Qnil)))
1940 return Fcurrent_buffer (); 1940 return Fcurrent_buffer ();
1941 else if (sym->redirect == SYMBOL_LOCALIZED 1941 else if (sym->redirect == SYMBOL_LOCALIZED
1942 && BLV_FOUND (SYMBOL_BLV (sym))) 1942 && blv_found (SYMBOL_BLV (sym)))
1943 return SYMBOL_BLV (sym)->where; 1943 return SYMBOL_BLV (sym)->where;
1944 else 1944 else
1945 return Qnil; 1945 return Qnil;
1946 default: abort (); 1946 default: emacs_abort ();
1947 } 1947 }
1948} 1948}
1949 1949
@@ -2007,10 +2007,10 @@ indirect_function (register Lisp_Object object)
2007 2007
2008 for (;;) 2008 for (;;)
2009 { 2009 {
2010 if (!SYMBOLP (hare) || EQ (hare, Qunbound)) 2010 if (!SYMBOLP (hare) || NILP (hare))
2011 break; 2011 break;
2012 hare = XSYMBOL (hare)->function; 2012 hare = XSYMBOL (hare)->function;
2013 if (!SYMBOLP (hare) || EQ (hare, Qunbound)) 2013 if (!SYMBOLP (hare) || NILP (hare))
2014 break; 2014 break;
2015 hare = XSYMBOL (hare)->function; 2015 hare = XSYMBOL (hare)->function;
2016 2016
@@ -2037,10 +2037,10 @@ function chain of symbols. */)
2037 2037
2038 /* Optimize for no indirection. */ 2038 /* Optimize for no indirection. */
2039 result = object; 2039 result = object;
2040 if (SYMBOLP (result) && !EQ (result, Qunbound) 2040 if (SYMBOLP (result) && !NILP (result)
2041 && (result = XSYMBOL (result)->function, SYMBOLP (result))) 2041 && (result = XSYMBOL (result)->function, SYMBOLP (result)))
2042 result = indirect_function (result); 2042 result = indirect_function (result);
2043 if (!EQ (result, Qunbound)) 2043 if (!NILP (result))
2044 return result; 2044 return result;
2045 2045
2046 if (NILP (noerror)) 2046 if (NILP (noerror))
@@ -2049,7 +2049,7 @@ function chain of symbols. */)
2049 return Qnil; 2049 return Qnil;
2050} 2050}
2051 2051
2052/* Extract and set vector and string elements */ 2052/* Extract and set vector and string elements. */
2053 2053
2054DEFUN ("aref", Faref, Saref, 2, 2, 0, 2054DEFUN ("aref", Faref, Saref, 2, 2, 0,
2055 doc: /* Return the element of ARRAY at index IDX. 2055 doc: /* Return the element of ARRAY at index IDX.
@@ -2064,7 +2064,7 @@ or a byte-code object. IDX starts at 0. */)
2064 if (STRINGP (array)) 2064 if (STRINGP (array))
2065 { 2065 {
2066 int c; 2066 int c;
2067 EMACS_INT idxval_byte; 2067 ptrdiff_t idxval_byte;
2068 2068
2069 if (idxval < 0 || idxval >= SCHARS (array)) 2069 if (idxval < 0 || idxval >= SCHARS (array))
2070 args_out_of_range (array, idx); 2070 args_out_of_range (array, idx);
@@ -2092,7 +2092,7 @@ or a byte-code object. IDX starts at 0. */)
2092 } 2092 }
2093 else 2093 else
2094 { 2094 {
2095 int size = 0; 2095 ptrdiff_t size = 0;
2096 if (VECTORP (array)) 2096 if (VECTORP (array))
2097 size = ASIZE (array); 2097 size = ASIZE (array);
2098 else if (COMPILEDP (array)) 2098 else if (COMPILEDP (array))
@@ -2123,7 +2123,7 @@ bool-vector. IDX starts at 0. */)
2123 { 2123 {
2124 if (idxval < 0 || idxval >= ASIZE (array)) 2124 if (idxval < 0 || idxval >= ASIZE (array))
2125 args_out_of_range (array, idx); 2125 args_out_of_range (array, idx);
2126 XVECTOR (array)->contents[idxval] = newelt; 2126 ASET (array, idxval, newelt);
2127 } 2127 }
2128 else if (BOOL_VECTOR_P (array)) 2128 else if (BOOL_VECTOR_P (array))
2129 { 2129 {
@@ -2156,7 +2156,8 @@ bool-vector. IDX starts at 0. */)
2156 2156
2157 if (STRING_MULTIBYTE (array)) 2157 if (STRING_MULTIBYTE (array))
2158 { 2158 {
2159 EMACS_INT idxval_byte, prev_bytes, new_bytes, nbytes; 2159 ptrdiff_t idxval_byte, nbytes;
2160 int prev_bytes, new_bytes;
2160 unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; 2161 unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
2161 2162
2162 nbytes = SBYTES (array); 2163 nbytes = SBYTES (array);
@@ -2167,11 +2168,10 @@ bool-vector. IDX starts at 0. */)
2167 if (prev_bytes != new_bytes) 2168 if (prev_bytes != new_bytes)
2168 { 2169 {
2169 /* We must relocate the string data. */ 2170 /* We must relocate the string data. */
2170 EMACS_INT nchars = SCHARS (array); 2171 ptrdiff_t nchars = SCHARS (array);
2171 unsigned char *str;
2172 USE_SAFE_ALLOCA; 2172 USE_SAFE_ALLOCA;
2173 unsigned char *str = SAFE_ALLOCA (nbytes);
2173 2174
2174 SAFE_ALLOCA (str, unsigned char *, nbytes);
2175 memcpy (str, SDATA (array), nbytes); 2175 memcpy (str, SDATA (array), nbytes);
2176 allocate_string_data (XSTRING (array), nchars, 2176 allocate_string_data (XSTRING (array), nchars,
2177 nbytes + new_bytes - prev_bytes); 2177 nbytes + new_bytes - prev_bytes);
@@ -2214,7 +2214,7 @@ static Lisp_Object
2214arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison) 2214arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
2215{ 2215{
2216 double f1 = 0, f2 = 0; 2216 double f1 = 0, f2 = 0;
2217 int floatp = 0; 2217 bool floatp = 0;
2218 2218
2219 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1); 2219 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1);
2220 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2); 2220 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2);
@@ -2259,7 +2259,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
2259 return Qnil; 2259 return Qnil;
2260 2260
2261 default: 2261 default:
2262 abort (); 2262 emacs_abort ();
2263 } 2263 }
2264} 2264}
2265 2265
@@ -2331,7 +2331,7 @@ DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
2331uintmax_t 2331uintmax_t
2332cons_to_unsigned (Lisp_Object c, uintmax_t max) 2332cons_to_unsigned (Lisp_Object c, uintmax_t max)
2333{ 2333{
2334 int valid = 0; 2334 bool valid = 0;
2335 uintmax_t val IF_LINT (= 0); 2335 uintmax_t val IF_LINT (= 0);
2336 if (INTEGERP (c)) 2336 if (INTEGERP (c))
2337 { 2337 {
@@ -2384,7 +2384,7 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max)
2384intmax_t 2384intmax_t
2385cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) 2385cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
2386{ 2386{
2387 int valid = 0; 2387 bool valid = 0;
2388 intmax_t val IF_LINT (= 0); 2388 intmax_t val IF_LINT (= 0);
2389 if (INTEGERP (c)) 2389 if (INTEGERP (c))
2390 { 2390 {
@@ -2437,20 +2437,17 @@ Uses a minus sign if negative.
2437NUMBER may be an integer or a floating point number. */) 2437NUMBER may be an integer or a floating point number. */)
2438 (Lisp_Object number) 2438 (Lisp_Object number)
2439{ 2439{
2440 char buffer[VALBITS]; 2440 char buffer[max (FLOAT_TO_STRING_BUFSIZE, INT_BUFSIZE_BOUND (EMACS_INT))];
2441 int len;
2441 2442
2442 CHECK_NUMBER_OR_FLOAT (number); 2443 CHECK_NUMBER_OR_FLOAT (number);
2443 2444
2444 if (FLOATP (number)) 2445 if (FLOATP (number))
2445 { 2446 len = float_to_string (buffer, XFLOAT_DATA (number));
2446 char pigbuf[FLOAT_TO_STRING_BUFSIZE]; 2447 else
2447 2448 len = sprintf (buffer, "%"pI"d", XINT (number));
2448 float_to_string (pigbuf, XFLOAT_DATA (number));
2449 return build_string (pigbuf);
2450 }
2451 2449
2452 sprintf (buffer, "%"pI"d", XINT (number)); 2450 return make_unibyte_string (buffer, len);
2453 return build_string (buffer);
2454} 2451}
2455 2452
2456DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0, 2453DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0,
@@ -2474,9 +2471,9 @@ If the base used is not 10, STRING is always parsed as integer. */)
2474 else 2471 else
2475 { 2472 {
2476 CHECK_NUMBER (base); 2473 CHECK_NUMBER (base);
2477 b = XINT (base); 2474 if (! (2 <= XINT (base) && XINT (base) <= 16))
2478 if (b < 2 || b > 16)
2479 xsignal1 (Qargs_out_of_range, base); 2475 xsignal1 (Qargs_out_of_range, base);
2476 b = XINT (base);
2480 } 2477 }
2481 2478
2482 p = SSDATA (string); 2479 p = SSDATA (string);
@@ -2505,16 +2502,13 @@ static Lisp_Object float_arith_driver (double, ptrdiff_t, enum arithop,
2505static Lisp_Object 2502static Lisp_Object
2506arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) 2503arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
2507{ 2504{
2508 register Lisp_Object val; 2505 Lisp_Object val;
2509 ptrdiff_t argnum; 2506 ptrdiff_t argnum, ok_args;
2510 register EMACS_INT accum = 0; 2507 EMACS_INT accum = 0;
2511 register EMACS_INT next; 2508 EMACS_INT next, ok_accum;
2512 2509 bool overflow = 0;
2513 int overflow = 0;
2514 ptrdiff_t ok_args;
2515 EMACS_INT ok_accum;
2516 2510
2517 switch (SWITCH_ENUM_CAST (code)) 2511 switch (code)
2518 { 2512 {
2519 case Alogior: 2513 case Alogior:
2520 case Alogxor: 2514 case Alogxor:
@@ -2549,7 +2543,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
2549 nargs, args); 2543 nargs, args);
2550 args[argnum] = val; 2544 args[argnum] = val;
2551 next = XINT (args[argnum]); 2545 next = XINT (args[argnum]);
2552 switch (SWITCH_ENUM_CAST (code)) 2546 switch (code)
2553 { 2547 {
2554 case Aadd: 2548 case Aadd:
2555 if (INT_ADD_OVERFLOW (accum, next)) 2549 if (INT_ADD_OVERFLOW (accum, next))
@@ -2635,7 +2629,7 @@ float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code,
2635 args[argnum] = val; /* runs into a compiler bug. */ 2629 args[argnum] = val; /* runs into a compiler bug. */
2636 next = XINT (args[argnum]); 2630 next = XINT (args[argnum]);
2637 } 2631 }
2638 switch (SWITCH_ENUM_CAST (code)) 2632 switch (code)
2639 { 2633 {
2640 case Aadd: 2634 case Aadd:
2641 accum += next; 2635 accum += next;
@@ -2701,10 +2695,10 @@ usage: (* &rest NUMBERS-OR-MARKERS) */)
2701 return arith_driver (Amult, nargs, args); 2695 return arith_driver (Amult, nargs, args);
2702} 2696}
2703 2697
2704DEFUN ("/", Fquo, Squo, 2, MANY, 0, 2698DEFUN ("/", Fquo, Squo, 1, MANY, 0,
2705 doc: /* Return first argument divided by all the remaining arguments. 2699 doc: /* Return first argument divided by all the remaining arguments.
2706The arguments must be numbers or markers. 2700The arguments must be numbers or markers.
2707usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */) 2701usage: (/ DIVIDEND &rest DIVISORS) */)
2708 (ptrdiff_t nargs, Lisp_Object *args) 2702 (ptrdiff_t nargs, Lisp_Object *args)
2709{ 2703{
2710 ptrdiff_t argnum; 2704 ptrdiff_t argnum;
@@ -2724,35 +2718,13 @@ Both must be integers or markers. */)
2724 CHECK_NUMBER_COERCE_MARKER (x); 2718 CHECK_NUMBER_COERCE_MARKER (x);
2725 CHECK_NUMBER_COERCE_MARKER (y); 2719 CHECK_NUMBER_COERCE_MARKER (y);
2726 2720
2727 if (XFASTINT (y) == 0) 2721 if (XINT (y) == 0)
2728 xsignal0 (Qarith_error); 2722 xsignal0 (Qarith_error);
2729 2723
2730 XSETINT (val, XINT (x) % XINT (y)); 2724 XSETINT (val, XINT (x) % XINT (y));
2731 return val; 2725 return val;
2732} 2726}
2733 2727
2734#ifndef HAVE_FMOD
2735double
2736fmod (double f1, double f2)
2737{
2738 double r = f1;
2739
2740 if (f2 < 0.0)
2741 f2 = -f2;
2742
2743 /* If the magnitude of the result exceeds that of the divisor, or
2744 the sign of the result does not agree with that of the dividend,
2745 iterate with the reduced value. This does not yield a
2746 particularly accurate result, but at least it will be in the
2747 range promised by fmod. */
2748 do
2749 r -= f2 * floor (r / f2);
2750 while (f2 <= (r < 0 ? -r : r) || ((r < 0) != (f1 < 0) && ! isnan (r)));
2751
2752 return r;
2753}
2754#endif /* ! HAVE_FMOD */
2755
2756DEFUN ("mod", Fmod, Smod, 2, 2, 0, 2728DEFUN ("mod", Fmod, Smod, 2, 2, 0,
2757 doc: /* Return X modulo Y. 2729 doc: /* Return X modulo Y.
2758The result falls between zero (inclusive) and Y (exclusive). 2730The result falls between zero (inclusive) and Y (exclusive).
@@ -2937,6 +2909,7 @@ syms_of_data (void)
2937 DEFSYM (Qtop_level, "top-level"); 2909 DEFSYM (Qtop_level, "top-level");
2938 2910
2939 DEFSYM (Qerror, "error"); 2911 DEFSYM (Qerror, "error");
2912 DEFSYM (Quser_error, "user-error");
2940 DEFSYM (Qquit, "quit"); 2913 DEFSYM (Qquit, "quit");
2941 DEFSYM (Qwrong_type_argument, "wrong-type-argument"); 2914 DEFSYM (Qwrong_type_argument, "wrong-type-argument");
2942 DEFSYM (Qargs_out_of_range, "args-out-of-range"); 2915 DEFSYM (Qargs_out_of_range, "args-out-of-range");
@@ -3002,104 +2975,44 @@ syms_of_data (void)
3002 Fput (Qerror, Qerror_conditions, 2975 Fput (Qerror, Qerror_conditions,
3003 error_tail); 2976 error_tail);
3004 Fput (Qerror, Qerror_message, 2977 Fput (Qerror, Qerror_message,
3005 make_pure_c_string ("error")); 2978 build_pure_c_string ("error"));
3006 2979
3007 Fput (Qquit, Qerror_conditions, 2980#define PUT_ERROR(sym, tail, msg) \
3008 pure_cons (Qquit, Qnil)); 2981 Fput (sym, Qerror_conditions, pure_cons (sym, tail)); \
3009 Fput (Qquit, Qerror_message, 2982 Fput (sym, Qerror_message, build_pure_c_string (msg))
3010 make_pure_c_string ("Quit")); 2983
3011 2984 PUT_ERROR (Qquit, Qnil, "Quit");
3012 Fput (Qwrong_type_argument, Qerror_conditions, 2985
3013 pure_cons (Qwrong_type_argument, error_tail)); 2986 PUT_ERROR (Quser_error, error_tail, "");
3014 Fput (Qwrong_type_argument, Qerror_message, 2987 PUT_ERROR (Qwrong_type_argument, error_tail, "Wrong type argument");
3015 make_pure_c_string ("Wrong type argument")); 2988 PUT_ERROR (Qargs_out_of_range, error_tail, "Args out of range");
3016 2989 PUT_ERROR (Qvoid_function, error_tail,
3017 Fput (Qargs_out_of_range, Qerror_conditions, 2990 "Symbol's function definition is void");
3018 pure_cons (Qargs_out_of_range, error_tail)); 2991 PUT_ERROR (Qcyclic_function_indirection, error_tail,
3019 Fput (Qargs_out_of_range, Qerror_message, 2992 "Symbol's chain of function indirections contains a loop");
3020 make_pure_c_string ("Args out of range")); 2993 PUT_ERROR (Qcyclic_variable_indirection, error_tail,
3021 2994 "Symbol's chain of variable indirections contains a loop");
3022 Fput (Qvoid_function, Qerror_conditions,
3023 pure_cons (Qvoid_function, error_tail));
3024 Fput (Qvoid_function, Qerror_message,
3025 make_pure_c_string ("Symbol's function definition is void"));
3026
3027 Fput (Qcyclic_function_indirection, Qerror_conditions,
3028 pure_cons (Qcyclic_function_indirection, error_tail));
3029 Fput (Qcyclic_function_indirection, Qerror_message,
3030 make_pure_c_string ("Symbol's chain of function indirections contains a loop"));
3031
3032 Fput (Qcyclic_variable_indirection, Qerror_conditions,
3033 pure_cons (Qcyclic_variable_indirection, error_tail));
3034 Fput (Qcyclic_variable_indirection, Qerror_message,
3035 make_pure_c_string ("Symbol's chain of variable indirections contains a loop"));
3036
3037 DEFSYM (Qcircular_list, "circular-list"); 2995 DEFSYM (Qcircular_list, "circular-list");
3038 Fput (Qcircular_list, Qerror_conditions, 2996 PUT_ERROR (Qcircular_list, error_tail, "List contains a loop");
3039 pure_cons (Qcircular_list, error_tail)); 2997 PUT_ERROR (Qvoid_variable, error_tail, "Symbol's value as variable is void");
3040 Fput (Qcircular_list, Qerror_message, 2998 PUT_ERROR (Qsetting_constant, error_tail,
3041 make_pure_c_string ("List contains a loop")); 2999 "Attempt to set a constant symbol");
3042 3000 PUT_ERROR (Qinvalid_read_syntax, error_tail, "Invalid read syntax");
3043 Fput (Qvoid_variable, Qerror_conditions, 3001 PUT_ERROR (Qinvalid_function, error_tail, "Invalid function");
3044 pure_cons (Qvoid_variable, error_tail)); 3002 PUT_ERROR (Qwrong_number_of_arguments, error_tail,
3045 Fput (Qvoid_variable, Qerror_message, 3003 "Wrong number of arguments");
3046 make_pure_c_string ("Symbol's value as variable is void")); 3004 PUT_ERROR (Qno_catch, error_tail, "No catch for tag");
3047 3005 PUT_ERROR (Qend_of_file, error_tail, "End of file during parsing");
3048 Fput (Qsetting_constant, Qerror_conditions,
3049 pure_cons (Qsetting_constant, error_tail));
3050 Fput (Qsetting_constant, Qerror_message,
3051 make_pure_c_string ("Attempt to set a constant symbol"));
3052
3053 Fput (Qinvalid_read_syntax, Qerror_conditions,
3054 pure_cons (Qinvalid_read_syntax, error_tail));
3055 Fput (Qinvalid_read_syntax, Qerror_message,
3056 make_pure_c_string ("Invalid read syntax"));
3057
3058 Fput (Qinvalid_function, Qerror_conditions,
3059 pure_cons (Qinvalid_function, error_tail));
3060 Fput (Qinvalid_function, Qerror_message,
3061 make_pure_c_string ("Invalid function"));
3062
3063 Fput (Qwrong_number_of_arguments, Qerror_conditions,
3064 pure_cons (Qwrong_number_of_arguments, error_tail));
3065 Fput (Qwrong_number_of_arguments, Qerror_message,
3066 make_pure_c_string ("Wrong number of arguments"));
3067
3068 Fput (Qno_catch, Qerror_conditions,
3069 pure_cons (Qno_catch, error_tail));
3070 Fput (Qno_catch, Qerror_message,
3071 make_pure_c_string ("No catch for tag"));
3072
3073 Fput (Qend_of_file, Qerror_conditions,
3074 pure_cons (Qend_of_file, error_tail));
3075 Fput (Qend_of_file, Qerror_message,
3076 make_pure_c_string ("End of file during parsing"));
3077 3006
3078 arith_tail = pure_cons (Qarith_error, error_tail); 3007 arith_tail = pure_cons (Qarith_error, error_tail);
3079 Fput (Qarith_error, Qerror_conditions, 3008 Fput (Qarith_error, Qerror_conditions, arith_tail);
3080 arith_tail); 3009 Fput (Qarith_error, Qerror_message, build_pure_c_string ("Arithmetic error"));
3081 Fput (Qarith_error, Qerror_message, 3010
3082 make_pure_c_string ("Arithmetic error")); 3011 PUT_ERROR (Qbeginning_of_buffer, error_tail, "Beginning of buffer");
3083 3012 PUT_ERROR (Qend_of_buffer, error_tail, "End of buffer");
3084 Fput (Qbeginning_of_buffer, Qerror_conditions, 3013 PUT_ERROR (Qbuffer_read_only, error_tail, "Buffer is read-only");
3085 pure_cons (Qbeginning_of_buffer, error_tail)); 3014 PUT_ERROR (Qtext_read_only, pure_cons (Qbuffer_read_only, error_tail),
3086 Fput (Qbeginning_of_buffer, Qerror_message, 3015 "Text is read-only");
3087 make_pure_c_string ("Beginning of buffer"));
3088
3089 Fput (Qend_of_buffer, Qerror_conditions,
3090 pure_cons (Qend_of_buffer, error_tail));
3091 Fput (Qend_of_buffer, Qerror_message,
3092 make_pure_c_string ("End of buffer"));
3093
3094 Fput (Qbuffer_read_only, Qerror_conditions,
3095 pure_cons (Qbuffer_read_only, error_tail));
3096 Fput (Qbuffer_read_only, Qerror_message,
3097 make_pure_c_string ("Buffer is read-only"));
3098
3099 Fput (Qtext_read_only, Qerror_conditions,
3100 pure_cons (Qtext_read_only, error_tail));
3101 Fput (Qtext_read_only, Qerror_message,
3102 make_pure_c_string ("Text is read-only"));
3103 3016
3104 DEFSYM (Qrange_error, "range-error"); 3017 DEFSYM (Qrange_error, "range-error");
3105 DEFSYM (Qdomain_error, "domain-error"); 3018 DEFSYM (Qdomain_error, "domain-error");
@@ -3107,30 +3020,17 @@ syms_of_data (void)
3107 DEFSYM (Qoverflow_error, "overflow-error"); 3020 DEFSYM (Qoverflow_error, "overflow-error");
3108 DEFSYM (Qunderflow_error, "underflow-error"); 3021 DEFSYM (Qunderflow_error, "underflow-error");
3109 3022
3110 Fput (Qdomain_error, Qerror_conditions, 3023 PUT_ERROR (Qdomain_error, arith_tail, "Arithmetic domain error");
3111 pure_cons (Qdomain_error, arith_tail));
3112 Fput (Qdomain_error, Qerror_message,
3113 make_pure_c_string ("Arithmetic domain error"));
3114
3115 Fput (Qrange_error, Qerror_conditions,
3116 pure_cons (Qrange_error, arith_tail));
3117 Fput (Qrange_error, Qerror_message,
3118 make_pure_c_string ("Arithmetic range error"));
3119 3024
3120 Fput (Qsingularity_error, Qerror_conditions, 3025 PUT_ERROR (Qrange_error, arith_tail, "Arithmetic range error");
3121 pure_cons (Qsingularity_error, Fcons (Qdomain_error, arith_tail)));
3122 Fput (Qsingularity_error, Qerror_message,
3123 make_pure_c_string ("Arithmetic singularity error"));
3124 3026
3125 Fput (Qoverflow_error, Qerror_conditions, 3027 PUT_ERROR (Qsingularity_error, Fcons (Qdomain_error, arith_tail),
3126 pure_cons (Qoverflow_error, Fcons (Qdomain_error, arith_tail))); 3028 "Arithmetic singularity error");
3127 Fput (Qoverflow_error, Qerror_message,
3128 make_pure_c_string ("Arithmetic overflow error"));
3129 3029
3130 Fput (Qunderflow_error, Qerror_conditions, 3030 PUT_ERROR (Qoverflow_error, Fcons (Qdomain_error, arith_tail),
3131 pure_cons (Qunderflow_error, Fcons (Qdomain_error, arith_tail))); 3031 "Arithmetic overflow error");
3132 Fput (Qunderflow_error, Qerror_message, 3032 PUT_ERROR (Qunderflow_error, Fcons (Qdomain_error, arith_tail),
3133 make_pure_c_string ("Arithmetic underflow error")); 3033 "Arithmetic underflow error");
3134 3034
3135 staticpro (&Qnil); 3035 staticpro (&Qnil);
3136 staticpro (&Qt); 3036 staticpro (&Qt);
@@ -3147,7 +3047,6 @@ syms_of_data (void)
3147 DEFSYM (Qwindow_configuration, "window-configuration"); 3047 DEFSYM (Qwindow_configuration, "window-configuration");
3148 DEFSYM (Qprocess, "process"); 3048 DEFSYM (Qprocess, "process");
3149 DEFSYM (Qwindow, "window"); 3049 DEFSYM (Qwindow, "window");
3150 /* DEFSYM (Qsubr, "subr"); */
3151 DEFSYM (Qcompiled_function, "compiled-function"); 3050 DEFSYM (Qcompiled_function, "compiled-function");
3152 DEFSYM (Qbuffer, "buffer"); 3051 DEFSYM (Qbuffer, "buffer");
3153 DEFSYM (Qframe, "frame"); 3052 DEFSYM (Qframe, "frame");
@@ -3155,12 +3054,16 @@ syms_of_data (void)
3155 DEFSYM (Qchar_table, "char-table"); 3054 DEFSYM (Qchar_table, "char-table");
3156 DEFSYM (Qbool_vector, "bool-vector"); 3055 DEFSYM (Qbool_vector, "bool-vector");
3157 DEFSYM (Qhash_table, "hash-table"); 3056 DEFSYM (Qhash_table, "hash-table");
3057 DEFSYM (Qmisc, "misc");
3058
3059 DEFSYM (Qdefun, "defun");
3158 3060
3159 DEFSYM (Qfont_spec, "font-spec"); 3061 DEFSYM (Qfont_spec, "font-spec");
3160 DEFSYM (Qfont_entity, "font-entity"); 3062 DEFSYM (Qfont_entity, "font-entity");
3161 DEFSYM (Qfont_object, "font-object"); 3063 DEFSYM (Qfont_object, "font-object");
3162 3064
3163 DEFSYM (Qinteractive_form, "interactive-form"); 3065 DEFSYM (Qinteractive_form, "interactive-form");
3066 DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
3164 3067
3165 defsubr (&Sindirect_variable); 3068 defsubr (&Sindirect_variable);
3166 defsubr (&Sinteractive_form); 3069 defsubr (&Sinteractive_form);
@@ -3257,7 +3160,7 @@ syms_of_data (void)
3257 defsubr (&Ssubr_arity); 3160 defsubr (&Ssubr_arity);
3258 defsubr (&Ssubr_name); 3161 defsubr (&Ssubr_name);
3259 3162
3260 XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function; 3163 set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->function);
3261 3164
3262 DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum, 3165 DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum,
3263 doc: /* The largest value that is representable in a Lisp integer. */); 3166 doc: /* The largest value that is representable in a Lisp integer. */);
@@ -3269,30 +3172,3 @@ syms_of_data (void)
3269 Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM); 3172 Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
3270 XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1; 3173 XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1;
3271} 3174}
3272
3273#ifndef FORWARD_SIGNAL_TO_MAIN_THREAD
3274static void arith_error (int) NO_RETURN;
3275#endif
3276
3277static void
3278arith_error (int signo)
3279{
3280 sigsetmask (SIGEMPTYMASK);
3281
3282 SIGNAL_THREAD_CHECK (signo);
3283 xsignal0 (Qarith_error);
3284}
3285
3286void
3287init_data (void)
3288{
3289 /* Don't do this if just dumping out.
3290 We don't want to call `signal' in this case
3291 so that we don't have trouble with dumping
3292 signal-delivering routines in an inconsistent state. */
3293#ifndef CANNOT_DUMP
3294 if (!initialized)
3295 return;
3296#endif /* CANNOT_DUMP */
3297 signal (SIGFPE, arith_error);
3298}