aboutsummaryrefslogtreecommitdiffstats
path: root/src/data.c
diff options
context:
space:
mode:
authorEli Zaretskii2013-09-05 11:01:04 +0300
committerEli Zaretskii2013-09-05 11:01:04 +0300
commit41306318777a942420bc4feadbfacf662ea179dc (patch)
tree669e5cca02f95d6064ce73c0d3fbbf91b8c8b563 /src/data.c
parent141f1ff7a40cda10f0558e891dd196a943a5082e (diff)
parent257b3b03cb1cff917e0b3b7832ad3eab5b59f257 (diff)
downloademacs-41306318777a942420bc4feadbfacf662ea179dc.tar.gz
emacs-41306318777a942420bc4feadbfacf662ea179dc.zip
Merge from trunk after a lot of time.
Diffstat (limited to 'src/data.c')
-rw-r--r--src/data.c632
1 files changed, 309 insertions, 323 deletions
diff --git a/src/data.c b/src/data.c
index defcd06a2ed..9f4bd1f1c02 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1,6 +1,6 @@
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-2012 2 Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2013 Free Software
3 Free Software Foundation, Inc. 3 Foundation, Inc.
4 4
5This file is part of GNU Emacs. 5This file is part of GNU Emacs.
6 6
@@ -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
@@ -36,19 +34,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
36#include "font.h" 34#include "font.h"
37#include "keymap.h" 35#include "keymap.h"
38 36
39#include <float.h>
40/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
41#ifndef IEEE_FLOATING_POINT
42#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
43 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
44#define IEEE_FLOATING_POINT 1
45#else
46#define IEEE_FLOATING_POINT 0
47#endif
48#endif
49
50#include <math.h>
51
52Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound; 37Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
53static Lisp_Object Qsubr; 38static Lisp_Object Qsubr;
54Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; 39Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
@@ -77,28 +62,118 @@ Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
77Lisp_Object Qcdr; 62Lisp_Object Qcdr;
78static Lisp_Object Qad_advice_info, Qad_activate_internal; 63static Lisp_Object Qad_advice_info, Qad_activate_internal;
79 64
80Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error; 65static Lisp_Object Qdomain_error, Qsingularity_error, Qunderflow_error;
81Lisp_Object Qoverflow_error, Qunderflow_error; 66Lisp_Object Qrange_error, Qoverflow_error;
82 67
83Lisp_Object Qfloatp; 68Lisp_Object Qfloatp;
84Lisp_Object Qnumberp, Qnumber_or_marker_p; 69Lisp_Object Qnumberp, Qnumber_or_marker_p;
85 70
86Lisp_Object Qinteger; 71Lisp_Object Qinteger, Qsymbol;
87static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; 72static Lisp_Object Qcons, Qfloat, Qmisc, Qstring, Qvector;
88Lisp_Object Qwindow; 73Lisp_Object Qwindow;
89static Lisp_Object Qfloat, Qwindow_configuration; 74static Lisp_Object Qoverlay, Qwindow_configuration;
90static Lisp_Object Qprocess; 75static Lisp_Object Qprocess, Qmarker;
91static Lisp_Object Qcompiled_function, Qframe, Qvector; 76static Lisp_Object Qcompiled_function, Qframe;
92Lisp_Object Qbuffer; 77Lisp_Object Qbuffer;
93static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; 78static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
94static Lisp_Object Qsubrp, Qmany, Qunevalled; 79static Lisp_Object Qsubrp;
80static Lisp_Object Qmany, Qunevalled;
95Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; 81Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
96static Lisp_Object Qdefun; 82static Lisp_Object Qdefun;
97 83
98Lisp_Object Qinteractive_form; 84Lisp_Object Qinteractive_form;
85static Lisp_Object Qdefalias_fset_function;
99 86
100static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *); 87static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
101 88
89static bool
90BOOLFWDP (union Lisp_Fwd *a)
91{
92 return XFWDTYPE (a) == Lisp_Fwd_Bool;
93}
94static bool
95INTFWDP (union Lisp_Fwd *a)
96{
97 return XFWDTYPE (a) == Lisp_Fwd_Int;
98}
99static bool
100KBOARD_OBJFWDP (union Lisp_Fwd *a)
101{
102 return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj;
103}
104static bool
105OBJFWDP (union Lisp_Fwd *a)
106{
107 return XFWDTYPE (a) == Lisp_Fwd_Obj;
108}
109
110static struct Lisp_Boolfwd *
111XBOOLFWD (union Lisp_Fwd *a)
112{
113 eassert (BOOLFWDP (a));
114 return &a->u_boolfwd;
115}
116static struct Lisp_Kboard_Objfwd *
117XKBOARD_OBJFWD (union Lisp_Fwd *a)
118{
119 eassert (KBOARD_OBJFWDP (a));
120 return &a->u_kboard_objfwd;
121}
122static struct Lisp_Intfwd *
123XINTFWD (union Lisp_Fwd *a)
124{
125 eassert (INTFWDP (a));
126 return &a->u_intfwd;
127}
128static struct Lisp_Objfwd *
129XOBJFWD (union Lisp_Fwd *a)
130{
131 eassert (OBJFWDP (a));
132 return &a->u_objfwd;
133}
134
135static void
136CHECK_SUBR (Lisp_Object x)
137{
138 CHECK_TYPE (SUBRP (x), Qsubrp, x);
139}
140
141static void
142set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found)
143{
144 eassert (found == !EQ (blv->defcell, blv->valcell));
145 blv->found = found;
146}
147
148static Lisp_Object
149blv_value (struct Lisp_Buffer_Local_Value *blv)
150{
151 return XCDR (blv->valcell);
152}
153
154static void
155set_blv_value (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
156{
157 XSETCDR (blv->valcell, val);
158}
159
160static void
161set_blv_where (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
162{
163 blv->where = val;
164}
165
166static void
167set_blv_defcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
168{
169 blv->defcell = val;
170}
171
172static void
173set_blv_valcell (struct Lisp_Buffer_Local_Value *blv, Lisp_Object val)
174{
175 blv->valcell = val;
176}
102 177
103Lisp_Object 178Lisp_Object
104wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value) 179wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
@@ -108,15 +183,15 @@ wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value)
108 to try and do that by checking the tagbits, but nowadays all 183 to try and do that by checking the tagbits, but nowadays all
109 tagbits are potentially valid. */ 184 tagbits are potentially valid. */
110 /* if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit) 185 /* if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit)
111 * abort (); */ 186 * emacs_abort (); */
112 187
113 xsignal2 (Qwrong_type_argument, predicate, value); 188 xsignal2 (Qwrong_type_argument, predicate, value);
114} 189}
115 190
116void 191void
117pure_write_error (void) 192pure_write_error (Lisp_Object obj)
118{ 193{
119 error ("Attempt to modify read-only object"); 194 xsignal2 (Qerror, build_string ("Attempt to modify read-only object"), obj);
120} 195}
121 196
122void 197void
@@ -182,7 +257,7 @@ for example, (type-of 1) returns `integer'. */)
182 case Lisp_Misc_Float: 257 case Lisp_Misc_Float:
183 return Qfloat; 258 return Qfloat;
184 } 259 }
185 abort (); 260 emacs_abort ();
186 261
187 case Lisp_Vectorlike: 262 case Lisp_Vectorlike:
188 if (WINDOW_CONFIGURATIONP (object)) 263 if (WINDOW_CONFIGURATIONP (object))
@@ -217,7 +292,7 @@ for example, (type-of 1) returns `integer'. */)
217 return Qfloat; 292 return Qfloat;
218 293
219 default: 294 default:
220 abort (); 295 emacs_abort ();
221 } 296 }
222} 297}
223 298
@@ -302,7 +377,8 @@ DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0,
302 377
303DEFUN ("multibyte-string-p", Fmultibyte_string_p, Smultibyte_string_p, 378DEFUN ("multibyte-string-p", Fmultibyte_string_p, Smultibyte_string_p,
304 1, 1, 0, 379 1, 1, 0,
305 doc: /* Return t if OBJECT is a multibyte string. */) 380 doc: /* Return t if OBJECT is a multibyte string.
381Return nil if OBJECT is either a unibyte string, or not a string. */)
306 (Lisp_Object object) 382 (Lisp_Object object)
307{ 383{
308 if (STRINGP (object) && STRING_MULTIBYTE (object)) 384 if (STRINGP (object) && STRING_MULTIBYTE (object))
@@ -459,7 +535,7 @@ DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
459} 535}
460 536
461 537
462/* Extract and set components of lists */ 538/* Extract and set components of lists. */
463 539
464DEFUN ("car", Fcar, Scar, 1, 1, 0, 540DEFUN ("car", Fcar, Scar, 1, 1, 0,
465 doc: /* Return the car of LIST. If arg is nil, return nil. 541 doc: /* Return the car of LIST. If arg is nil, return nil.
@@ -517,10 +593,12 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
517 return newcdr; 593 return newcdr;
518} 594}
519 595
520/* Extract and set components of symbols */ 596/* Extract and set components of symbols. */
521 597
522DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, 598DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
523 doc: /* Return t if SYMBOL's value is not void. */) 599 doc: /* Return t if SYMBOL's value is not void.
600Note that if `lexical-binding' is in effect, this refers to the
601global value outside of any lexical scope. */)
524 (register Lisp_Object symbol) 602 (register Lisp_Object symbol)
525{ 603{
526 Lisp_Object valcontents; 604 Lisp_Object valcontents;
@@ -543,7 +621,7 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
543 else 621 else
544 { 622 {
545 swap_in_symval_forwarding (sym, blv); 623 swap_in_symval_forwarding (sym, blv);
546 valcontents = BLV_VALUE (blv); 624 valcontents = blv_value (blv);
547 } 625 }
548 break; 626 break;
549 } 627 }
@@ -551,18 +629,19 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
551 /* In set_internal, we un-forward vars when their value is 629 /* In set_internal, we un-forward vars when their value is
552 set to Qunbound. */ 630 set to Qunbound. */
553 return Qt; 631 return Qt;
554 default: abort (); 632 default: emacs_abort ();
555 } 633 }
556 634
557 return (EQ (valcontents, Qunbound) ? Qnil : Qt); 635 return (EQ (valcontents, Qunbound) ? Qnil : Qt);
558} 636}
559 637
638/* FIXME: Make it an alias for function-symbol! */
560DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, 639DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
561 doc: /* Return t if SYMBOL's function definition is not void. */) 640 doc: /* Return t if SYMBOL's function definition is not void. */)
562 (register Lisp_Object symbol) 641 (register Lisp_Object symbol)
563{ 642{
564 CHECK_SYMBOL (symbol); 643 CHECK_SYMBOL (symbol);
565 return (EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt); 644 return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt;
566} 645}
567 646
568DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, 647DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
@@ -578,14 +657,14 @@ Return SYMBOL. */)
578} 657}
579 658
580DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, 659DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
581 doc: /* Make SYMBOL's function definition be void. 660 doc: /* Make SYMBOL's function definition be nil.
582Return SYMBOL. */) 661Return SYMBOL. */)
583 (register Lisp_Object symbol) 662 (register Lisp_Object symbol)
584{ 663{
585 CHECK_SYMBOL (symbol); 664 CHECK_SYMBOL (symbol);
586 if (NILP (symbol) || EQ (symbol, Qt)) 665 if (NILP (symbol) || EQ (symbol, Qt))
587 xsignal1 (Qsetting_constant, symbol); 666 xsignal1 (Qsetting_constant, symbol);
588 XSYMBOL (symbol)->function = Qunbound; 667 set_symbol_function (symbol, Qnil);
589 return symbol; 668 return symbol;
590} 669}
591 670
@@ -594,9 +673,7 @@ DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
594 (register Lisp_Object symbol) 673 (register Lisp_Object symbol)
595{ 674{
596 CHECK_SYMBOL (symbol); 675 CHECK_SYMBOL (symbol);
597 if (!EQ (XSYMBOL (symbol)->function, Qunbound)) 676 return XSYMBOL (symbol)->function;
598 return XSYMBOL (symbol)->function;
599 xsignal1 (Qvoid_function, symbol);
600} 677}
601 678
602DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, 679DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
@@ -623,50 +700,63 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
623 (register Lisp_Object symbol, Lisp_Object definition) 700 (register Lisp_Object symbol, Lisp_Object definition)
624{ 701{
625 register Lisp_Object function; 702 register Lisp_Object function;
626
627 CHECK_SYMBOL (symbol); 703 CHECK_SYMBOL (symbol);
628 if (NILP (symbol) || EQ (symbol, Qt))
629 xsignal1 (Qsetting_constant, symbol);
630 704
631 function = XSYMBOL (symbol)->function; 705 function = XSYMBOL (symbol)->function;
632 706
633 if (!NILP (Vautoload_queue) && !EQ (function, Qunbound)) 707 if (!NILP (Vautoload_queue) && !NILP (function))
634 Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue); 708 Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
635 709
636 if (CONSP (function) && EQ (XCAR (function), Qautoload)) 710 if (AUTOLOADP (function))
637 Fput (symbol, Qautoload, XCDR (function)); 711 Fput (symbol, Qautoload, XCDR (function));
638 712
639 XSYMBOL (symbol)->function = definition; 713 set_symbol_function (symbol, definition);
640 /* Handle automatic advice activation */ 714
641 if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info)))
642 {
643 call2 (Qad_activate_internal, symbol, Qnil);
644 definition = XSYMBOL (symbol)->function;
645 }
646 return definition; 715 return definition;
647} 716}
648 717
649DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0, 718DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0,
650 doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. 719 doc: /* Set SYMBOL's function definition to DEFINITION.
651Associates the function with the current load file, if any. 720Associates the function with the current load file, if any.
652The optional third argument DOCSTRING specifies the documentation string 721The optional third argument DOCSTRING specifies the documentation string
653for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string 722for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string
654determined by DEFINITION. */) 723determined by DEFINITION.
724The return value is undefined. */)
655 (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring) 725 (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
656{ 726{
657 CHECK_SYMBOL (symbol); 727 CHECK_SYMBOL (symbol);
658 if (CONSP (XSYMBOL (symbol)->function)
659 && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
660 LOADHIST_ATTACH (Fcons (Qt, symbol));
661 if (!NILP (Vpurify_flag) 728 if (!NILP (Vpurify_flag)
662 /* If `definition' is a keymap, immutable (and copying) is wrong. */ 729 /* If `definition' is a keymap, immutable (and copying) is wrong. */
663 && !KEYMAPP (definition)) 730 && !KEYMAPP (definition))
664 definition = Fpurecopy (definition); 731 definition = Fpurecopy (definition);
665 definition = Ffset (symbol, definition); 732
666 LOADHIST_ATTACH (Fcons (Qdefun, symbol)); 733 {
734 bool autoload = AUTOLOADP (definition);
735 if (NILP (Vpurify_flag) || !autoload)
736 { /* Only add autoload entries after dumping, because the ones before are
737 not useful and else we get loads of them from the loaddefs.el. */
738
739 if (AUTOLOADP (XSYMBOL (symbol)->function))
740 /* Remember that the function was already an autoload. */
741 LOADHIST_ATTACH (Fcons (Qt, symbol));
742 LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
743 }
744 }
745
746 { /* Handle automatic advice activation. */
747 Lisp_Object hook = Fget (symbol, Qdefalias_fset_function);
748 if (!NILP (hook))
749 call2 (hook, symbol, definition);
750 else
751 Ffset (symbol, definition);
752 }
753
667 if (!NILP (docstring)) 754 if (!NILP (docstring))
668 Fput (symbol, Qfunction_documentation, docstring); 755 Fput (symbol, Qfunction_documentation, docstring);
669 return definition; 756 /* We used to return `definition', but now that `defun' and `defmacro' expand
757 to a call to `defalias', we return `symbol' for backward compatibility
758 (bug#11686). */
759 return symbol;
670} 760}
671 761
672DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0, 762DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
@@ -674,7 +764,7 @@ DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
674 (register Lisp_Object symbol, Lisp_Object newplist) 764 (register Lisp_Object symbol, Lisp_Object newplist)
675{ 765{
676 CHECK_SYMBOL (symbol); 766 CHECK_SYMBOL (symbol);
677 XSYMBOL (symbol)->plist = newplist; 767 set_symbol_plist (symbol, newplist);
678 return newplist; 768 return newplist;
679} 769}
680 770
@@ -690,12 +780,10 @@ function with `&rest' args, or `unevalled' for a special form. */)
690 CHECK_SUBR (subr); 780 CHECK_SUBR (subr);
691 minargs = XSUBR (subr)->min_args; 781 minargs = XSUBR (subr)->min_args;
692 maxargs = XSUBR (subr)->max_args; 782 maxargs = XSUBR (subr)->max_args;
693 if (maxargs == MANY) 783 return Fcons (make_number (minargs),
694 return Fcons (make_number (minargs), Qmany); 784 maxargs == MANY ? Qmany
695 else if (maxargs == UNEVALLED) 785 : maxargs == UNEVALLED ? Qunevalled
696 return Fcons (make_number (minargs), Qunevalled); 786 : make_number (maxargs));
697 else
698 return Fcons (make_number (minargs), make_number (maxargs));
699} 787}
700 788
701DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0, 789DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
@@ -717,11 +805,11 @@ Value, if non-nil, is a list \(interactive SPEC). */)
717{ 805{
718 Lisp_Object fun = indirect_function (cmd); /* Check cycles. */ 806 Lisp_Object fun = indirect_function (cmd); /* Check cycles. */
719 807
720 if (NILP (fun) || EQ (fun, Qunbound)) 808 if (NILP (fun))
721 return Qnil; 809 return Qnil;
722 810
723 /* Use an `interactive-form' property if present, analogous to the 811 /* Use an `interactive-form' property if present, analogous to the
724 function-documentation property. */ 812 function-documentation property. */
725 fun = cmd; 813 fun = cmd;
726 while (SYMBOLP (fun)) 814 while (SYMBOLP (fun))
727 { 815 {
@@ -745,6 +833,8 @@ Value, if non-nil, is a list \(interactive SPEC). */)
745 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE) 833 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
746 return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE)); 834 return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
747 } 835 }
836 else if (AUTOLOADP (fun))
837 return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
748 else if (CONSP (fun)) 838 else if (CONSP (fun))
749 { 839 {
750 Lisp_Object funcar = XCAR (fun); 840 Lisp_Object funcar = XCAR (fun);
@@ -752,14 +842,6 @@ Value, if non-nil, is a list \(interactive SPEC). */)
752 return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))); 842 return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
753 else if (EQ (funcar, Qlambda)) 843 else if (EQ (funcar, Qlambda))
754 return Fassq (Qinteractive, Fcdr (XCDR (fun))); 844 return Fassq (Qinteractive, Fcdr (XCDR (fun)));
755 else if (EQ (funcar, Qautoload))
756 {
757 struct gcpro gcpro1;
758 GCPRO1 (cmd);
759 do_autoload (fun, cmd);
760 UNGCPRO;
761 return Finteractive_form (cmd);
762 }
763 } 845 }
764 return Qnil; 846 return Qnil;
765} 847}
@@ -803,10 +885,12 @@ indirect_variable (struct Lisp_Symbol *symbol)
803 885
804DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0, 886DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0,
805 doc: /* Return the variable at the end of OBJECT's variable chain. 887 doc: /* Return the variable at the end of OBJECT's variable chain.
806If OBJECT is a symbol, follow all variable indirections and return the final 888If OBJECT is a symbol, follow its variable indirections (if any), and
807variable. If OBJECT is not a symbol, just return it. 889return the variable at the end of the chain of aliases. See Info node
808Signal a cyclic-variable-indirection error if there is a loop in the 890`(elisp)Variable Aliases'.
809variable chain of symbols. */) 891
892If OBJECT is not a symbol, just return it. If there is a loop in the
893chain of aliases, signal a `cyclic-variable-indirection' error. */)
810 (Lisp_Object object) 894 (Lisp_Object object)
811{ 895{
812 if (SYMBOLP (object)) 896 if (SYMBOLP (object))
@@ -840,7 +924,7 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents)
840 return *XOBJFWD (valcontents)->objvar; 924 return *XOBJFWD (valcontents)->objvar;
841 925
842 case Lisp_Fwd_Buffer_Obj: 926 case Lisp_Fwd_Buffer_Obj:
843 return PER_BUFFER_VALUE (current_buffer, 927 return per_buffer_value (current_buffer,
844 XBUFFER_OBJFWD (valcontents)->offset); 928 XBUFFER_OBJFWD (valcontents)->offset);
845 929
846 case Lisp_Fwd_Kboard_Obj: 930 case Lisp_Fwd_Kboard_Obj:
@@ -857,7 +941,7 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents)
857 don't think anything will break. --lorentey */ 941 don't think anything will break. --lorentey */
858 return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset 942 return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
859 + (char *)FRAME_KBOARD (SELECTED_FRAME ())); 943 + (char *)FRAME_KBOARD (SELECTED_FRAME ()));
860 default: abort (); 944 default: emacs_abort ();
861 } 945 }
862} 946}
863 947
@@ -897,22 +981,17 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
897 - (char *) &buffer_defaults); 981 - (char *) &buffer_defaults);
898 int idx = PER_BUFFER_IDX (offset); 982 int idx = PER_BUFFER_IDX (offset);
899 983
900 Lisp_Object tail; 984 Lisp_Object tail, buf;
901 985
902 if (idx <= 0) 986 if (idx <= 0)
903 break; 987 break;
904 988
905 for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) 989 FOR_EACH_LIVE_BUFFER (tail, buf)
906 { 990 {
907 Lisp_Object lbuf; 991 struct buffer *b = XBUFFER (buf);
908 struct buffer *b;
909
910 lbuf = Fcdr (XCAR (tail));
911 if (!BUFFERP (lbuf)) continue;
912 b = XBUFFER (lbuf);
913 992
914 if (! PER_BUFFER_VALUE_P (b, idx)) 993 if (! PER_BUFFER_VALUE_P (b, idx))
915 PER_BUFFER_VALUE (b, offset) = newval; 994 set_per_buffer_value (b, offset, newval);
916 } 995 }
917 } 996 }
918 break; 997 break;
@@ -920,17 +999,15 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
920 case Lisp_Fwd_Buffer_Obj: 999 case Lisp_Fwd_Buffer_Obj:
921 { 1000 {
922 int offset = XBUFFER_OBJFWD (valcontents)->offset; 1001 int offset = XBUFFER_OBJFWD (valcontents)->offset;
923 Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype; 1002 Lisp_Object predicate = XBUFFER_OBJFWD (valcontents)->predicate;
924 1003
925 if (!(NILP (type) || NILP (newval) 1004 if (!NILP (predicate) && !NILP (newval)
926 || (XINT (type) == LISP_INT_TAG 1005 && NILP (call1 (predicate, newval)))
927 ? INTEGERP (newval) 1006 wrong_type_argument (predicate, newval);
928 : XTYPE (newval) == XINT (type))))
929 buffer_slot_type_mismatch (newval, XINT (type));
930 1007
931 if (buf == NULL) 1008 if (buf == NULL)
932 buf = current_buffer; 1009 buf = current_buffer;
933 PER_BUFFER_VALUE (buf, offset) = newval; 1010 set_per_buffer_value (buf, offset, newval);
934 } 1011 }
935 break; 1012 break;
936 1013
@@ -943,12 +1020,14 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
943 break; 1020 break;
944 1021
945 default: 1022 default:
946 abort (); /* goto def; */ 1023 emacs_abort (); /* goto def; */
947 } 1024 }
948} 1025}
949 1026
950/* Set up SYMBOL to refer to its global binding. 1027/* Set up SYMBOL to refer to its global binding. This makes it safe
951 This makes it safe to alter the status of other bindings. */ 1028 to alter the status of other bindings. BEWARE: this may be called
1029 during the mark phase of GC, where we assume that Lisp_Object slots
1030 of BLV are marked after this function has changed them. */
952 1031
953void 1032void
954swap_in_global_binding (struct Lisp_Symbol *symbol) 1033swap_in_global_binding (struct Lisp_Symbol *symbol)
@@ -957,16 +1036,16 @@ swap_in_global_binding (struct Lisp_Symbol *symbol)
957 1036
958 /* Unload the previously loaded binding. */ 1037 /* Unload the previously loaded binding. */
959 if (blv->fwd) 1038 if (blv->fwd)
960 SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd)); 1039 set_blv_value (blv, do_symval_forwarding (blv->fwd));
961 1040
962 /* Select the global binding in the symbol. */ 1041 /* Select the global binding in the symbol. */
963 blv->valcell = blv->defcell; 1042 set_blv_valcell (blv, blv->defcell);
964 if (blv->fwd) 1043 if (blv->fwd)
965 store_symval_forwarding (blv->fwd, XCDR (blv->defcell), NULL); 1044 store_symval_forwarding (blv->fwd, XCDR (blv->defcell), NULL);
966 1045
967 /* Indicate that the global binding is set up now. */ 1046 /* Indicate that the global binding is set up now. */
968 blv->where = Qnil; 1047 set_blv_where (blv, Qnil);
969 SET_BLV_FOUND (blv, 0); 1048 set_blv_found (blv, 0);
970} 1049}
971 1050
972/* Set up the buffer-local symbol SYMBOL for validity in the current buffer. 1051/* Set up the buffer-local symbol SYMBOL for validity in the current buffer.
@@ -994,7 +1073,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_
994 /* Unload the previously loaded binding. */ 1073 /* Unload the previously loaded binding. */
995 tem1 = blv->valcell; 1074 tem1 = blv->valcell;
996 if (blv->fwd) 1075 if (blv->fwd)
997 SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd)); 1076 set_blv_value (blv, do_symval_forwarding (blv->fwd));
998 /* Choose the new binding. */ 1077 /* Choose the new binding. */
999 { 1078 {
1000 Lisp_Object var; 1079 Lisp_Object var;
@@ -1002,21 +1081,21 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_
1002 if (blv->frame_local) 1081 if (blv->frame_local)
1003 { 1082 {
1004 tem1 = assq_no_quit (var, XFRAME (selected_frame)->param_alist); 1083 tem1 = assq_no_quit (var, XFRAME (selected_frame)->param_alist);
1005 blv->where = selected_frame; 1084 set_blv_where (blv, selected_frame);
1006 } 1085 }
1007 else 1086 else
1008 { 1087 {
1009 tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist)); 1088 tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist));
1010 XSETBUFFER (blv->where, current_buffer); 1089 set_blv_where (blv, Fcurrent_buffer ());
1011 } 1090 }
1012 } 1091 }
1013 if (!(blv->found = !NILP (tem1))) 1092 if (!(blv->found = !NILP (tem1)))
1014 tem1 = blv->defcell; 1093 tem1 = blv->defcell;
1015 1094
1016 /* Load the new binding. */ 1095 /* Load the new binding. */
1017 blv->valcell = tem1; 1096 set_blv_valcell (blv, tem1);
1018 if (blv->fwd) 1097 if (blv->fwd)
1019 store_symval_forwarding (blv->fwd, BLV_VALUE (blv), NULL); 1098 store_symval_forwarding (blv->fwd, blv_value (blv), NULL);
1020 } 1099 }
1021} 1100}
1022 1101
@@ -1043,17 +1122,19 @@ find_symbol_value (Lisp_Object symbol)
1043 { 1122 {
1044 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); 1123 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
1045 swap_in_symval_forwarding (sym, blv); 1124 swap_in_symval_forwarding (sym, blv);
1046 return blv->fwd ? do_symval_forwarding (blv->fwd) : BLV_VALUE (blv); 1125 return blv->fwd ? do_symval_forwarding (blv->fwd) : blv_value (blv);
1047 } 1126 }
1048 /* FALLTHROUGH */ 1127 /* FALLTHROUGH */
1049 case SYMBOL_FORWARDED: 1128 case SYMBOL_FORWARDED:
1050 return do_symval_forwarding (SYMBOL_FWD (sym)); 1129 return do_symval_forwarding (SYMBOL_FWD (sym));
1051 default: abort (); 1130 default: emacs_abort ();
1052 } 1131 }
1053} 1132}
1054 1133
1055DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0, 1134DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0,
1056 doc: /* Return SYMBOL's value. Error if that is void. */) 1135 doc: /* Return SYMBOL's value. Error if that is void.
1136Note that if `lexical-binding' is in effect, this returns the
1137global value outside of any lexical scope. */)
1057 (Lisp_Object symbol) 1138 (Lisp_Object symbol)
1058{ 1139{
1059 Lisp_Object val; 1140 Lisp_Object val;
@@ -1073,52 +1154,19 @@ DEFUN ("set", Fset, Sset, 2, 2, 0,
1073 return newval; 1154 return newval;
1074} 1155}
1075 1156
1076/* Return 1 if SYMBOL currently has a let-binding
1077 which was made in the buffer that is now current. */
1078
1079static int
1080let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
1081{
1082 struct specbinding *p;
1083
1084 for (p = specpdl_ptr; p > specpdl; )
1085 if ((--p)->func == NULL
1086 && CONSP (p->symbol))
1087 {
1088 struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol));
1089 eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS);
1090 if (symbol == let_bound_symbol
1091 && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer)
1092 return 1;
1093 }
1094
1095 return 0;
1096}
1097
1098static int
1099let_shadows_global_binding_p (Lisp_Object symbol)
1100{
1101 struct specbinding *p;
1102
1103 for (p = specpdl_ptr; p > specpdl; )
1104 if ((--p)->func == NULL && EQ (p->symbol, symbol))
1105 return 1;
1106
1107 return 0;
1108}
1109
1110/* Store the value NEWVAL into SYMBOL. 1157/* Store the value NEWVAL into SYMBOL.
1111 If buffer/frame-locality is an issue, WHERE specifies which context to use. 1158 If buffer/frame-locality is an issue, WHERE specifies which context to use.
1112 (nil stands for the current buffer/frame). 1159 (nil stands for the current buffer/frame).
1113 1160
1114 If BINDFLAG is zero, then if this symbol is supposed to become 1161 If BINDFLAG is false, then if this symbol is supposed to become
1115 local in every buffer where it is set, then we make it local. 1162 local in every buffer where it is set, then we make it local.
1116 If BINDFLAG is nonzero, we don't do that. */ 1163 If BINDFLAG is true, we don't do that. */
1117 1164
1118void 1165void
1119set_internal (register Lisp_Object symbol, register Lisp_Object newval, register Lisp_Object where, int bindflag) 1166set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
1167 bool bindflag)
1120{ 1168{
1121 int voide = EQ (newval, Qunbound); 1169 bool voide = EQ (newval, Qunbound);
1122 struct Lisp_Symbol *sym; 1170 struct Lisp_Symbol *sym;
1123 Lisp_Object tem1; 1171 Lisp_Object tem1;
1124 1172
@@ -1160,7 +1208,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
1160 the default binding is loaded, the loaded binding may be the 1208 the default binding is loaded, the loaded binding may be the
1161 wrong one. */ 1209 wrong one. */
1162 if (!EQ (blv->where, where) 1210 if (!EQ (blv->where, where)
1163 /* Also unload a global binding (if the var is local_if_set). */ 1211 /* Also unload a global binding (if the var is local_if_set). */
1164 || (EQ (blv->valcell, blv->defcell))) 1212 || (EQ (blv->valcell, blv->defcell)))
1165 { 1213 {
1166 /* The currently loaded binding is not necessarily valid. 1214 /* The currently loaded binding is not necessarily valid.
@@ -1168,7 +1216,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
1168 1216
1169 /* Write out `realvalue' to the old loaded binding. */ 1217 /* Write out `realvalue' to the old loaded binding. */
1170 if (blv->fwd) 1218 if (blv->fwd)
1171 SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd)); 1219 set_blv_value (blv, do_symval_forwarding (blv->fwd));
1172 1220
1173 /* Find the new binding. */ 1221 /* Find the new binding. */
1174 XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */ 1222 XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */
@@ -1176,7 +1224,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
1176 (blv->frame_local 1224 (blv->frame_local
1177 ? XFRAME (where)->param_alist 1225 ? XFRAME (where)->param_alist
1178 : BVAR (XBUFFER (where), local_var_alist))); 1226 : BVAR (XBUFFER (where), local_var_alist)));
1179 blv->where = where; 1227 set_blv_where (blv, where);
1180 blv->found = 1; 1228 blv->found = 1;
1181 1229
1182 if (NILP (tem1)) 1230 if (NILP (tem1))
@@ -1206,17 +1254,18 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
1206 bindings, not for frame-local bindings. */ 1254 bindings, not for frame-local bindings. */
1207 eassert (!blv->frame_local); 1255 eassert (!blv->frame_local);
1208 tem1 = Fcons (symbol, XCDR (blv->defcell)); 1256 tem1 = Fcons (symbol, XCDR (blv->defcell));
1209 BVAR (XBUFFER (where), local_var_alist) 1257 bset_local_var_alist
1210 = Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)); 1258 (XBUFFER (where),
1259 Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)));
1211 } 1260 }
1212 } 1261 }
1213 1262
1214 /* Record which binding is now loaded. */ 1263 /* Record which binding is now loaded. */
1215 blv->valcell = tem1; 1264 set_blv_valcell (blv, tem1);
1216 } 1265 }
1217 1266
1218 /* Store the new value in the cons cell. */ 1267 /* Store the new value in the cons cell. */
1219 SET_BLV_VALUE (blv, newval); 1268 set_blv_value (blv, newval);
1220 1269
1221 if (blv->fwd) 1270 if (blv->fwd)
1222 { 1271 {
@@ -1256,7 +1305,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register
1256 store_symval_forwarding (/* sym, */ innercontents, newval, buf); 1305 store_symval_forwarding (/* sym, */ innercontents, newval, buf);
1257 break; 1306 break;
1258 } 1307 }
1259 default: abort (); 1308 default: emacs_abort ();
1260 } 1309 }
1261 return; 1310 return;
1262} 1311}
@@ -1301,13 +1350,13 @@ default_value (Lisp_Object symbol)
1301 { 1350 {
1302 int offset = XBUFFER_OBJFWD (valcontents)->offset; 1351 int offset = XBUFFER_OBJFWD (valcontents)->offset;
1303 if (PER_BUFFER_IDX (offset) != 0) 1352 if (PER_BUFFER_IDX (offset) != 0)
1304 return PER_BUFFER_DEFAULT (offset); 1353 return per_buffer_default (offset);
1305 } 1354 }
1306 1355
1307 /* For other variables, get the current value. */ 1356 /* For other variables, get the current value. */
1308 return do_symval_forwarding (valcontents); 1357 return do_symval_forwarding (valcontents);
1309 } 1358 }
1310 default: abort (); 1359 default: emacs_abort ();
1311 } 1360 }
1312} 1361}
1313 1362
@@ -1330,9 +1379,7 @@ for this variable. The default value is meaningful for variables with
1330local bindings in certain buffers. */) 1379local bindings in certain buffers. */)
1331 (Lisp_Object symbol) 1380 (Lisp_Object symbol)
1332{ 1381{
1333 register Lisp_Object value; 1382 Lisp_Object value = default_value (symbol);
1334
1335 value = default_value (symbol);
1336 if (!EQ (value, Qunbound)) 1383 if (!EQ (value, Qunbound))
1337 return value; 1384 return value;
1338 1385
@@ -1388,7 +1435,7 @@ for this variable. */)
1388 int offset = XBUFFER_OBJFWD (valcontents)->offset; 1435 int offset = XBUFFER_OBJFWD (valcontents)->offset;
1389 int idx = PER_BUFFER_IDX (offset); 1436 int idx = PER_BUFFER_IDX (offset);
1390 1437
1391 PER_BUFFER_DEFAULT (offset) = value; 1438 set_per_buffer_default (offset, value);
1392 1439
1393 /* If this variable is not always local in all buffers, 1440 /* If this variable is not always local in all buffers,
1394 set it in the buffers that don't nominally have a local value. */ 1441 set it in the buffers that don't nominally have a local value. */
@@ -1396,16 +1443,16 @@ for this variable. */)
1396 { 1443 {
1397 struct buffer *b; 1444 struct buffer *b;
1398 1445
1399 for (b = all_buffers; b; b = b->header.next.buffer) 1446 FOR_EACH_BUFFER (b)
1400 if (!PER_BUFFER_VALUE_P (b, idx)) 1447 if (!PER_BUFFER_VALUE_P (b, idx))
1401 PER_BUFFER_VALUE (b, offset) = value; 1448 set_per_buffer_value (b, offset, value);
1402 } 1449 }
1403 return value; 1450 return value;
1404 } 1451 }
1405 else 1452 else
1406 return Fset (symbol, value); 1453 return Fset (symbol, value);
1407 } 1454 }
1408 default: abort (); 1455 default: emacs_abort ();
1409 } 1456 }
1410} 1457}
1411 1458
@@ -1424,24 +1471,19 @@ of previous VARs.
1424usage: (setq-default [VAR VALUE]...) */) 1471usage: (setq-default [VAR VALUE]...) */)
1425 (Lisp_Object args) 1472 (Lisp_Object args)
1426{ 1473{
1427 register Lisp_Object args_left; 1474 Lisp_Object args_left, symbol, val;
1428 register Lisp_Object val, symbol;
1429 struct gcpro gcpro1; 1475 struct gcpro gcpro1;
1430 1476
1431 if (NILP (args)) 1477 args_left = val = args;
1432 return Qnil;
1433
1434 args_left = args;
1435 GCPRO1 (args); 1478 GCPRO1 (args);
1436 1479
1437 do 1480 while (CONSP (args_left))
1438 { 1481 {
1439 val = eval_sub (Fcar (Fcdr (args_left))); 1482 val = eval_sub (Fcar (XCDR (args_left)));
1440 symbol = XCAR (args_left); 1483 symbol = XCAR (args_left);
1441 Fset_default (symbol, val); 1484 Fset_default (symbol, val);
1442 args_left = Fcdr (XCDR (args_left)); 1485 args_left = Fcdr (XCDR (args_left));
1443 } 1486 }
1444 while (!NILP (args_left));
1445 1487
1446 UNGCPRO; 1488 UNGCPRO;
1447 return val; 1489 return val;
@@ -1456,10 +1498,10 @@ union Lisp_Val_Fwd
1456 }; 1498 };
1457 1499
1458static struct Lisp_Buffer_Local_Value * 1500static struct Lisp_Buffer_Local_Value *
1459make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents) 1501make_blv (struct Lisp_Symbol *sym, bool forwarded,
1502 union Lisp_Val_Fwd valcontents)
1460{ 1503{
1461 struct Lisp_Buffer_Local_Value *blv 1504 struct Lisp_Buffer_Local_Value *blv = xmalloc (sizeof *blv);
1462 = xmalloc (sizeof (struct Lisp_Buffer_Local_Value));
1463 Lisp_Object symbol; 1505 Lisp_Object symbol;
1464 Lisp_Object tem; 1506 Lisp_Object tem;
1465 1507
@@ -1473,12 +1515,12 @@ make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents
1473 eassert (!(forwarded && BUFFER_OBJFWDP (valcontents.fwd))); 1515 eassert (!(forwarded && BUFFER_OBJFWDP (valcontents.fwd)));
1474 eassert (!(forwarded && KBOARD_OBJFWDP (valcontents.fwd))); 1516 eassert (!(forwarded && KBOARD_OBJFWDP (valcontents.fwd)));
1475 blv->fwd = forwarded ? valcontents.fwd : NULL; 1517 blv->fwd = forwarded ? valcontents.fwd : NULL;
1476 blv->where = Qnil; 1518 set_blv_where (blv, Qnil);
1477 blv->frame_local = 0; 1519 blv->frame_local = 0;
1478 blv->local_if_set = 0; 1520 blv->local_if_set = 0;
1479 blv->defcell = tem; 1521 set_blv_defcell (blv, tem);
1480 blv->valcell = tem; 1522 set_blv_valcell (blv, tem);
1481 SET_BLV_FOUND (blv, 0); 1523 set_blv_found (blv, 0);
1482 return blv; 1524 return blv;
1483} 1525}
1484 1526
@@ -1500,8 +1542,8 @@ The function `default-value' gets the default value and `set-default' sets it.
1500{ 1542{
1501 struct Lisp_Symbol *sym; 1543 struct Lisp_Symbol *sym;
1502 struct Lisp_Buffer_Local_Value *blv = NULL; 1544 struct Lisp_Buffer_Local_Value *blv = NULL;
1503 union Lisp_Val_Fwd valcontents IF_LINT (= {0}); 1545 union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
1504 int forwarded IF_LINT (= 0); 1546 bool forwarded IF_LINT (= 0);
1505 1547
1506 CHECK_SYMBOL (variable); 1548 CHECK_SYMBOL (variable);
1507 sym = XSYMBOL (variable); 1549 sym = XSYMBOL (variable);
@@ -1529,7 +1571,7 @@ The function `default-value' gets the default value and `set-default' sets it.
1529 else if (BUFFER_OBJFWDP (valcontents.fwd)) 1571 else if (BUFFER_OBJFWDP (valcontents.fwd))
1530 return variable; 1572 return variable;
1531 break; 1573 break;
1532 default: abort (); 1574 default: emacs_abort ();
1533 } 1575 }
1534 1576
1535 if (sym->constant) 1577 if (sym->constant)
@@ -1573,11 +1615,11 @@ See also `make-variable-buffer-local'.
1573 1615
1574Do not use `make-local-variable' to make a hook variable buffer-local. 1616Do not use `make-local-variable' to make a hook variable buffer-local.
1575Instead, use `add-hook' and specify t for the LOCAL argument. */) 1617Instead, use `add-hook' and specify t for the LOCAL argument. */)
1576 (register Lisp_Object variable) 1618 (Lisp_Object variable)
1577{ 1619{
1578 register Lisp_Object tem; 1620 Lisp_Object tem;
1579 int forwarded IF_LINT (= 0); 1621 bool forwarded IF_LINT (= 0);
1580 union Lisp_Val_Fwd valcontents IF_LINT (= {0}); 1622 union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO});
1581 struct Lisp_Symbol *sym; 1623 struct Lisp_Symbol *sym;
1582 struct Lisp_Buffer_Local_Value *blv = NULL; 1624 struct Lisp_Buffer_Local_Value *blv = NULL;
1583 1625
@@ -1602,7 +1644,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
1602 error ("Symbol %s may not be buffer-local", 1644 error ("Symbol %s may not be buffer-local",
1603 SDATA (SYMBOL_NAME (variable))); 1645 SDATA (SYMBOL_NAME (variable)));
1604 break; 1646 break;
1605 default: abort (); 1647 default: emacs_abort ();
1606 } 1648 }
1607 1649
1608 if (sym->constant) 1650 if (sym->constant)
@@ -1647,17 +1689,16 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
1647 default value. */ 1689 default value. */
1648 find_symbol_value (variable); 1690 find_symbol_value (variable);
1649 1691
1650 BVAR (current_buffer, local_var_alist) 1692 bset_local_var_alist
1651 = Fcons (Fcons (variable, XCDR (blv->defcell)), 1693 (current_buffer,
1652 BVAR (current_buffer, local_var_alist)); 1694 Fcons (Fcons (variable, XCDR (blv->defcell)),
1695 BVAR (current_buffer, local_var_alist)));
1653 1696
1654 /* Make sure symbol does not think it is set up for this buffer; 1697 /* Make sure symbol does not think it is set up for this buffer;
1655 force it to look once again for this buffer's value. */ 1698 force it to look once again for this buffer's value. */
1656 if (current_buffer == XBUFFER (blv->where)) 1699 if (current_buffer == XBUFFER (blv->where))
1657 blv->where = Qnil; 1700 set_blv_where (blv, Qnil);
1658 /* blv->valcell = blv->defcell; 1701 set_blv_found (blv, 0);
1659 * SET_BLV_FOUND (blv, 0); */
1660 blv->found = 0;
1661 } 1702 }
1662 1703
1663 /* If the symbol forwards into a C variable, then load the binding 1704 /* If the symbol forwards into a C variable, then load the binding
@@ -1699,8 +1740,8 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
1699 if (idx > 0) 1740 if (idx > 0)
1700 { 1741 {
1701 SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0); 1742 SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0);
1702 PER_BUFFER_VALUE (current_buffer, offset) 1743 set_per_buffer_value (current_buffer, offset,
1703 = PER_BUFFER_DEFAULT (offset); 1744 per_buffer_default (offset));
1704 } 1745 }
1705 } 1746 }
1706 return variable; 1747 return variable;
@@ -1710,15 +1751,16 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
1710 if (blv->frame_local) 1751 if (blv->frame_local)
1711 return variable; 1752 return variable;
1712 break; 1753 break;
1713 default: abort (); 1754 default: emacs_abort ();
1714 } 1755 }
1715 1756
1716 /* Get rid of this buffer's alist element, if any. */ 1757 /* Get rid of this buffer's alist element, if any. */
1717 XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ 1758 XSETSYMBOL (variable, sym); /* Propagate variable indirection. */
1718 tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); 1759 tem = Fassq (variable, BVAR (current_buffer, local_var_alist));
1719 if (!NILP (tem)) 1760 if (!NILP (tem))
1720 BVAR (current_buffer, local_var_alist) 1761 bset_local_var_alist
1721 = Fdelq (tem, BVAR (current_buffer, local_var_alist)); 1762 (current_buffer,
1763 Fdelq (tem, BVAR (current_buffer, local_var_alist)));
1722 1764
1723 /* If the symbol is set up with the current buffer's binding 1765 /* If the symbol is set up with the current buffer's binding
1724 loaded, recompute its value. We have to do it now, or else 1766 loaded, recompute its value. We have to do it now, or else
@@ -1727,9 +1769,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
1727 Lisp_Object buf; XSETBUFFER (buf, current_buffer); 1769 Lisp_Object buf; XSETBUFFER (buf, current_buffer);
1728 if (EQ (buf, blv->where)) 1770 if (EQ (buf, blv->where))
1729 { 1771 {
1730 blv->where = Qnil; 1772 set_blv_where (blv, Qnil);
1731 /* blv->valcell = blv->defcell;
1732 * SET_BLV_FOUND (blv, 0); */
1733 blv->found = 0; 1773 blv->found = 0;
1734 find_symbol_value (variable); 1774 find_symbol_value (variable);
1735 } 1775 }
@@ -1762,9 +1802,9 @@ is to set the VARIABLE frame parameter of that frame. See
1762Note that since Emacs 23.1, variables cannot be both buffer-local and 1802Note that since Emacs 23.1, variables cannot be both buffer-local and
1763frame-local any more (buffer-local bindings used to take precedence over 1803frame-local any more (buffer-local bindings used to take precedence over
1764frame-local bindings). */) 1804frame-local bindings). */)
1765 (register Lisp_Object variable) 1805 (Lisp_Object variable)
1766{ 1806{
1767 int forwarded; 1807 bool forwarded;
1768 union Lisp_Val_Fwd valcontents; 1808 union Lisp_Val_Fwd valcontents;
1769 struct Lisp_Symbol *sym; 1809 struct Lisp_Symbol *sym;
1770 struct Lisp_Buffer_Local_Value *blv = NULL; 1810 struct Lisp_Buffer_Local_Value *blv = NULL;
@@ -1793,7 +1833,7 @@ frame-local bindings). */)
1793 error ("Symbol %s may not be frame-local", 1833 error ("Symbol %s may not be frame-local",
1794 SDATA (SYMBOL_NAME (variable))); 1834 SDATA (SYMBOL_NAME (variable)));
1795 break; 1835 break;
1796 default: abort (); 1836 default: emacs_abort ();
1797 } 1837 }
1798 1838
1799 if (sym->constant) 1839 if (sym->constant)
@@ -1845,17 +1885,18 @@ BUFFER defaults to the current buffer. */)
1845 XSETBUFFER (tmp, buf); 1885 XSETBUFFER (tmp, buf);
1846 XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ 1886 XSETSYMBOL (variable, sym); /* Update in case of aliasing. */
1847 1887
1848 for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) 1888 if (EQ (blv->where, tmp)) /* The binding is already loaded. */
1849 { 1889 return blv_found (blv) ? Qt : Qnil;
1850 elt = XCAR (tail); 1890 else
1851 if (EQ (variable, XCAR (elt))) 1891 for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
1852 { 1892 {
1853 eassert (!blv->frame_local); 1893 elt = XCAR (tail);
1854 eassert (BLV_FOUND (blv) || !EQ (blv->where, tmp)); 1894 if (EQ (variable, XCAR (elt)))
1855 return Qt; 1895 {
1856 } 1896 eassert (!blv->frame_local);
1857 } 1897 return Qt;
1858 eassert (!BLV_FOUND (blv) || !EQ (blv->where, tmp)); 1898 }
1899 }
1859 return Qnil; 1900 return Qnil;
1860 } 1901 }
1861 case SYMBOL_FORWARDED: 1902 case SYMBOL_FORWARDED:
@@ -1870,18 +1911,18 @@ BUFFER defaults to the current buffer. */)
1870 } 1911 }
1871 return Qnil; 1912 return Qnil;
1872 } 1913 }
1873 default: abort (); 1914 default: emacs_abort ();
1874 } 1915 }
1875} 1916}
1876 1917
1877DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p, 1918DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p,
1878 1, 2, 0, 1919 1, 2, 0,
1879 doc: /* Non-nil if VARIABLE will be local in buffer BUFFER when set there. 1920 doc: /* Non-nil if VARIABLE is local in buffer BUFFER when set there.
1880More precisely, this means that setting the variable \(with `set' or`setq'), 1921BUFFER defaults to the current buffer.
1881while it does not have a `let'-style binding that was made in BUFFER, 1922
1882will produce a buffer local binding. See Info node 1923More precisely, return non-nil if either VARIABLE already has a local
1883`(elisp)Creating Buffer-Local'. 1924value in BUFFER, or if VARIABLE is automatically buffer-local (see
1884BUFFER defaults to the current buffer. */) 1925`make-variable-buffer-local'). */)
1885 (register Lisp_Object variable, Lisp_Object buffer) 1926 (register Lisp_Object variable, Lisp_Object buffer)
1886{ 1927{
1887 struct Lisp_Symbol *sym; 1928 struct Lisp_Symbol *sym;
@@ -1905,7 +1946,7 @@ BUFFER defaults to the current buffer. */)
1905 case SYMBOL_FORWARDED: 1946 case SYMBOL_FORWARDED:
1906 /* All BUFFER_OBJFWD slots become local if they are set. */ 1947 /* All BUFFER_OBJFWD slots become local if they are set. */
1907 return (BUFFER_OBJFWDP (SYMBOL_FWD (sym)) ? Qt : Qnil); 1948 return (BUFFER_OBJFWDP (SYMBOL_FWD (sym)) ? Qt : Qnil);
1908 default: abort (); 1949 default: emacs_abort ();
1909 } 1950 }
1910} 1951}
1911 1952
@@ -1934,7 +1975,7 @@ If the current binding is global (the default), the value is nil. */)
1934 { 1975 {
1935 union Lisp_Fwd *valcontents = SYMBOL_FWD (sym); 1976 union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
1936 if (KBOARD_OBJFWDP (valcontents)) 1977 if (KBOARD_OBJFWDP (valcontents))
1937 return Fframe_terminal (Fselected_frame ()); 1978 return Fframe_terminal (selected_frame);
1938 else if (!BUFFER_OBJFWDP (valcontents)) 1979 else if (!BUFFER_OBJFWDP (valcontents))
1939 return Qnil; 1980 return Qnil;
1940 } 1981 }
@@ -1945,11 +1986,11 @@ If the current binding is global (the default), the value is nil. */)
1945 if (!NILP (Flocal_variable_p (variable, Qnil))) 1986 if (!NILP (Flocal_variable_p (variable, Qnil)))
1946 return Fcurrent_buffer (); 1987 return Fcurrent_buffer ();
1947 else if (sym->redirect == SYMBOL_LOCALIZED 1988 else if (sym->redirect == SYMBOL_LOCALIZED
1948 && BLV_FOUND (SYMBOL_BLV (sym))) 1989 && blv_found (SYMBOL_BLV (sym)))
1949 return SYMBOL_BLV (sym)->where; 1990 return SYMBOL_BLV (sym)->where;
1950 else 1991 else
1951 return Qnil; 1992 return Qnil;
1952 default: abort (); 1993 default: emacs_abort ();
1953 } 1994 }
1954} 1995}
1955 1996
@@ -2013,10 +2054,10 @@ indirect_function (register Lisp_Object object)
2013 2054
2014 for (;;) 2055 for (;;)
2015 { 2056 {
2016 if (!SYMBOLP (hare) || EQ (hare, Qunbound)) 2057 if (!SYMBOLP (hare) || NILP (hare))
2017 break; 2058 break;
2018 hare = XSYMBOL (hare)->function; 2059 hare = XSYMBOL (hare)->function;
2019 if (!SYMBOLP (hare) || EQ (hare, Qunbound)) 2060 if (!SYMBOLP (hare) || NILP (hare))
2020 break; 2061 break;
2021 hare = XSYMBOL (hare)->function; 2062 hare = XSYMBOL (hare)->function;
2022 2063
@@ -2043,10 +2084,10 @@ function chain of symbols. */)
2043 2084
2044 /* Optimize for no indirection. */ 2085 /* Optimize for no indirection. */
2045 result = object; 2086 result = object;
2046 if (SYMBOLP (result) && !EQ (result, Qunbound) 2087 if (SYMBOLP (result) && !NILP (result)
2047 && (result = XSYMBOL (result)->function, SYMBOLP (result))) 2088 && (result = XSYMBOL (result)->function, SYMBOLP (result)))
2048 result = indirect_function (result); 2089 result = indirect_function (result);
2049 if (!EQ (result, Qunbound)) 2090 if (!NILP (result))
2050 return result; 2091 return result;
2051 2092
2052 if (NILP (noerror)) 2093 if (NILP (noerror))
@@ -2055,7 +2096,7 @@ function chain of symbols. */)
2055 return Qnil; 2096 return Qnil;
2056} 2097}
2057 2098
2058/* Extract and set vector and string elements */ 2099/* Extract and set vector and string elements. */
2059 2100
2060DEFUN ("aref", Faref, Saref, 2, 2, 0, 2101DEFUN ("aref", Faref, Saref, 2, 2, 0,
2061 doc: /* Return the element of ARRAY at index IDX. 2102 doc: /* Return the element of ARRAY at index IDX.
@@ -2129,7 +2170,7 @@ bool-vector. IDX starts at 0. */)
2129 { 2170 {
2130 if (idxval < 0 || idxval >= ASIZE (array)) 2171 if (idxval < 0 || idxval >= ASIZE (array))
2131 args_out_of_range (array, idx); 2172 args_out_of_range (array, idx);
2132 XVECTOR (array)->contents[idxval] = newelt; 2173 ASET (array, idxval, newelt);
2133 } 2174 }
2134 else if (BOOL_VECTOR_P (array)) 2175 else if (BOOL_VECTOR_P (array))
2135 { 2176 {
@@ -2175,10 +2216,9 @@ bool-vector. IDX starts at 0. */)
2175 { 2216 {
2176 /* We must relocate the string data. */ 2217 /* We must relocate the string data. */
2177 ptrdiff_t nchars = SCHARS (array); 2218 ptrdiff_t nchars = SCHARS (array);
2178 unsigned char *str;
2179 USE_SAFE_ALLOCA; 2219 USE_SAFE_ALLOCA;
2220 unsigned char *str = SAFE_ALLOCA (nbytes);
2180 2221
2181 SAFE_ALLOCA (str, unsigned char *, nbytes);
2182 memcpy (str, SDATA (array), nbytes); 2222 memcpy (str, SDATA (array), nbytes);
2183 allocate_string_data (XSTRING (array), nchars, 2223 allocate_string_data (XSTRING (array), nchars,
2184 nbytes + new_bytes - prev_bytes); 2224 nbytes + new_bytes - prev_bytes);
@@ -2221,7 +2261,7 @@ static Lisp_Object
2221arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison) 2261arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
2222{ 2262{
2223 double f1 = 0, f2 = 0; 2263 double f1 = 0, f2 = 0;
2224 int floatp = 0; 2264 bool floatp = 0;
2225 2265
2226 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1); 2266 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1);
2227 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2); 2267 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2);
@@ -2266,7 +2306,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
2266 return Qnil; 2306 return Qnil;
2267 2307
2268 default: 2308 default:
2269 abort (); 2309 emacs_abort ();
2270 } 2310 }
2271} 2311}
2272 2312
@@ -2338,7 +2378,7 @@ DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
2338uintmax_t 2378uintmax_t
2339cons_to_unsigned (Lisp_Object c, uintmax_t max) 2379cons_to_unsigned (Lisp_Object c, uintmax_t max)
2340{ 2380{
2341 int valid = 0; 2381 bool valid = 0;
2342 uintmax_t val IF_LINT (= 0); 2382 uintmax_t val IF_LINT (= 0);
2343 if (INTEGERP (c)) 2383 if (INTEGERP (c))
2344 { 2384 {
@@ -2391,7 +2431,7 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max)
2391intmax_t 2431intmax_t
2392cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) 2432cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
2393{ 2433{
2394 int valid = 0; 2434 bool valid = 0;
2395 intmax_t val IF_LINT (= 0); 2435 intmax_t val IF_LINT (= 0);
2396 if (INTEGERP (c)) 2436 if (INTEGERP (c))
2397 { 2437 {
@@ -2444,20 +2484,17 @@ Uses a minus sign if negative.
2444NUMBER may be an integer or a floating point number. */) 2484NUMBER may be an integer or a floating point number. */)
2445 (Lisp_Object number) 2485 (Lisp_Object number)
2446{ 2486{
2447 char buffer[VALBITS]; 2487 char buffer[max (FLOAT_TO_STRING_BUFSIZE, INT_BUFSIZE_BOUND (EMACS_INT))];
2488 int len;
2448 2489
2449 CHECK_NUMBER_OR_FLOAT (number); 2490 CHECK_NUMBER_OR_FLOAT (number);
2450 2491
2451 if (FLOATP (number)) 2492 if (FLOATP (number))
2452 { 2493 len = float_to_string (buffer, XFLOAT_DATA (number));
2453 char pigbuf[FLOAT_TO_STRING_BUFSIZE]; 2494 else
2454 2495 len = sprintf (buffer, "%"pI"d", XINT (number));
2455 float_to_string (pigbuf, XFLOAT_DATA (number));
2456 return build_string (pigbuf);
2457 }
2458 2496
2459 sprintf (buffer, "%"pI"d", XINT (number)); 2497 return make_unibyte_string (buffer, len);
2460 return build_string (buffer);
2461} 2498}
2462 2499
2463DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0, 2500DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0,
@@ -2512,16 +2549,13 @@ static Lisp_Object float_arith_driver (double, ptrdiff_t, enum arithop,
2512static Lisp_Object 2549static Lisp_Object
2513arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) 2550arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
2514{ 2551{
2515 register Lisp_Object val; 2552 Lisp_Object val;
2516 ptrdiff_t argnum; 2553 ptrdiff_t argnum, ok_args;
2517 register EMACS_INT accum = 0; 2554 EMACS_INT accum = 0;
2518 register EMACS_INT next; 2555 EMACS_INT next, ok_accum;
2519 2556 bool overflow = 0;
2520 int overflow = 0;
2521 ptrdiff_t ok_args;
2522 EMACS_INT ok_accum;
2523 2557
2524 switch (SWITCH_ENUM_CAST (code)) 2558 switch (code)
2525 { 2559 {
2526 case Alogior: 2560 case Alogior:
2527 case Alogxor: 2561 case Alogxor:
@@ -2556,7 +2590,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
2556 nargs, args); 2590 nargs, args);
2557 args[argnum] = val; 2591 args[argnum] = val;
2558 next = XINT (args[argnum]); 2592 next = XINT (args[argnum]);
2559 switch (SWITCH_ENUM_CAST (code)) 2593 switch (code)
2560 { 2594 {
2561 case Aadd: 2595 case Aadd:
2562 if (INT_ADD_OVERFLOW (accum, next)) 2596 if (INT_ADD_OVERFLOW (accum, next))
@@ -2642,7 +2676,7 @@ float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code,
2642 args[argnum] = val; /* runs into a compiler bug. */ 2676 args[argnum] = val; /* runs into a compiler bug. */
2643 next = XINT (args[argnum]); 2677 next = XINT (args[argnum]);
2644 } 2678 }
2645 switch (SWITCH_ENUM_CAST (code)) 2679 switch (code)
2646 { 2680 {
2647 case Aadd: 2681 case Aadd:
2648 accum += next; 2682 accum += next;
@@ -2708,10 +2742,10 @@ usage: (* &rest NUMBERS-OR-MARKERS) */)
2708 return arith_driver (Amult, nargs, args); 2742 return arith_driver (Amult, nargs, args);
2709} 2743}
2710 2744
2711DEFUN ("/", Fquo, Squo, 2, MANY, 0, 2745DEFUN ("/", Fquo, Squo, 1, MANY, 0,
2712 doc: /* Return first argument divided by all the remaining arguments. 2746 doc: /* Return first argument divided by all the remaining arguments.
2713The arguments must be numbers or markers. 2747The arguments must be numbers or markers.
2714usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */) 2748usage: (/ DIVIDEND &rest DIVISORS) */)
2715 (ptrdiff_t nargs, Lisp_Object *args) 2749 (ptrdiff_t nargs, Lisp_Object *args)
2716{ 2750{
2717 ptrdiff_t argnum; 2751 ptrdiff_t argnum;
@@ -2738,28 +2772,6 @@ Both must be integers or markers. */)
2738 return val; 2772 return val;
2739} 2773}
2740 2774
2741#ifndef HAVE_FMOD
2742double
2743fmod (double f1, double f2)
2744{
2745 double r = f1;
2746
2747 if (f2 < 0.0)
2748 f2 = -f2;
2749
2750 /* If the magnitude of the result exceeds that of the divisor, or
2751 the sign of the result does not agree with that of the dividend,
2752 iterate with the reduced value. This does not yield a
2753 particularly accurate result, but at least it will be in the
2754 range promised by fmod. */
2755 do
2756 r -= f2 * floor (r / f2);
2757 while (f2 <= (r < 0 ? -r : r) || ((r < 0) != (f1 < 0) && ! isnan (r)));
2758
2759 return r;
2760}
2761#endif /* ! HAVE_FMOD */
2762
2763DEFUN ("mod", Fmod, Smod, 2, 2, 0, 2775DEFUN ("mod", Fmod, Smod, 2, 2, 0,
2764 doc: /* Return X modulo Y. 2776 doc: /* Return X modulo Y.
2765The result falls between zero (inclusive) and Y (exclusive). 2777The result falls between zero (inclusive) and Y (exclusive).
@@ -3010,11 +3022,11 @@ syms_of_data (void)
3010 Fput (Qerror, Qerror_conditions, 3022 Fput (Qerror, Qerror_conditions,
3011 error_tail); 3023 error_tail);
3012 Fput (Qerror, Qerror_message, 3024 Fput (Qerror, Qerror_message,
3013 make_pure_c_string ("error")); 3025 build_pure_c_string ("error"));
3014 3026
3015#define PUT_ERROR(sym, tail, msg) \ 3027#define PUT_ERROR(sym, tail, msg) \
3016 Fput (sym, Qerror_conditions, pure_cons (sym, tail)); \ 3028 Fput (sym, Qerror_conditions, pure_cons (sym, tail)); \
3017 Fput (sym, Qerror_message, make_pure_c_string (msg)) 3029 Fput (sym, Qerror_message, build_pure_c_string (msg))
3018 3030
3019 PUT_ERROR (Qquit, Qnil, "Quit"); 3031 PUT_ERROR (Qquit, Qnil, "Quit");
3020 3032
@@ -3041,7 +3053,7 @@ syms_of_data (void)
3041 3053
3042 arith_tail = pure_cons (Qarith_error, error_tail); 3054 arith_tail = pure_cons (Qarith_error, error_tail);
3043 Fput (Qarith_error, Qerror_conditions, arith_tail); 3055 Fput (Qarith_error, Qerror_conditions, arith_tail);
3044 Fput (Qarith_error, Qerror_message, make_pure_c_string ("Arithmetic error")); 3056 Fput (Qarith_error, Qerror_message, build_pure_c_string ("Arithmetic error"));
3045 3057
3046 PUT_ERROR (Qbeginning_of_buffer, error_tail, "Beginning of buffer"); 3058 PUT_ERROR (Qbeginning_of_buffer, error_tail, "Beginning of buffer");
3047 PUT_ERROR (Qend_of_buffer, error_tail, "End of buffer"); 3059 PUT_ERROR (Qend_of_buffer, error_tail, "End of buffer");
@@ -3082,7 +3094,6 @@ syms_of_data (void)
3082 DEFSYM (Qwindow_configuration, "window-configuration"); 3094 DEFSYM (Qwindow_configuration, "window-configuration");
3083 DEFSYM (Qprocess, "process"); 3095 DEFSYM (Qprocess, "process");
3084 DEFSYM (Qwindow, "window"); 3096 DEFSYM (Qwindow, "window");
3085 /* DEFSYM (Qsubr, "subr"); */
3086 DEFSYM (Qcompiled_function, "compiled-function"); 3097 DEFSYM (Qcompiled_function, "compiled-function");
3087 DEFSYM (Qbuffer, "buffer"); 3098 DEFSYM (Qbuffer, "buffer");
3088 DEFSYM (Qframe, "frame"); 3099 DEFSYM (Qframe, "frame");
@@ -3090,6 +3101,7 @@ syms_of_data (void)
3090 DEFSYM (Qchar_table, "char-table"); 3101 DEFSYM (Qchar_table, "char-table");
3091 DEFSYM (Qbool_vector, "bool-vector"); 3102 DEFSYM (Qbool_vector, "bool-vector");
3092 DEFSYM (Qhash_table, "hash-table"); 3103 DEFSYM (Qhash_table, "hash-table");
3104 DEFSYM (Qmisc, "misc");
3093 3105
3094 DEFSYM (Qdefun, "defun"); 3106 DEFSYM (Qdefun, "defun");
3095 3107
@@ -3098,6 +3110,7 @@ syms_of_data (void)
3098 DEFSYM (Qfont_object, "font-object"); 3110 DEFSYM (Qfont_object, "font-object");
3099 3111
3100 DEFSYM (Qinteractive_form, "interactive-form"); 3112 DEFSYM (Qinteractive_form, "interactive-form");
3113 DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
3101 3114
3102 defsubr (&Sindirect_variable); 3115 defsubr (&Sindirect_variable);
3103 defsubr (&Sinteractive_form); 3116 defsubr (&Sinteractive_form);
@@ -3194,7 +3207,7 @@ syms_of_data (void)
3194 defsubr (&Ssubr_arity); 3207 defsubr (&Ssubr_arity);
3195 defsubr (&Ssubr_name); 3208 defsubr (&Ssubr_name);
3196 3209
3197 XSYMBOL (Qwholenump)->function = XSYMBOL (Qnatnump)->function; 3210 set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->function);
3198 3211
3199 DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum, 3212 DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum,
3200 doc: /* The largest value that is representable in a Lisp integer. */); 3213 doc: /* The largest value that is representable in a Lisp integer. */);
@@ -3206,30 +3219,3 @@ syms_of_data (void)
3206 Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM); 3219 Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
3207 XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1; 3220 XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1;
3208} 3221}
3209
3210#ifndef FORWARD_SIGNAL_TO_MAIN_THREAD
3211static void arith_error (int) NO_RETURN;
3212#endif
3213
3214static void
3215arith_error (int signo)
3216{
3217 sigsetmask (SIGEMPTYMASK);
3218
3219 SIGNAL_THREAD_CHECK (signo);
3220 xsignal0 (Qarith_error);
3221}
3222
3223void
3224init_data (void)
3225{
3226 /* Don't do this if just dumping out.
3227 We don't want to call `signal' in this case
3228 so that we don't have trouble with dumping
3229 signal-delivering routines in an inconsistent state. */
3230#ifndef CANNOT_DUMP
3231 if (!initialized)
3232 return;
3233#endif /* CANNOT_DUMP */
3234 signal (SIGFPE, arith_error);
3235}