1 /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985,86,88,93,94,95,97,98, 1999 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
35 #include "syssignal.h"
37 #ifdef LISP_FLOAT_TYPE
43 /* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
44 #ifndef IEEE_FLOATING_POINT
45 #if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
46 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
47 #define IEEE_FLOATING_POINT 1
49 #define IEEE_FLOATING_POINT 0
53 /* Work around a problem that happens because math.h on hpux 7
54 defines two static variables--which, in Emacs, are not really static,
55 because `static' is defined as nothing. The problem is that they are
56 here, in floatfns.c, and in lread.c.
57 These macros prevent the name conflict. */
58 #if defined (HPUX) && !defined (HPUX8)
59 #define _MAXLDBL data_c_maxldbl
60 #define _NMAXLDBL data_c_nmaxldbl
64 #endif /* LISP_FLOAT_TYPE */
67 extern double atof ();
70 /* Nonzero means it is an error to set a symbol whose name starts with
72 int keyword_symbols_constant_flag
;
74 Lisp_Object Qnil
, Qt
, Qquote
, Qlambda
, Qsubr
, Qunbound
;
75 Lisp_Object Qerror_conditions
, Qerror_message
, Qtop_level
;
76 Lisp_Object Qerror
, Qquit
, Qwrong_type_argument
, Qargs_out_of_range
;
77 Lisp_Object Qvoid_variable
, Qvoid_function
, Qcyclic_function_indirection
;
78 Lisp_Object Qsetting_constant
, Qinvalid_read_syntax
;
79 Lisp_Object Qinvalid_function
, Qwrong_number_of_arguments
, Qno_catch
;
80 Lisp_Object Qend_of_file
, Qarith_error
, Qmark_inactive
;
81 Lisp_Object Qbeginning_of_buffer
, Qend_of_buffer
, Qbuffer_read_only
;
82 Lisp_Object Qtext_read_only
;
83 Lisp_Object Qintegerp
, Qnatnump
, Qwholenump
, Qsymbolp
, Qlistp
, Qconsp
;
84 Lisp_Object Qstringp
, Qarrayp
, Qsequencep
, Qbufferp
;
85 Lisp_Object Qchar_or_string_p
, Qmarkerp
, Qinteger_or_marker_p
, Qvectorp
;
86 Lisp_Object Qbuffer_or_string_p
;
87 Lisp_Object Qboundp
, Qfboundp
;
88 Lisp_Object Qchar_table_p
, Qvector_or_char_table_p
;
91 Lisp_Object Qad_advice_info
, Qad_activate_internal
;
93 Lisp_Object Qrange_error
, Qdomain_error
, Qsingularity_error
;
94 Lisp_Object Qoverflow_error
, Qunderflow_error
;
96 #ifdef LISP_FLOAT_TYPE
98 Lisp_Object Qnumberp
, Qnumber_or_marker_p
;
101 static Lisp_Object Qinteger
, Qsymbol
, Qstring
, Qcons
, Qmarker
, Qoverlay
;
102 static Lisp_Object Qfloat
, Qwindow_configuration
, Qwindow
;
103 Lisp_Object Qprocess
;
104 static Lisp_Object Qcompiled_function
, Qbuffer
, Qframe
, Qvector
;
105 static Lisp_Object Qchar_table
, Qbool_vector
, Qhash_table
;
107 static Lisp_Object
swap_in_symval_forwarding ();
109 Lisp_Object
set_internal ();
112 wrong_type_argument (predicate
, value
)
113 register Lisp_Object predicate
, value
;
115 register Lisp_Object tem
;
118 if (!EQ (Vmocklisp_arguments
, Qt
))
120 if (STRINGP (value
) &&
121 (EQ (predicate
, Qintegerp
) || EQ (predicate
, Qinteger_or_marker_p
)))
122 return Fstring_to_number (value
, Qnil
);
123 if (INTEGERP (value
) && EQ (predicate
, Qstringp
))
124 return Fnumber_to_string (value
);
127 /* If VALUE is not even a valid Lisp object, abort here
128 where we can get a backtrace showing where it came from. */
129 if ((unsigned int) XGCTYPE (value
) >= Lisp_Type_Limit
)
132 value
= Fsignal (Qwrong_type_argument
, Fcons (predicate
, Fcons (value
, Qnil
)));
133 tem
= call1 (predicate
, value
);
142 error ("Attempt to modify read-only object");
146 args_out_of_range (a1
, a2
)
150 Fsignal (Qargs_out_of_range
, Fcons (a1
, Fcons (a2
, Qnil
)));
154 args_out_of_range_3 (a1
, a2
, a3
)
155 Lisp_Object a1
, a2
, a3
;
158 Fsignal (Qargs_out_of_range
, Fcons (a1
, Fcons (a2
, Fcons (a3
, Qnil
))));
161 /* On some machines, XINT needs a temporary location.
162 Here it is, in case it is needed. */
164 int sign_extend_temp
;
166 /* On a few machines, XINT can only be done by calling this. */
169 sign_extend_lisp_int (num
)
172 if (num
& (((EMACS_INT
) 1) << (VALBITS
- 1)))
173 return num
| (((EMACS_INT
) (-1)) << VALBITS
);
175 return num
& ((((EMACS_INT
) 1) << VALBITS
) - 1);
178 /* Data type predicates */
180 DEFUN ("eq", Feq
, Seq
, 2, 2, 0,
181 "Return t if the two args are the same Lisp object.")
183 Lisp_Object obj1
, obj2
;
190 DEFUN ("null", Fnull
, Snull
, 1, 1, 0, "Return t if OBJECT is nil.")
199 DEFUN ("type-of", Ftype_of
, Stype_of
, 1, 1, 0,
200 "Return a symbol representing the type of OBJECT.\n\
201 The symbol returned names the object's basic type;\n\
202 for example, (type-of 1) returns `integer'.")
206 switch (XGCTYPE (object
))
221 switch (XMISCTYPE (object
))
223 case Lisp_Misc_Marker
:
225 case Lisp_Misc_Overlay
:
227 case Lisp_Misc_Float
:
232 case Lisp_Vectorlike
:
233 if (GC_WINDOW_CONFIGURATIONP (object
))
234 return Qwindow_configuration
;
235 if (GC_PROCESSP (object
))
237 if (GC_WINDOWP (object
))
239 if (GC_SUBRP (object
))
241 if (GC_COMPILEDP (object
))
242 return Qcompiled_function
;
243 if (GC_BUFFERP (object
))
245 if (GC_CHAR_TABLE_P (object
))
247 if (GC_BOOL_VECTOR_P (object
))
249 if (GC_FRAMEP (object
))
251 if (GC_HASH_TABLE_P (object
))
255 #ifdef LISP_FLOAT_TYPE
265 DEFUN ("consp", Fconsp
, Sconsp
, 1, 1, 0, "Return t if OBJECT is a cons cell.")
274 DEFUN ("atom", Fatom
, Satom
, 1, 1, 0,
275 "Return t if OBJECT is not a cons cell. This includes nil.")
284 DEFUN ("listp", Flistp
, Slistp
, 1, 1, 0,
285 "Return t if OBJECT is a list. This includes nil.")
289 if (CONSP (object
) || NILP (object
))
294 DEFUN ("nlistp", Fnlistp
, Snlistp
, 1, 1, 0,
295 "Return t if OBJECT is not a list. Lists include nil.")
299 if (CONSP (object
) || NILP (object
))
304 DEFUN ("symbolp", Fsymbolp
, Ssymbolp
, 1, 1, 0,
305 "Return t if OBJECT is a symbol.")
309 if (SYMBOLP (object
))
314 DEFUN ("vectorp", Fvectorp
, Svectorp
, 1, 1, 0,
315 "Return t if OBJECT is a vector.")
319 if (VECTORP (object
))
324 DEFUN ("stringp", Fstringp
, Sstringp
, 1, 1, 0,
325 "Return t if OBJECT is a string.")
329 if (STRINGP (object
))
334 DEFUN ("multibyte-string-p", Fmultibyte_string_p
, Smultibyte_string_p
,
335 1, 1, 0, "Return t if OBJECT is a multibyte string.")
339 if (STRINGP (object
) && STRING_MULTIBYTE (object
))
344 DEFUN ("char-table-p", Fchar_table_p
, Schar_table_p
, 1, 1, 0,
345 "Return t if OBJECT is a char-table.")
349 if (CHAR_TABLE_P (object
))
354 DEFUN ("vector-or-char-table-p", Fvector_or_char_table_p
,
355 Svector_or_char_table_p
, 1, 1, 0,
356 "Return t if OBJECT is a char-table or vector.")
360 if (VECTORP (object
) || CHAR_TABLE_P (object
))
365 DEFUN ("bool-vector-p", Fbool_vector_p
, Sbool_vector_p
, 1, 1, 0, "Return t if OBJECT is a bool-vector.")
369 if (BOOL_VECTOR_P (object
))
374 DEFUN ("arrayp", Farrayp
, Sarrayp
, 1, 1, 0, "Return t if OBJECT is an array (string or vector).")
378 if (VECTORP (object
) || STRINGP (object
)
379 || CHAR_TABLE_P (object
) || BOOL_VECTOR_P (object
))
384 DEFUN ("sequencep", Fsequencep
, Ssequencep
, 1, 1, 0,
385 "Return t if OBJECT is a sequence (list or array).")
387 register Lisp_Object object
;
389 if (CONSP (object
) || NILP (object
) || VECTORP (object
) || STRINGP (object
)
390 || CHAR_TABLE_P (object
) || BOOL_VECTOR_P (object
))
395 DEFUN ("bufferp", Fbufferp
, Sbufferp
, 1, 1, 0, "Return t if OBJECT is an editor buffer.")
399 if (BUFFERP (object
))
404 DEFUN ("markerp", Fmarkerp
, Smarkerp
, 1, 1, 0, "Return t if OBJECT is a marker (editor pointer).")
408 if (MARKERP (object
))
413 DEFUN ("subrp", Fsubrp
, Ssubrp
, 1, 1, 0, "Return t if OBJECT is a built-in function.")
422 DEFUN ("byte-code-function-p", Fbyte_code_function_p
, Sbyte_code_function_p
,
423 1, 1, 0, "Return t if OBJECT is a byte-compiled function object.")
427 if (COMPILEDP (object
))
432 DEFUN ("char-or-string-p", Fchar_or_string_p
, Schar_or_string_p
, 1, 1, 0,
433 "Return t if OBJECT is a character (an integer) or a string.")
435 register Lisp_Object object
;
437 if (INTEGERP (object
) || STRINGP (object
))
442 DEFUN ("integerp", Fintegerp
, Sintegerp
, 1, 1, 0, "Return t if OBJECT is an integer.")
446 if (INTEGERP (object
))
451 DEFUN ("integer-or-marker-p", Finteger_or_marker_p
, Sinteger_or_marker_p
, 1, 1, 0,
452 "Return t if OBJECT is an integer or a marker (editor pointer).")
454 register Lisp_Object object
;
456 if (MARKERP (object
) || INTEGERP (object
))
461 DEFUN ("natnump", Fnatnump
, Snatnump
, 1, 1, 0,
462 "Return t if OBJECT is a nonnegative integer.")
466 if (NATNUMP (object
))
471 DEFUN ("numberp", Fnumberp
, Snumberp
, 1, 1, 0,
472 "Return t if OBJECT is a number (floating point or integer).")
476 if (NUMBERP (object
))
482 DEFUN ("number-or-marker-p", Fnumber_or_marker_p
,
483 Snumber_or_marker_p
, 1, 1, 0,
484 "Return t if OBJECT is a number or a marker.")
488 if (NUMBERP (object
) || MARKERP (object
))
493 #ifdef LISP_FLOAT_TYPE
494 DEFUN ("floatp", Ffloatp
, Sfloatp
, 1, 1, 0,
495 "Return t if OBJECT is a floating point number.")
503 #endif /* LISP_FLOAT_TYPE */
505 /* Extract and set components of lists */
507 DEFUN ("car", Fcar
, Scar
, 1, 1, 0,
508 "Return the car of LIST. If arg is nil, return nil.\n\
509 Error if arg is not nil and not a cons cell. See also `car-safe'.")
511 register Lisp_Object list
;
517 else if (EQ (list
, Qnil
))
520 list
= wrong_type_argument (Qlistp
, list
);
524 DEFUN ("car-safe", Fcar_safe
, Scar_safe
, 1, 1, 0,
525 "Return the car of OBJECT if it is a cons cell, or else nil.")
530 return XCAR (object
);
535 DEFUN ("cdr", Fcdr
, Scdr
, 1, 1, 0,
536 "Return the cdr of LIST. If arg is nil, return nil.\n\
537 Error if arg is not nil and not a cons cell. See also `cdr-safe'.")
540 register Lisp_Object list
;
546 else if (EQ (list
, Qnil
))
549 list
= wrong_type_argument (Qlistp
, list
);
553 DEFUN ("cdr-safe", Fcdr_safe
, Scdr_safe
, 1, 1, 0,
554 "Return the cdr of OBJECT if it is a cons cell, or else nil.")
559 return XCDR (object
);
564 DEFUN ("setcar", Fsetcar
, Ssetcar
, 2, 2, 0,
565 "Set the car of CELL to be NEWCAR. Returns NEWCAR.")
567 register Lisp_Object cell
, newcar
;
570 cell
= wrong_type_argument (Qconsp
, cell
);
573 XCAR (cell
) = newcar
;
577 DEFUN ("setcdr", Fsetcdr
, Ssetcdr
, 2, 2, 0,
578 "Set the cdr of CELL to be NEWCDR. Returns NEWCDR.")
580 register Lisp_Object cell
, newcdr
;
583 cell
= wrong_type_argument (Qconsp
, cell
);
586 XCDR (cell
) = newcdr
;
590 /* Extract and set components of symbols */
592 DEFUN ("boundp", Fboundp
, Sboundp
, 1, 1, 0, "Return t if SYMBOL's value is not void.")
594 register Lisp_Object symbol
;
596 Lisp_Object valcontents
;
597 CHECK_SYMBOL (symbol
, 0);
599 valcontents
= XSYMBOL (symbol
)->value
;
601 if (BUFFER_LOCAL_VALUEP (valcontents
)
602 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
603 valcontents
= swap_in_symval_forwarding (symbol
, valcontents
);
605 return (EQ (valcontents
, Qunbound
) ? Qnil
: Qt
);
608 DEFUN ("fboundp", Ffboundp
, Sfboundp
, 1, 1, 0, "Return t if SYMBOL's function definition is not void.")
610 register Lisp_Object symbol
;
612 CHECK_SYMBOL (symbol
, 0);
613 return (EQ (XSYMBOL (symbol
)->function
, Qunbound
) ? Qnil
: Qt
);
616 DEFUN ("makunbound", Fmakunbound
, Smakunbound
, 1, 1, 0, "Make SYMBOL's value be void.")
618 register Lisp_Object symbol
;
620 CHECK_SYMBOL (symbol
, 0);
621 if (NILP (symbol
) || EQ (symbol
, Qt
)
622 || (XSYMBOL (symbol
)->name
->data
[0] == ':'
623 && EQ (XSYMBOL (symbol
)->obarray
, initial_obarray
)
624 && keyword_symbols_constant_flag
))
625 return Fsignal (Qsetting_constant
, Fcons (symbol
, Qnil
));
626 Fset (symbol
, Qunbound
);
630 DEFUN ("fmakunbound", Ffmakunbound
, Sfmakunbound
, 1, 1, 0, "Make SYMBOL's function definition be void.")
632 register Lisp_Object symbol
;
634 CHECK_SYMBOL (symbol
, 0);
635 if (NILP (symbol
) || EQ (symbol
, Qt
))
636 return Fsignal (Qsetting_constant
, Fcons (symbol
, Qnil
));
637 XSYMBOL (symbol
)->function
= Qunbound
;
641 DEFUN ("symbol-function", Fsymbol_function
, Ssymbol_function
, 1, 1, 0,
642 "Return SYMBOL's function definition. Error if that is void.")
644 register Lisp_Object symbol
;
646 CHECK_SYMBOL (symbol
, 0);
647 if (EQ (XSYMBOL (symbol
)->function
, Qunbound
))
648 return Fsignal (Qvoid_function
, Fcons (symbol
, Qnil
));
649 return XSYMBOL (symbol
)->function
;
652 DEFUN ("symbol-plist", Fsymbol_plist
, Ssymbol_plist
, 1, 1, 0, "Return SYMBOL's property list.")
654 register Lisp_Object symbol
;
656 CHECK_SYMBOL (symbol
, 0);
657 return XSYMBOL (symbol
)->plist
;
660 DEFUN ("symbol-name", Fsymbol_name
, Ssymbol_name
, 1, 1, 0, "Return SYMBOL's name, a string.")
662 register Lisp_Object symbol
;
664 register Lisp_Object name
;
666 CHECK_SYMBOL (symbol
, 0);
667 XSETSTRING (name
, XSYMBOL (symbol
)->name
);
671 DEFUN ("fset", Ffset
, Sfset
, 2, 2, 0,
672 "Set SYMBOL's function definition to DEFINITION, and return DEFINITION.")
674 register Lisp_Object symbol
, definition
;
676 CHECK_SYMBOL (symbol
, 0);
677 if (NILP (symbol
) || EQ (symbol
, Qt
))
678 return Fsignal (Qsetting_constant
, Fcons (symbol
, Qnil
));
679 if (!NILP (Vautoload_queue
) && !EQ (XSYMBOL (symbol
)->function
, Qunbound
))
680 Vautoload_queue
= Fcons (Fcons (symbol
, XSYMBOL (symbol
)->function
),
682 XSYMBOL (symbol
)->function
= definition
;
683 /* Handle automatic advice activation */
684 if (CONSP (XSYMBOL (symbol
)->plist
) && !NILP (Fget (symbol
, Qad_advice_info
)))
686 call2 (Qad_activate_internal
, symbol
, Qnil
);
687 definition
= XSYMBOL (symbol
)->function
;
692 DEFUN ("defalias", Fdefalias
, Sdefalias
, 2, 2, 0,
693 "Set SYMBOL's function definition to DEFINITION, and return DEFINITION.\n\
694 Associates the function with the current load file, if any.")
696 register Lisp_Object symbol
, definition
;
698 definition
= Ffset (symbol
, definition
);
699 LOADHIST_ATTACH (symbol
);
703 DEFUN ("setplist", Fsetplist
, Ssetplist
, 2, 2, 0,
704 "Set SYMBOL's property list to NEWVAL, and return NEWVAL.")
706 register Lisp_Object symbol
, newplist
;
708 CHECK_SYMBOL (symbol
, 0);
709 XSYMBOL (symbol
)->plist
= newplist
;
714 /* Getting and setting values of symbols */
716 /* Given the raw contents of a symbol value cell,
717 return the Lisp value of the symbol.
718 This does not handle buffer-local variables; use
719 swap_in_symval_forwarding for that. */
722 do_symval_forwarding (valcontents
)
723 register Lisp_Object valcontents
;
725 register Lisp_Object val
;
727 if (MISCP (valcontents
))
728 switch (XMISCTYPE (valcontents
))
730 case Lisp_Misc_Intfwd
:
731 XSETINT (val
, *XINTFWD (valcontents
)->intvar
);
734 case Lisp_Misc_Boolfwd
:
735 return (*XBOOLFWD (valcontents
)->boolvar
? Qt
: Qnil
);
737 case Lisp_Misc_Objfwd
:
738 return *XOBJFWD (valcontents
)->objvar
;
740 case Lisp_Misc_Buffer_Objfwd
:
741 offset
= XBUFFER_OBJFWD (valcontents
)->offset
;
742 return *(Lisp_Object
*)(offset
+ (char *)current_buffer
);
744 case Lisp_Misc_Kboard_Objfwd
:
745 offset
= XKBOARD_OBJFWD (valcontents
)->offset
;
746 return *(Lisp_Object
*)(offset
+ (char *)current_kboard
);
751 /* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell
752 of SYMBOL. If SYMBOL is buffer-local, VALCONTENTS should be the
753 buffer-independent contents of the value cell: forwarded just one
754 step past the buffer-localness. */
757 store_symval_forwarding (symbol
, valcontents
, newval
)
759 register Lisp_Object valcontents
, newval
;
761 switch (SWITCH_ENUM_CAST (XTYPE (valcontents
)))
764 switch (XMISCTYPE (valcontents
))
766 case Lisp_Misc_Intfwd
:
767 CHECK_NUMBER (newval
, 1);
768 *XINTFWD (valcontents
)->intvar
= XINT (newval
);
769 if (*XINTFWD (valcontents
)->intvar
!= XINT (newval
))
770 error ("Value out of range for variable `%s'",
771 XSYMBOL (symbol
)->name
->data
);
774 case Lisp_Misc_Boolfwd
:
775 *XBOOLFWD (valcontents
)->boolvar
= NILP (newval
) ? 0 : 1;
778 case Lisp_Misc_Objfwd
:
779 *XOBJFWD (valcontents
)->objvar
= newval
;
782 case Lisp_Misc_Buffer_Objfwd
:
784 int offset
= XBUFFER_OBJFWD (valcontents
)->offset
;
787 type
= *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
);
788 if (XINT (type
) == -1)
789 error ("Variable %s is read-only", XSYMBOL (symbol
)->name
->data
);
791 if (! NILP (type
) && ! NILP (newval
)
792 && XTYPE (newval
) != XINT (type
))
793 buffer_slot_type_mismatch (offset
);
795 *(Lisp_Object
*)(offset
+ (char *)current_buffer
) = newval
;
799 case Lisp_Misc_Kboard_Objfwd
:
800 (*(Lisp_Object
*)((char *)current_kboard
801 + XKBOARD_OBJFWD (valcontents
)->offset
))
812 valcontents
= XSYMBOL (symbol
)->value
;
813 if (BUFFER_LOCAL_VALUEP (valcontents
)
814 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
815 XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
= newval
;
817 XSYMBOL (symbol
)->value
= newval
;
821 /* Set up the buffer-local symbol SYMBOL for validity in the current
822 buffer. VALCONTENTS is the contents of its value cell.
823 Return the value forwarded one step past the buffer-local indicator. */
826 swap_in_symval_forwarding (symbol
, valcontents
)
827 Lisp_Object symbol
, valcontents
;
829 /* valcontents is a pointer to a struct resembling the cons
830 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)).
832 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
833 local_var_alist, that being the element whose car is this
834 variable. Or it can be a pointer to the
835 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not have
836 an element in its alist for this variable.
838 If the current buffer is not BUFFER, we store the current
839 REALVALUE value into CURRENT-ALIST-ELEMENT, then find the
840 appropriate alist element for the buffer now current and set up
841 CURRENT-ALIST-ELEMENT. Then we set REALVALUE out of that
842 element, and store into BUFFER.
844 Note that REALVALUE can be a forwarding pointer. */
846 register Lisp_Object tem1
;
847 tem1
= XBUFFER_LOCAL_VALUE (valcontents
)->buffer
;
849 if (NILP (tem1
) || current_buffer
!= XBUFFER (tem1
)
850 || !EQ (selected_frame
, XBUFFER_LOCAL_VALUE (valcontents
)->frame
))
852 tem1
= XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
854 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
));
855 tem1
= assq_no_quit (symbol
, current_buffer
->local_var_alist
);
856 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 0;
857 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
860 if (XBUFFER_LOCAL_VALUE (valcontents
)->check_frame
)
861 tem1
= assq_no_quit (symbol
, XFRAME (selected_frame
)->param_alist
);
863 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 1;
865 tem1
= XBUFFER_LOCAL_VALUE (valcontents
)->cdr
;
868 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 1;
870 XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
) = tem1
;
871 XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents
)->buffer
, current_buffer
);
872 XBUFFER_LOCAL_VALUE (valcontents
)->frame
= selected_frame
;
873 store_symval_forwarding (symbol
,
874 XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
,
877 return XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
;
880 /* Find the value of a symbol, returning Qunbound if it's not bound.
881 This is helpful for code which just wants to get a variable's value
882 if it has one, without signaling an error.
883 Note that it must not be possible to quit
884 within this function. Great care is required for this. */
887 find_symbol_value (symbol
)
890 register Lisp_Object valcontents
;
891 register Lisp_Object val
;
892 CHECK_SYMBOL (symbol
, 0);
893 valcontents
= XSYMBOL (symbol
)->value
;
895 if (BUFFER_LOCAL_VALUEP (valcontents
)
896 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
897 valcontents
= swap_in_symval_forwarding (symbol
, valcontents
);
899 if (MISCP (valcontents
))
901 switch (XMISCTYPE (valcontents
))
903 case Lisp_Misc_Intfwd
:
904 XSETINT (val
, *XINTFWD (valcontents
)->intvar
);
907 case Lisp_Misc_Boolfwd
:
908 return (*XBOOLFWD (valcontents
)->boolvar
? Qt
: Qnil
);
910 case Lisp_Misc_Objfwd
:
911 return *XOBJFWD (valcontents
)->objvar
;
913 case Lisp_Misc_Buffer_Objfwd
:
914 return *(Lisp_Object
*)(XBUFFER_OBJFWD (valcontents
)->offset
915 + (char *)current_buffer
);
917 case Lisp_Misc_Kboard_Objfwd
:
918 return *(Lisp_Object
*)(XKBOARD_OBJFWD (valcontents
)->offset
919 + (char *)current_kboard
);
926 DEFUN ("symbol-value", Fsymbol_value
, Ssymbol_value
, 1, 1, 0,
927 "Return SYMBOL's value. Error if that is void.")
933 val
= find_symbol_value (symbol
);
934 if (EQ (val
, Qunbound
))
935 return Fsignal (Qvoid_variable
, Fcons (symbol
, Qnil
));
940 DEFUN ("set", Fset
, Sset
, 2, 2, 0,
941 "Set SYMBOL's value to NEWVAL, and return NEWVAL.")
943 register Lisp_Object symbol
, newval
;
945 return set_internal (symbol
, newval
, 0);
948 /* Store the value NEWVAL into SYMBOL.
949 If BINDFLAG is zero, then if this symbol is supposed to become
950 local in every buffer where it is set, then we make it local.
951 If BINDFLAG is nonzero, we don't do that. */
954 set_internal (symbol
, newval
, bindflag
)
955 register Lisp_Object symbol
, newval
;
958 int voide
= EQ (newval
, Qunbound
);
960 register Lisp_Object valcontents
, tem1
, current_alist_element
;
962 CHECK_SYMBOL (symbol
, 0);
963 if (NILP (symbol
) || EQ (symbol
, Qt
)
964 || (XSYMBOL (symbol
)->name
->data
[0] == ':'
965 && EQ (XSYMBOL (symbol
)->obarray
, initial_obarray
)
966 && keyword_symbols_constant_flag
&& ! EQ (newval
, symbol
)))
967 return Fsignal (Qsetting_constant
, Fcons (symbol
, Qnil
));
968 valcontents
= XSYMBOL (symbol
)->value
;
970 if (BUFFER_OBJFWDP (valcontents
))
972 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
973 register int mask
= XINT (*((Lisp_Object
*)
974 (idx
+ (char *)&buffer_local_flags
)));
975 if (mask
> 0 && ! bindflag
)
976 current_buffer
->local_var_flags
|= mask
;
979 else if (BUFFER_LOCAL_VALUEP (valcontents
)
980 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
982 /* valcontents is actually a pointer to a struct resembling a cons,
983 with contents something like:
984 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE).
986 BUFFER is the last buffer for which this symbol's value was
989 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
990 local_var_alist, that being the element whose car is this
991 variable. Or it can be a pointer to the
992 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not
993 have an element in its alist for this variable (that is, if
994 BUFFER sees the default value of this variable).
996 If we want to examine or set the value and BUFFER is current,
997 we just examine or set REALVALUE. If BUFFER is not current, we
998 store the current REALVALUE value into CURRENT-ALIST-ELEMENT,
999 then find the appropriate alist element for the buffer now
1000 current and set up CURRENT-ALIST-ELEMENT. Then we set
1001 REALVALUE out of that element, and store into BUFFER.
1003 If we are setting the variable and the current buffer does
1004 not have an alist entry for this variable, an alist entry is
1007 Note that REALVALUE can be a forwarding pointer. Each time
1008 it is examined or set, forwarding must be done. */
1010 /* What value are we caching right now? */
1011 current_alist_element
1012 = XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
1014 /* If the current buffer is not the buffer whose binding is
1015 currently cached, or if it's a Lisp_Buffer_Local_Value and
1016 we're looking at the default value, the cache is invalid; we
1017 need to write it out, and find the new CURRENT-ALIST-ELEMENT. */
1018 if (current_buffer
!= XBUFFER (XBUFFER_LOCAL_VALUE (valcontents
)->buffer
)
1019 || !EQ (selected_frame
, XBUFFER_LOCAL_VALUE (valcontents
)->frame
)
1020 || (BUFFER_LOCAL_VALUEP (valcontents
)
1021 && EQ (XCAR (current_alist_element
),
1022 current_alist_element
)))
1024 /* Write out the cached value for the old buffer; copy it
1025 back to its alist element. This works if the current
1026 buffer only sees the default value, too. */
1027 Fsetcdr (current_alist_element
,
1028 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
));
1030 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1031 tem1
= Fassq (symbol
, current_buffer
->local_var_alist
);
1032 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 1;
1033 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 0;
1037 /* This buffer still sees the default value. */
1039 /* If the variable is a Lisp_Some_Buffer_Local_Value,
1040 or if this is `let' rather than `set',
1041 make CURRENT-ALIST-ELEMENT point to itself,
1042 indicating that we're seeing the default value. */
1043 if (bindflag
|| SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1045 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
1047 if (XBUFFER_LOCAL_VALUE (valcontents
)->check_frame
)
1048 tem1
= Fassq (symbol
,
1049 XFRAME (selected_frame
)->param_alist
);
1052 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 1;
1054 tem1
= XBUFFER_LOCAL_VALUE (valcontents
)->cdr
;
1056 /* If it's a Lisp_Buffer_Local_Value, being set not bound,
1057 give this buffer a new assoc for a local value and set
1058 CURRENT-ALIST-ELEMENT to point to that. */
1061 tem1
= Fcons (symbol
, Fcdr (current_alist_element
));
1062 current_buffer
->local_var_alist
1063 = Fcons (tem1
, current_buffer
->local_var_alist
);
1067 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1068 XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
)
1071 /* Set BUFFER and FRAME for binding now loaded. */
1072 XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents
)->buffer
,
1074 XBUFFER_LOCAL_VALUE (valcontents
)->frame
= selected_frame
;
1076 valcontents
= XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
;
1079 /* If storing void (making the symbol void), forward only through
1080 buffer-local indicator, not through Lisp_Objfwd, etc. */
1082 store_symval_forwarding (symbol
, Qnil
, newval
);
1084 store_symval_forwarding (symbol
, valcontents
, newval
);
1089 /* Access or set a buffer-local symbol's default value. */
1091 /* Return the default value of SYMBOL, but don't check for voidness.
1092 Return Qunbound if it is void. */
1095 default_value (symbol
)
1098 register Lisp_Object valcontents
;
1100 CHECK_SYMBOL (symbol
, 0);
1101 valcontents
= XSYMBOL (symbol
)->value
;
1103 /* For a built-in buffer-local variable, get the default value
1104 rather than letting do_symval_forwarding get the current value. */
1105 if (BUFFER_OBJFWDP (valcontents
))
1107 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1109 if (XINT (*(Lisp_Object
*) (idx
+ (char *) &buffer_local_flags
)) != 0)
1110 return *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
1113 /* Handle user-created local variables. */
1114 if (BUFFER_LOCAL_VALUEP (valcontents
)
1115 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1117 /* If var is set up for a buffer that lacks a local value for it,
1118 the current value is nominally the default value.
1119 But the current value slot may be more up to date, since
1120 ordinary setq stores just that slot. So use that. */
1121 Lisp_Object current_alist_element
, alist_element_car
;
1122 current_alist_element
1123 = XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
1124 alist_element_car
= XCAR (current_alist_element
);
1125 if (EQ (alist_element_car
, current_alist_element
))
1126 return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
);
1128 return XCDR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
1130 /* For other variables, get the current value. */
1131 return do_symval_forwarding (valcontents
);
1134 DEFUN ("default-boundp", Fdefault_boundp
, Sdefault_boundp
, 1, 1, 0,
1135 "Return t if SYMBOL has a non-void default value.\n\
1136 This is the value that is seen in buffers that do not have their own values\n\
1137 for this variable.")
1141 register Lisp_Object value
;
1143 value
= default_value (symbol
);
1144 return (EQ (value
, Qunbound
) ? Qnil
: Qt
);
1147 DEFUN ("default-value", Fdefault_value
, Sdefault_value
, 1, 1, 0,
1148 "Return SYMBOL's default value.\n\
1149 This is the value that is seen in buffers that do not have their own values\n\
1150 for this variable. The default value is meaningful for variables with\n\
1151 local bindings in certain buffers.")
1155 register Lisp_Object value
;
1157 value
= default_value (symbol
);
1158 if (EQ (value
, Qunbound
))
1159 return Fsignal (Qvoid_variable
, Fcons (symbol
, Qnil
));
1163 DEFUN ("set-default", Fset_default
, Sset_default
, 2, 2, 0,
1164 "Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.\n\
1165 The default value is seen in buffers that do not have their own values\n\
1166 for this variable.")
1168 Lisp_Object symbol
, value
;
1170 register Lisp_Object valcontents
, current_alist_element
, alist_element_buffer
;
1172 CHECK_SYMBOL (symbol
, 0);
1173 valcontents
= XSYMBOL (symbol
)->value
;
1175 /* Handle variables like case-fold-search that have special slots
1176 in the buffer. Make them work apparently like Lisp_Buffer_Local_Value
1178 if (BUFFER_OBJFWDP (valcontents
))
1180 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1181 register struct buffer
*b
;
1182 register int mask
= XINT (*((Lisp_Object
*)
1183 (idx
+ (char *)&buffer_local_flags
)));
1185 *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
) = value
;
1187 /* If this variable is not always local in all buffers,
1188 set it in the buffers that don't nominally have a local value. */
1191 for (b
= all_buffers
; b
; b
= b
->next
)
1192 if (!(b
->local_var_flags
& mask
))
1193 *(Lisp_Object
*)(idx
+ (char *) b
) = value
;
1198 if (!BUFFER_LOCAL_VALUEP (valcontents
)
1199 && !SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1200 return Fset (symbol
, value
);
1202 /* Store new value into the DEFAULT-VALUE slot */
1203 XCDR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
) = value
;
1205 /* If that slot is current, we must set the REALVALUE slot too */
1206 current_alist_element
1207 = XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
1208 alist_element_buffer
= Fcar (current_alist_element
);
1209 if (EQ (alist_element_buffer
, current_alist_element
))
1210 store_symval_forwarding (symbol
, XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
,
1216 DEFUN ("setq-default", Fsetq_default
, Ssetq_default
, 2, UNEVALLED
, 0,
1217 "Set the default value of variable VAR to VALUE.\n\
1218 VAR, the variable name, is literal (not evaluated);\n\
1219 VALUE is an expression and it is evaluated.\n\
1220 The default value of a variable is seen in buffers\n\
1221 that do not have their own values for the variable.\n\
1223 More generally, you can use multiple variables and values, as in\n\
1224 (setq-default SYMBOL VALUE SYMBOL VALUE...)\n\
1225 This sets each SYMBOL's default value to the corresponding VALUE.\n\
1226 The VALUE for the Nth SYMBOL can refer to the new default values\n\
1231 register Lisp_Object args_left
;
1232 register Lisp_Object val
, symbol
;
1233 struct gcpro gcpro1
;
1243 val
= Feval (Fcar (Fcdr (args_left
)));
1244 symbol
= Fcar (args_left
);
1245 Fset_default (symbol
, val
);
1246 args_left
= Fcdr (Fcdr (args_left
));
1248 while (!NILP (args_left
));
1254 /* Lisp functions for creating and removing buffer-local variables. */
1256 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local
, Smake_variable_buffer_local
,
1257 1, 1, "vMake Variable Buffer Local: ",
1258 "Make VARIABLE have a separate value for each buffer.\n\
1259 At any time, the value for the current buffer is in effect.\n\
1260 There is also a default value which is seen in any buffer which has not yet\n\
1261 set its own value.\n\
1262 Using `set' or `setq' to set the variable causes it to have a separate value\n\
1263 for the current buffer if it was previously using the default value.\n\
1264 The function `default-value' gets the default value and `set-default' sets it.")
1266 register Lisp_Object variable
;
1268 register Lisp_Object tem
, valcontents
, newval
;
1270 CHECK_SYMBOL (variable
, 0);
1272 valcontents
= XSYMBOL (variable
)->value
;
1273 if (EQ (variable
, Qnil
) || EQ (variable
, Qt
) || KBOARD_OBJFWDP (valcontents
))
1274 error ("Symbol %s may not be buffer-local", XSYMBOL (variable
)->name
->data
);
1276 if (BUFFER_LOCAL_VALUEP (valcontents
) || BUFFER_OBJFWDP (valcontents
))
1278 if (SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1280 XMISCTYPE (XSYMBOL (variable
)->value
) = Lisp_Misc_Buffer_Local_Value
;
1283 if (EQ (valcontents
, Qunbound
))
1284 XSYMBOL (variable
)->value
= Qnil
;
1285 tem
= Fcons (Qnil
, Fsymbol_value (variable
));
1287 newval
= allocate_misc ();
1288 XMISCTYPE (newval
) = Lisp_Misc_Buffer_Local_Value
;
1289 XBUFFER_LOCAL_VALUE (newval
)->realvalue
= XSYMBOL (variable
)->value
;
1290 XBUFFER_LOCAL_VALUE (newval
)->buffer
= Fcurrent_buffer ();
1291 XBUFFER_LOCAL_VALUE (newval
)->frame
= Qnil
;
1292 XBUFFER_LOCAL_VALUE (newval
)->found_for_buffer
= 1;
1293 XBUFFER_LOCAL_VALUE (newval
)->found_for_frame
= 0;
1294 XBUFFER_LOCAL_VALUE (newval
)->check_frame
= 0;
1295 XBUFFER_LOCAL_VALUE (newval
)->cdr
= tem
;
1296 XSYMBOL (variable
)->value
= newval
;
1300 DEFUN ("make-local-variable", Fmake_local_variable
, Smake_local_variable
,
1301 1, 1, "vMake Local Variable: ",
1302 "Make VARIABLE have a separate value in the current buffer.\n\
1303 Other buffers will continue to share a common default value.\n\
1304 \(The buffer-local value of VARIABLE starts out as the same value\n\
1305 VARIABLE previously had. If VARIABLE was void, it remains void.\)\n\
1306 See also `make-variable-buffer-local'.\n\
1308 If the variable is already arranged to become local when set,\n\
1309 this function causes a local value to exist for this buffer,\n\
1310 just as setting the variable would do.\n\
1312 This function returns VARIABLE, and therefore\n\
1313 (set (make-local-variable 'VARIABLE) VALUE-EXP)\n\
1316 Do not use `make-local-variable' to make a hook variable buffer-local.\n\
1317 Use `make-local-hook' instead.")
1319 register Lisp_Object variable
;
1321 register Lisp_Object tem
, valcontents
;
1323 CHECK_SYMBOL (variable
, 0);
1325 valcontents
= XSYMBOL (variable
)->value
;
1326 if (EQ (variable
, Qnil
) || EQ (variable
, Qt
) || KBOARD_OBJFWDP (valcontents
))
1327 error ("Symbol %s may not be buffer-local", XSYMBOL (variable
)->name
->data
);
1329 if (BUFFER_LOCAL_VALUEP (valcontents
) || BUFFER_OBJFWDP (valcontents
))
1331 tem
= Fboundp (variable
);
1333 /* Make sure the symbol has a local value in this particular buffer,
1334 by setting it to the same value it already has. */
1335 Fset (variable
, (EQ (tem
, Qt
) ? Fsymbol_value (variable
) : Qunbound
));
1338 /* Make sure symbol is set up to hold per-buffer values */
1339 if (!SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1342 tem
= Fcons (Qnil
, do_symval_forwarding (valcontents
));
1344 newval
= allocate_misc ();
1345 XMISCTYPE (newval
) = Lisp_Misc_Some_Buffer_Local_Value
;
1346 XBUFFER_LOCAL_VALUE (newval
)->realvalue
= XSYMBOL (variable
)->value
;
1347 XBUFFER_LOCAL_VALUE (newval
)->buffer
= Qnil
;
1348 XBUFFER_LOCAL_VALUE (newval
)->frame
= Qnil
;
1349 XBUFFER_LOCAL_VALUE (newval
)->found_for_buffer
= 0;
1350 XBUFFER_LOCAL_VALUE (newval
)->found_for_frame
= 0;
1351 XBUFFER_LOCAL_VALUE (newval
)->check_frame
= 0;
1352 XBUFFER_LOCAL_VALUE (newval
)->cdr
= tem
;
1353 XSYMBOL (variable
)->value
= newval
;
1355 /* Make sure this buffer has its own value of symbol */
1356 tem
= Fassq (variable
, current_buffer
->local_var_alist
);
1359 /* Swap out any local binding for some other buffer, and make
1360 sure the current value is permanently recorded, if it's the
1362 find_symbol_value (variable
);
1364 current_buffer
->local_var_alist
1365 = Fcons (Fcons (variable
, XCDR (XBUFFER_LOCAL_VALUE (XSYMBOL (variable
)->value
)->cdr
)),
1366 current_buffer
->local_var_alist
);
1368 /* Make sure symbol does not think it is set up for this buffer;
1369 force it to look once again for this buffer's value */
1371 Lisp_Object
*pvalbuf
;
1373 valcontents
= XSYMBOL (variable
)->value
;
1375 pvalbuf
= &XBUFFER_LOCAL_VALUE (valcontents
)->buffer
;
1376 if (current_buffer
== XBUFFER (*pvalbuf
))
1378 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
1382 /* If the symbol forwards into a C variable, then swap in the
1383 variable for this buffer immediately. If C code modifies the
1384 variable before we swap in, then that new value will clobber the
1385 default value the next time we swap. */
1386 valcontents
= XBUFFER_LOCAL_VALUE (XSYMBOL (variable
)->value
)->realvalue
;
1387 if (INTFWDP (valcontents
) || BOOLFWDP (valcontents
) || OBJFWDP (valcontents
))
1388 swap_in_symval_forwarding (variable
, XSYMBOL (variable
)->value
);
1393 DEFUN ("kill-local-variable", Fkill_local_variable
, Skill_local_variable
,
1394 1, 1, "vKill Local Variable: ",
1395 "Make VARIABLE no longer have a separate value in the current buffer.\n\
1396 From now on the default value will apply in this buffer.")
1398 register Lisp_Object variable
;
1400 register Lisp_Object tem
, valcontents
;
1402 CHECK_SYMBOL (variable
, 0);
1404 valcontents
= XSYMBOL (variable
)->value
;
1406 if (BUFFER_OBJFWDP (valcontents
))
1408 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1409 register int mask
= XINT (*((Lisp_Object
*)
1410 (idx
+ (char *)&buffer_local_flags
)));
1414 *(Lisp_Object
*)(idx
+ (char *) current_buffer
)
1415 = *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
1416 current_buffer
->local_var_flags
&= ~mask
;
1421 if (!BUFFER_LOCAL_VALUEP (valcontents
)
1422 && !SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1425 /* Get rid of this buffer's alist element, if any */
1427 tem
= Fassq (variable
, current_buffer
->local_var_alist
);
1429 current_buffer
->local_var_alist
1430 = Fdelq (tem
, current_buffer
->local_var_alist
);
1432 /* If the symbol is set up for the current buffer, recompute its
1433 value. We have to do it now, or else forwarded objects won't
1436 Lisp_Object
*pvalbuf
;
1437 valcontents
= XSYMBOL (variable
)->value
;
1438 pvalbuf
= &XBUFFER_LOCAL_VALUE (valcontents
)->buffer
;
1439 if (current_buffer
== XBUFFER (*pvalbuf
))
1442 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
1443 find_symbol_value (variable
);
1450 /* Lisp functions for creating and removing buffer-local variables. */
1452 DEFUN ("make-variable-frame-local", Fmake_variable_frame_local
, Smake_variable_frame_local
,
1453 1, 1, "vMake Variable Frame Local: ",
1454 "Enable VARIABLE to have frame-local bindings.\n\
1455 When a frame-local binding exists in the current frame,\n\
1456 it is in effect whenever the current buffer has no buffer-local binding.\n\
1457 A frame-local binding is actual a frame parameter value;\n\
1458 thus, any given frame has a local binding for VARIABLE\n\
1459 if it has a value for the frame parameter named VARIABLE.\n\
1460 See `modify-frame-parameters'.")
1462 register Lisp_Object variable
;
1464 register Lisp_Object tem
, valcontents
, newval
;
1466 CHECK_SYMBOL (variable
, 0);
1468 valcontents
= XSYMBOL (variable
)->value
;
1469 if (EQ (variable
, Qnil
) || EQ (variable
, Qt
) || KBOARD_OBJFWDP (valcontents
)
1470 || BUFFER_OBJFWDP (valcontents
))
1471 error ("Symbol %s may not be frame-local", XSYMBOL (variable
)->name
->data
);
1473 if (BUFFER_LOCAL_VALUEP (valcontents
)
1474 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1477 if (EQ (valcontents
, Qunbound
))
1478 XSYMBOL (variable
)->value
= Qnil
;
1479 tem
= Fcons (Qnil
, Fsymbol_value (variable
));
1481 newval
= allocate_misc ();
1482 XMISCTYPE (newval
) = Lisp_Misc_Some_Buffer_Local_Value
;
1483 XBUFFER_LOCAL_VALUE (newval
)->realvalue
= XSYMBOL (variable
)->value
;
1484 XBUFFER_LOCAL_VALUE (newval
)->buffer
= Qnil
;
1485 XBUFFER_LOCAL_VALUE (newval
)->frame
= Qnil
;
1486 XBUFFER_LOCAL_VALUE (newval
)->found_for_buffer
= 0;
1487 XBUFFER_LOCAL_VALUE (newval
)->found_for_frame
= 0;
1488 XBUFFER_LOCAL_VALUE (newval
)->check_frame
= 1;
1489 XBUFFER_LOCAL_VALUE (newval
)->cdr
= tem
;
1490 XSYMBOL (variable
)->value
= newval
;
1494 DEFUN ("local-variable-p", Flocal_variable_p
, Slocal_variable_p
,
1496 "Non-nil if VARIABLE has a local binding in buffer BUFFER.\n\
1497 BUFFER defaults to the current buffer.")
1499 register Lisp_Object variable
, buffer
;
1501 Lisp_Object valcontents
;
1502 register struct buffer
*buf
;
1505 buf
= current_buffer
;
1508 CHECK_BUFFER (buffer
, 0);
1509 buf
= XBUFFER (buffer
);
1512 CHECK_SYMBOL (variable
, 0);
1514 valcontents
= XSYMBOL (variable
)->value
;
1515 if (BUFFER_LOCAL_VALUEP (valcontents
)
1516 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1518 Lisp_Object tail
, elt
;
1519 for (tail
= buf
->local_var_alist
; CONSP (tail
); tail
= XCDR (tail
))
1522 if (EQ (variable
, XCAR (elt
)))
1526 if (BUFFER_OBJFWDP (valcontents
))
1528 int offset
= XBUFFER_OBJFWD (valcontents
)->offset
;
1529 int mask
= XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
));
1530 if (mask
== -1 || (buf
->local_var_flags
& mask
))
1536 DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p
, Slocal_variable_if_set_p
,
1538 "Non-nil if VARIABLE will be local in buffer BUFFER if it is set there.\n\
1539 BUFFER defaults to the current buffer.")
1541 register Lisp_Object variable
, buffer
;
1543 Lisp_Object valcontents
;
1544 register struct buffer
*buf
;
1547 buf
= current_buffer
;
1550 CHECK_BUFFER (buffer
, 0);
1551 buf
= XBUFFER (buffer
);
1554 CHECK_SYMBOL (variable
, 0);
1556 valcontents
= XSYMBOL (variable
)->value
;
1558 /* This means that make-variable-buffer-local was done. */
1559 if (BUFFER_LOCAL_VALUEP (valcontents
))
1561 /* All these slots become local if they are set. */
1562 if (BUFFER_OBJFWDP (valcontents
))
1564 if (SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1566 Lisp_Object tail
, elt
;
1567 for (tail
= buf
->local_var_alist
; CONSP (tail
); tail
= XCDR (tail
))
1570 if (EQ (variable
, XCAR (elt
)))
1577 /* Find the function at the end of a chain of symbol function indirections. */
1579 /* If OBJECT is a symbol, find the end of its function chain and
1580 return the value found there. If OBJECT is not a symbol, just
1581 return it. If there is a cycle in the function chain, signal a
1582 cyclic-function-indirection error.
1584 This is like Findirect_function, except that it doesn't signal an
1585 error if the chain ends up unbound. */
1587 indirect_function (object
)
1588 register Lisp_Object object
;
1590 Lisp_Object tortoise
, hare
;
1592 hare
= tortoise
= object
;
1596 if (!SYMBOLP (hare
) || EQ (hare
, Qunbound
))
1598 hare
= XSYMBOL (hare
)->function
;
1599 if (!SYMBOLP (hare
) || EQ (hare
, Qunbound
))
1601 hare
= XSYMBOL (hare
)->function
;
1603 tortoise
= XSYMBOL (tortoise
)->function
;
1605 if (EQ (hare
, tortoise
))
1606 Fsignal (Qcyclic_function_indirection
, Fcons (object
, Qnil
));
1612 DEFUN ("indirect-function", Findirect_function
, Sindirect_function
, 1, 1, 0,
1613 "Return the function at the end of OBJECT's function chain.\n\
1614 If OBJECT is a symbol, follow all function indirections and return the final\n\
1615 function binding.\n\
1616 If OBJECT is not a symbol, just return it.\n\
1617 Signal a void-function error if the final symbol is unbound.\n\
1618 Signal a cyclic-function-indirection error if there is a loop in the\n\
1619 function chain of symbols.")
1621 register Lisp_Object object
;
1625 result
= indirect_function (object
);
1627 if (EQ (result
, Qunbound
))
1628 return Fsignal (Qvoid_function
, Fcons (object
, Qnil
));
1632 /* Extract and set vector and string elements */
1634 DEFUN ("aref", Faref
, Saref
, 2, 2, 0,
1635 "Return the element of ARRAY at index IDX.\n\
1636 ARRAY may be a vector, a string, a char-table, a bool-vector,\n\
1637 or a byte-code object. IDX starts at 0.")
1639 register Lisp_Object array
;
1642 register int idxval
;
1644 CHECK_NUMBER (idx
, 1);
1645 idxval
= XINT (idx
);
1646 if (STRINGP (array
))
1650 if (idxval
< 0 || idxval
>= XSTRING (array
)->size
)
1651 args_out_of_range (array
, idx
);
1652 if (! STRING_MULTIBYTE (array
))
1653 return make_number ((unsigned char) XSTRING (array
)->data
[idxval
]);
1654 idxval_byte
= string_char_to_byte (array
, idxval
);
1656 c
= STRING_CHAR (&XSTRING (array
)->data
[idxval_byte
],
1657 STRING_BYTES (XSTRING (array
)) - idxval_byte
);
1658 return make_number (c
);
1660 else if (BOOL_VECTOR_P (array
))
1664 if (idxval
< 0 || idxval
>= XBOOL_VECTOR (array
)->size
)
1665 args_out_of_range (array
, idx
);
1667 val
= (unsigned char) XBOOL_VECTOR (array
)->data
[idxval
/ BITS_PER_CHAR
];
1668 return (val
& (1 << (idxval
% BITS_PER_CHAR
)) ? Qt
: Qnil
);
1670 else if (CHAR_TABLE_P (array
))
1675 args_out_of_range (array
, idx
);
1676 if (idxval
< CHAR_TABLE_ORDINARY_SLOTS
)
1678 /* For ASCII and 8-bit European characters, the element is
1679 stored in the top table. */
1680 val
= XCHAR_TABLE (array
)->contents
[idxval
];
1682 val
= XCHAR_TABLE (array
)->defalt
;
1683 while (NILP (val
)) /* Follow parents until we find some value. */
1685 array
= XCHAR_TABLE (array
)->parent
;
1688 val
= XCHAR_TABLE (array
)->contents
[idxval
];
1690 val
= XCHAR_TABLE (array
)->defalt
;
1697 Lisp_Object sub_table
;
1699 SPLIT_NON_ASCII_CHAR (idxval
, code
[0], code
[1], code
[2]);
1700 if (code
[1] < 32) code
[1] = -1;
1701 else if (code
[2] < 32) code
[2] = -1;
1703 /* Here, the possible range of CODE[0] (== charset ID) is
1704 128..MAX_CHARSET. Since the top level char table contains
1705 data for multibyte characters after 256th element, we must
1706 increment CODE[0] by 128 to get a correct index. */
1708 code
[3] = -1; /* anchor */
1710 try_parent_char_table
:
1712 for (i
= 0; code
[i
] >= 0; i
++)
1714 val
= XCHAR_TABLE (sub_table
)->contents
[code
[i
]];
1715 if (SUB_CHAR_TABLE_P (val
))
1720 val
= XCHAR_TABLE (sub_table
)->defalt
;
1723 array
= XCHAR_TABLE (array
)->parent
;
1725 goto try_parent_char_table
;
1730 /* Here, VAL is a sub char table. We try the default value
1732 val
= XCHAR_TABLE (val
)->defalt
;
1735 array
= XCHAR_TABLE (array
)->parent
;
1737 goto try_parent_char_table
;
1745 if (VECTORP (array
))
1746 size
= XVECTOR (array
)->size
;
1747 else if (COMPILEDP (array
))
1748 size
= XVECTOR (array
)->size
& PSEUDOVECTOR_SIZE_MASK
;
1750 wrong_type_argument (Qarrayp
, array
);
1752 if (idxval
< 0 || idxval
>= size
)
1753 args_out_of_range (array
, idx
);
1754 return XVECTOR (array
)->contents
[idxval
];
1758 DEFUN ("aset", Faset
, Saset
, 3, 3, 0,
1759 "Store into the element of ARRAY at index IDX the value NEWELT.\n\
1760 ARRAY may be a vector, a string, a char-table or a bool-vector.\n\
1762 (array
, idx
, newelt
)
1763 register Lisp_Object array
;
1764 Lisp_Object idx
, newelt
;
1766 register int idxval
;
1768 CHECK_NUMBER (idx
, 1);
1769 idxval
= XINT (idx
);
1770 if (!VECTORP (array
) && !STRINGP (array
) && !BOOL_VECTOR_P (array
)
1771 && ! CHAR_TABLE_P (array
))
1772 array
= wrong_type_argument (Qarrayp
, array
);
1773 CHECK_IMPURE (array
);
1775 if (VECTORP (array
))
1777 if (idxval
< 0 || idxval
>= XVECTOR (array
)->size
)
1778 args_out_of_range (array
, idx
);
1779 XVECTOR (array
)->contents
[idxval
] = newelt
;
1781 else if (BOOL_VECTOR_P (array
))
1785 if (idxval
< 0 || idxval
>= XBOOL_VECTOR (array
)->size
)
1786 args_out_of_range (array
, idx
);
1788 val
= (unsigned char) XBOOL_VECTOR (array
)->data
[idxval
/ BITS_PER_CHAR
];
1790 if (! NILP (newelt
))
1791 val
|= 1 << (idxval
% BITS_PER_CHAR
);
1793 val
&= ~(1 << (idxval
% BITS_PER_CHAR
));
1794 XBOOL_VECTOR (array
)->data
[idxval
/ BITS_PER_CHAR
] = val
;
1796 else if (CHAR_TABLE_P (array
))
1799 args_out_of_range (array
, idx
);
1800 if (idxval
< CHAR_TABLE_ORDINARY_SLOTS
)
1801 XCHAR_TABLE (array
)->contents
[idxval
] = newelt
;
1807 SPLIT_NON_ASCII_CHAR (idxval
, code
[0], code
[1], code
[2]);
1808 if (code
[1] < 32) code
[1] = -1;
1809 else if (code
[2] < 32) code
[2] = -1;
1811 /* See the comment of the corresponding part in Faref. */
1813 code
[3] = -1; /* anchor */
1814 for (i
= 0; code
[i
+ 1] >= 0; i
++)
1816 val
= XCHAR_TABLE (array
)->contents
[code
[i
]];
1817 if (SUB_CHAR_TABLE_P (val
))
1823 /* VAL is a leaf. Create a sub char table with the
1824 default value VAL or XCHAR_TABLE (array)->defalt
1825 and look into it. */
1827 temp
= make_sub_char_table (NILP (val
)
1828 ? XCHAR_TABLE (array
)->defalt
1830 XCHAR_TABLE (array
)->contents
[code
[i
]] = temp
;
1834 XCHAR_TABLE (array
)->contents
[code
[i
]] = newelt
;
1837 else if (STRING_MULTIBYTE (array
))
1839 int idxval_byte
, new_len
, actual_len
;
1841 unsigned char *p
, workbuf
[MAX_MULTIBYTE_LENGTH
], *str
= workbuf
;
1843 if (idxval
< 0 || idxval
>= XSTRING (array
)->size
)
1844 args_out_of_range (array
, idx
);
1846 idxval_byte
= string_char_to_byte (array
, idxval
);
1847 p
= &XSTRING (array
)->data
[idxval_byte
];
1849 actual_len
= MULTIBYTE_FORM_LENGTH (p
, STRING_BYTES (XSTRING (array
)));
1850 CHECK_NUMBER (newelt
, 2);
1851 new_len
= CHAR_STRING (XINT (newelt
), str
);
1852 if (actual_len
!= new_len
)
1853 error ("Attempt to change byte length of a string");
1855 /* We can't accept a change causing byte combining. */
1856 if (!ASCII_BYTE_P (*str
)
1857 && ((idxval
> 0 && !CHAR_HEAD_P (*str
)
1858 && (prev_byte
= string_char_to_byte (array
, idxval
- 1),
1859 BYTES_BY_CHAR_HEAD (XSTRING (array
)->data
[prev_byte
])
1860 > idxval_byte
- prev_byte
))
1861 || (idxval
< XSTRING (array
)->size
- 1
1862 && !CHAR_HEAD_P (p
[actual_len
])
1863 && new_len
< BYTES_BY_CHAR_HEAD (*str
))))
1864 error ("Attempt to change char length of a string");
1870 if (idxval
< 0 || idxval
>= XSTRING (array
)->size
)
1871 args_out_of_range (array
, idx
);
1872 CHECK_NUMBER (newelt
, 2);
1873 XSTRING (array
)->data
[idxval
] = XINT (newelt
);
1879 /* Arithmetic functions */
1881 enum comparison
{ equal
, notequal
, less
, grtr
, less_or_equal
, grtr_or_equal
};
1884 arithcompare (num1
, num2
, comparison
)
1885 Lisp_Object num1
, num2
;
1886 enum comparison comparison
;
1891 #ifdef LISP_FLOAT_TYPE
1892 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1
, 0);
1893 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2
, 0);
1895 if (FLOATP (num1
) || FLOATP (num2
))
1898 f1
= (FLOATP (num1
)) ? XFLOAT_DATA (num1
) : XINT (num1
);
1899 f2
= (FLOATP (num2
)) ? XFLOAT_DATA (num2
) : XINT (num2
);
1902 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1903 CHECK_NUMBER_COERCE_MARKER (num2
, 0);
1904 #endif /* LISP_FLOAT_TYPE */
1909 if (floatp
? f1
== f2
: XINT (num1
) == XINT (num2
))
1914 if (floatp
? f1
!= f2
: XINT (num1
) != XINT (num2
))
1919 if (floatp
? f1
< f2
: XINT (num1
) < XINT (num2
))
1924 if (floatp
? f1
<= f2
: XINT (num1
) <= XINT (num2
))
1929 if (floatp
? f1
> f2
: XINT (num1
) > XINT (num2
))
1934 if (floatp
? f1
>= f2
: XINT (num1
) >= XINT (num2
))
1943 DEFUN ("=", Feqlsign
, Seqlsign
, 2, 2, 0,
1944 "Return t if two args, both numbers or markers, are equal.")
1946 register Lisp_Object num1
, num2
;
1948 return arithcompare (num1
, num2
, equal
);
1951 DEFUN ("<", Flss
, Slss
, 2, 2, 0,
1952 "Return t if first arg is less than second arg. Both must be numbers or markers.")
1954 register Lisp_Object num1
, num2
;
1956 return arithcompare (num1
, num2
, less
);
1959 DEFUN (">", Fgtr
, Sgtr
, 2, 2, 0,
1960 "Return t if first arg is greater than second arg. Both must be numbers or markers.")
1962 register Lisp_Object num1
, num2
;
1964 return arithcompare (num1
, num2
, grtr
);
1967 DEFUN ("<=", Fleq
, Sleq
, 2, 2, 0,
1968 "Return t if first arg is less than or equal to second arg.\n\
1969 Both must be numbers or markers.")
1971 register Lisp_Object num1
, num2
;
1973 return arithcompare (num1
, num2
, less_or_equal
);
1976 DEFUN (">=", Fgeq
, Sgeq
, 2, 2, 0,
1977 "Return t if first arg is greater than or equal to second arg.\n\
1978 Both must be numbers or markers.")
1980 register Lisp_Object num1
, num2
;
1982 return arithcompare (num1
, num2
, grtr_or_equal
);
1985 DEFUN ("/=", Fneq
, Sneq
, 2, 2, 0,
1986 "Return t if first arg is not equal to second arg. Both must be numbers or markers.")
1988 register Lisp_Object num1
, num2
;
1990 return arithcompare (num1
, num2
, notequal
);
1993 DEFUN ("zerop", Fzerop
, Szerop
, 1, 1, 0, "Return t if NUMBER is zero.")
1995 register Lisp_Object number
;
1997 #ifdef LISP_FLOAT_TYPE
1998 CHECK_NUMBER_OR_FLOAT (number
, 0);
2000 if (FLOATP (number
))
2002 if (XFLOAT_DATA (number
) == 0.0)
2007 CHECK_NUMBER (number
, 0);
2008 #endif /* LISP_FLOAT_TYPE */
2015 /* Convert between long values and pairs of Lisp integers. */
2021 unsigned int top
= i
>> 16;
2022 unsigned int bot
= i
& 0xFFFF;
2024 return make_number (bot
);
2025 if (top
== (unsigned long)-1 >> 16)
2026 return Fcons (make_number (-1), make_number (bot
));
2027 return Fcons (make_number (top
), make_number (bot
));
2034 Lisp_Object top
, bot
;
2041 return ((XINT (top
) << 16) | XINT (bot
));
2044 DEFUN ("number-to-string", Fnumber_to_string
, Snumber_to_string
, 1, 1, 0,
2045 "Convert NUMBER to a string by printing it in decimal.\n\
2046 Uses a minus sign if negative.\n\
2047 NUMBER may be an integer or a floating point number.")
2051 char buffer
[VALBITS
];
2053 #ifndef LISP_FLOAT_TYPE
2054 CHECK_NUMBER (number
, 0);
2056 CHECK_NUMBER_OR_FLOAT (number
, 0);
2058 if (FLOATP (number
))
2060 char pigbuf
[350]; /* see comments in float_to_string */
2062 float_to_string (pigbuf
, XFLOAT_DATA (number
));
2063 return build_string (pigbuf
);
2065 #endif /* LISP_FLOAT_TYPE */
2067 if (sizeof (int) == sizeof (EMACS_INT
))
2068 sprintf (buffer
, "%d", XINT (number
));
2069 else if (sizeof (long) == sizeof (EMACS_INT
))
2070 sprintf (buffer
, "%ld", (long) XINT (number
));
2073 return build_string (buffer
);
2077 digit_to_number (character
, base
)
2078 int character
, base
;
2082 if (character
>= '0' && character
<= '9')
2083 digit
= character
- '0';
2084 else if (character
>= 'a' && character
<= 'z')
2085 digit
= character
- 'a' + 10;
2086 else if (character
>= 'A' && character
<= 'Z')
2087 digit
= character
- 'A' + 10;
2097 DEFUN ("string-to-number", Fstring_to_number
, Sstring_to_number
, 1, 2, 0,
2098 "Convert STRING to a number by parsing it as a decimal number.\n\
2099 This parses both integers and floating point numbers.\n\
2100 It ignores leading spaces and tabs.\n\
2102 If BASE, interpret STRING as a number in that base. If BASE isn't\n\
2103 present, base 10 is used. BASE must be between 2 and 16 (inclusive).\n\
2104 If the base used is not 10, floating point is not recognized.")
2106 register Lisp_Object string
, base
;
2108 register unsigned char *p
;
2109 register int b
, v
= 0;
2112 CHECK_STRING (string
, 0);
2118 CHECK_NUMBER (base
, 1);
2120 if (b
< 2 || b
> 16)
2121 Fsignal (Qargs_out_of_range
, Fcons (base
, Qnil
));
2124 p
= XSTRING (string
)->data
;
2126 /* Skip any whitespace at the front of the number. Some versions of
2127 atoi do this anyway, so we might as well make Emacs lisp consistent. */
2128 while (*p
== ' ' || *p
== '\t')
2139 #ifdef LISP_FLOAT_TYPE
2140 if (isfloat_string (p
) && b
== 10)
2141 return make_float (negative
* atof (p
));
2142 #endif /* LISP_FLOAT_TYPE */
2146 int digit
= digit_to_number (*p
++, b
);
2152 return make_number (negative
* v
);
2157 { Aadd
, Asub
, Amult
, Adiv
, Alogand
, Alogior
, Alogxor
, Amax
, Amin
};
2159 extern Lisp_Object
float_arith_driver ();
2160 extern Lisp_Object
fmod_float ();
2163 arith_driver (code
, nargs
, args
)
2166 register Lisp_Object
*args
;
2168 register Lisp_Object val
;
2169 register int argnum
;
2170 register EMACS_INT accum
;
2171 register EMACS_INT next
;
2173 switch (SWITCH_ENUM_CAST (code
))
2186 for (argnum
= 0; argnum
< nargs
; argnum
++)
2188 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
2189 #ifdef LISP_FLOAT_TYPE
2190 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
2192 if (FLOATP (val
)) /* time to do serious math */
2193 return (float_arith_driver ((double) accum
, argnum
, code
,
2196 CHECK_NUMBER_COERCE_MARKER (val
, argnum
);
2197 #endif /* LISP_FLOAT_TYPE */
2198 args
[argnum
] = val
; /* runs into a compiler bug. */
2199 next
= XINT (args
[argnum
]);
2200 switch (SWITCH_ENUM_CAST (code
))
2202 case Aadd
: accum
+= next
; break;
2204 accum
= argnum
? accum
- next
: nargs
== 1 ? - next
: next
;
2206 case Amult
: accum
*= next
; break;
2208 if (!argnum
) accum
= next
;
2212 Fsignal (Qarith_error
, Qnil
);
2216 case Alogand
: accum
&= next
; break;
2217 case Alogior
: accum
|= next
; break;
2218 case Alogxor
: accum
^= next
; break;
2219 case Amax
: if (!argnum
|| next
> accum
) accum
= next
; break;
2220 case Amin
: if (!argnum
|| next
< accum
) accum
= next
; break;
2224 XSETINT (val
, accum
);
2229 #define isnan(x) ((x) != (x))
2231 #ifdef LISP_FLOAT_TYPE
2234 float_arith_driver (accum
, argnum
, code
, nargs
, args
)
2236 register int argnum
;
2239 register Lisp_Object
*args
;
2241 register Lisp_Object val
;
2244 for (; argnum
< nargs
; argnum
++)
2246 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
2247 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
2251 next
= XFLOAT_DATA (val
);
2255 args
[argnum
] = val
; /* runs into a compiler bug. */
2256 next
= XINT (args
[argnum
]);
2258 switch (SWITCH_ENUM_CAST (code
))
2264 accum
= argnum
? accum
- next
: nargs
== 1 ? - next
: next
;
2274 if (! IEEE_FLOATING_POINT
&& next
== 0)
2275 Fsignal (Qarith_error
, Qnil
);
2282 return wrong_type_argument (Qinteger_or_marker_p
, val
);
2284 if (!argnum
|| isnan (next
) || next
> accum
)
2288 if (!argnum
|| isnan (next
) || next
< accum
)
2294 return make_float (accum
);
2296 #endif /* LISP_FLOAT_TYPE */
2298 DEFUN ("+", Fplus
, Splus
, 0, MANY
, 0,
2299 "Return sum of any number of arguments, which are numbers or markers.")
2304 return arith_driver (Aadd
, nargs
, args
);
2307 DEFUN ("-", Fminus
, Sminus
, 0, MANY
, 0,
2308 "Negate number or subtract numbers or markers.\n\
2309 With one arg, negates it. With more than one arg,\n\
2310 subtracts all but the first from the first.")
2315 return arith_driver (Asub
, nargs
, args
);
2318 DEFUN ("*", Ftimes
, Stimes
, 0, MANY
, 0,
2319 "Returns product of any number of arguments, which are numbers or markers.")
2324 return arith_driver (Amult
, nargs
, args
);
2327 DEFUN ("/", Fquo
, Squo
, 2, MANY
, 0,
2328 "Returns first argument divided by all the remaining arguments.\n\
2329 The arguments must be numbers or markers.")
2334 return arith_driver (Adiv
, nargs
, args
);
2337 DEFUN ("%", Frem
, Srem
, 2, 2, 0,
2338 "Returns remainder of X divided by Y.\n\
2339 Both must be integers or markers.")
2341 register Lisp_Object x
, y
;
2345 CHECK_NUMBER_COERCE_MARKER (x
, 0);
2346 CHECK_NUMBER_COERCE_MARKER (y
, 1);
2348 if (XFASTINT (y
) == 0)
2349 Fsignal (Qarith_error
, Qnil
);
2351 XSETINT (val
, XINT (x
) % XINT (y
));
2365 /* If the magnitude of the result exceeds that of the divisor, or
2366 the sign of the result does not agree with that of the dividend,
2367 iterate with the reduced value. This does not yield a
2368 particularly accurate result, but at least it will be in the
2369 range promised by fmod. */
2371 r
-= f2
* floor (r
/ f2
);
2372 while (f2
<= (r
< 0 ? -r
: r
) || ((r
< 0) != (f1
< 0) && ! isnan (r
)));
2376 #endif /* ! HAVE_FMOD */
2378 DEFUN ("mod", Fmod
, Smod
, 2, 2, 0,
2379 "Returns X modulo Y.\n\
2380 The result falls between zero (inclusive) and Y (exclusive).\n\
2381 Both X and Y must be numbers or markers.")
2383 register Lisp_Object x
, y
;
2388 #ifdef LISP_FLOAT_TYPE
2389 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (x
, 0);
2390 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (y
, 1);
2392 if (FLOATP (x
) || FLOATP (y
))
2393 return fmod_float (x
, y
);
2395 #else /* not LISP_FLOAT_TYPE */
2396 CHECK_NUMBER_COERCE_MARKER (x
, 0);
2397 CHECK_NUMBER_COERCE_MARKER (y
, 1);
2398 #endif /* not LISP_FLOAT_TYPE */
2404 Fsignal (Qarith_error
, Qnil
);
2408 /* If the "remainder" comes out with the wrong sign, fix it. */
2409 if (i2
< 0 ? i1
> 0 : i1
< 0)
2416 DEFUN ("max", Fmax
, Smax
, 1, MANY
, 0,
2417 "Return largest of all the arguments (which must be numbers or markers).\n\
2418 The value is always a number; markers are converted to numbers.")
2423 return arith_driver (Amax
, nargs
, args
);
2426 DEFUN ("min", Fmin
, Smin
, 1, MANY
, 0,
2427 "Return smallest of all the arguments (which must be numbers or markers).\n\
2428 The value is always a number; markers are converted to numbers.")
2433 return arith_driver (Amin
, nargs
, args
);
2436 DEFUN ("logand", Flogand
, Slogand
, 0, MANY
, 0,
2437 "Return bitwise-and of all the arguments.\n\
2438 Arguments may be integers, or markers converted to integers.")
2443 return arith_driver (Alogand
, nargs
, args
);
2446 DEFUN ("logior", Flogior
, Slogior
, 0, MANY
, 0,
2447 "Return bitwise-or of all the arguments.\n\
2448 Arguments may be integers, or markers converted to integers.")
2453 return arith_driver (Alogior
, nargs
, args
);
2456 DEFUN ("logxor", Flogxor
, Slogxor
, 0, MANY
, 0,
2457 "Return bitwise-exclusive-or of all the arguments.\n\
2458 Arguments may be integers, or markers converted to integers.")
2463 return arith_driver (Alogxor
, nargs
, args
);
2466 DEFUN ("ash", Fash
, Sash
, 2, 2, 0,
2467 "Return VALUE with its bits shifted left by COUNT.\n\
2468 If COUNT is negative, shifting is actually to the right.\n\
2469 In this case, the sign bit is duplicated.")
2471 register Lisp_Object value
, count
;
2473 register Lisp_Object val
;
2475 CHECK_NUMBER (value
, 0);
2476 CHECK_NUMBER (count
, 1);
2478 if (XINT (count
) >= BITS_PER_EMACS_INT
)
2480 else if (XINT (count
) > 0)
2481 XSETINT (val
, XINT (value
) << XFASTINT (count
));
2482 else if (XINT (count
) <= -BITS_PER_EMACS_INT
)
2483 XSETINT (val
, XINT (value
) < 0 ? -1 : 0);
2485 XSETINT (val
, XINT (value
) >> -XINT (count
));
2489 DEFUN ("lsh", Flsh
, Slsh
, 2, 2, 0,
2490 "Return VALUE with its bits shifted left by COUNT.\n\
2491 If COUNT is negative, shifting is actually to the right.\n\
2492 In this case, zeros are shifted in on the left.")
2494 register Lisp_Object value
, count
;
2496 register Lisp_Object val
;
2498 CHECK_NUMBER (value
, 0);
2499 CHECK_NUMBER (count
, 1);
2501 if (XINT (count
) >= BITS_PER_EMACS_INT
)
2503 else if (XINT (count
) > 0)
2504 XSETINT (val
, (EMACS_UINT
) XUINT (value
) << XFASTINT (count
));
2505 else if (XINT (count
) <= -BITS_PER_EMACS_INT
)
2508 XSETINT (val
, (EMACS_UINT
) XUINT (value
) >> -XINT (count
));
2512 DEFUN ("1+", Fadd1
, Sadd1
, 1, 1, 0,
2513 "Return NUMBER plus one. NUMBER may be a number or a marker.\n\
2514 Markers are converted to integers.")
2516 register Lisp_Object number
;
2518 #ifdef LISP_FLOAT_TYPE
2519 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number
, 0);
2521 if (FLOATP (number
))
2522 return (make_float (1.0 + XFLOAT_DATA (number
)));
2524 CHECK_NUMBER_COERCE_MARKER (number
, 0);
2525 #endif /* LISP_FLOAT_TYPE */
2527 XSETINT (number
, XINT (number
) + 1);
2531 DEFUN ("1-", Fsub1
, Ssub1
, 1, 1, 0,
2532 "Return NUMBER minus one. NUMBER may be a number or a marker.\n\
2533 Markers are converted to integers.")
2535 register Lisp_Object number
;
2537 #ifdef LISP_FLOAT_TYPE
2538 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number
, 0);
2540 if (FLOATP (number
))
2541 return (make_float (-1.0 + XFLOAT_DATA (number
)));
2543 CHECK_NUMBER_COERCE_MARKER (number
, 0);
2544 #endif /* LISP_FLOAT_TYPE */
2546 XSETINT (number
, XINT (number
) - 1);
2550 DEFUN ("lognot", Flognot
, Slognot
, 1, 1, 0,
2551 "Return the bitwise complement of NUMBER. NUMBER must be an integer.")
2553 register Lisp_Object number
;
2555 CHECK_NUMBER (number
, 0);
2556 XSETINT (number
, ~XINT (number
));
2563 Lisp_Object error_tail
, arith_tail
;
2565 Qquote
= intern ("quote");
2566 Qlambda
= intern ("lambda");
2567 Qsubr
= intern ("subr");
2568 Qerror_conditions
= intern ("error-conditions");
2569 Qerror_message
= intern ("error-message");
2570 Qtop_level
= intern ("top-level");
2572 Qerror
= intern ("error");
2573 Qquit
= intern ("quit");
2574 Qwrong_type_argument
= intern ("wrong-type-argument");
2575 Qargs_out_of_range
= intern ("args-out-of-range");
2576 Qvoid_function
= intern ("void-function");
2577 Qcyclic_function_indirection
= intern ("cyclic-function-indirection");
2578 Qvoid_variable
= intern ("void-variable");
2579 Qsetting_constant
= intern ("setting-constant");
2580 Qinvalid_read_syntax
= intern ("invalid-read-syntax");
2582 Qinvalid_function
= intern ("invalid-function");
2583 Qwrong_number_of_arguments
= intern ("wrong-number-of-arguments");
2584 Qno_catch
= intern ("no-catch");
2585 Qend_of_file
= intern ("end-of-file");
2586 Qarith_error
= intern ("arith-error");
2587 Qbeginning_of_buffer
= intern ("beginning-of-buffer");
2588 Qend_of_buffer
= intern ("end-of-buffer");
2589 Qbuffer_read_only
= intern ("buffer-read-only");
2590 Qtext_read_only
= intern ("text-read-only");
2591 Qmark_inactive
= intern ("mark-inactive");
2593 Qlistp
= intern ("listp");
2594 Qconsp
= intern ("consp");
2595 Qsymbolp
= intern ("symbolp");
2596 Qintegerp
= intern ("integerp");
2597 Qnatnump
= intern ("natnump");
2598 Qwholenump
= intern ("wholenump");
2599 Qstringp
= intern ("stringp");
2600 Qarrayp
= intern ("arrayp");
2601 Qsequencep
= intern ("sequencep");
2602 Qbufferp
= intern ("bufferp");
2603 Qvectorp
= intern ("vectorp");
2604 Qchar_or_string_p
= intern ("char-or-string-p");
2605 Qmarkerp
= intern ("markerp");
2606 Qbuffer_or_string_p
= intern ("buffer-or-string-p");
2607 Qinteger_or_marker_p
= intern ("integer-or-marker-p");
2608 Qboundp
= intern ("boundp");
2609 Qfboundp
= intern ("fboundp");
2611 #ifdef LISP_FLOAT_TYPE
2612 Qfloatp
= intern ("floatp");
2613 Qnumberp
= intern ("numberp");
2614 Qnumber_or_marker_p
= intern ("number-or-marker-p");
2615 #endif /* LISP_FLOAT_TYPE */
2617 Qchar_table_p
= intern ("char-table-p");
2618 Qvector_or_char_table_p
= intern ("vector-or-char-table-p");
2620 Qcdr
= intern ("cdr");
2622 /* Handle automatic advice activation */
2623 Qad_advice_info
= intern ("ad-advice-info");
2624 Qad_activate_internal
= intern ("ad-activate-internal");
2626 error_tail
= Fcons (Qerror
, Qnil
);
2628 /* ERROR is used as a signaler for random errors for which nothing else is right */
2630 Fput (Qerror
, Qerror_conditions
,
2632 Fput (Qerror
, Qerror_message
,
2633 build_string ("error"));
2635 Fput (Qquit
, Qerror_conditions
,
2636 Fcons (Qquit
, Qnil
));
2637 Fput (Qquit
, Qerror_message
,
2638 build_string ("Quit"));
2640 Fput (Qwrong_type_argument
, Qerror_conditions
,
2641 Fcons (Qwrong_type_argument
, error_tail
));
2642 Fput (Qwrong_type_argument
, Qerror_message
,
2643 build_string ("Wrong type argument"));
2645 Fput (Qargs_out_of_range
, Qerror_conditions
,
2646 Fcons (Qargs_out_of_range
, error_tail
));
2647 Fput (Qargs_out_of_range
, Qerror_message
,
2648 build_string ("Args out of range"));
2650 Fput (Qvoid_function
, Qerror_conditions
,
2651 Fcons (Qvoid_function
, error_tail
));
2652 Fput (Qvoid_function
, Qerror_message
,
2653 build_string ("Symbol's function definition is void"));
2655 Fput (Qcyclic_function_indirection
, Qerror_conditions
,
2656 Fcons (Qcyclic_function_indirection
, error_tail
));
2657 Fput (Qcyclic_function_indirection
, Qerror_message
,
2658 build_string ("Symbol's chain of function indirections contains a loop"));
2660 Fput (Qvoid_variable
, Qerror_conditions
,
2661 Fcons (Qvoid_variable
, error_tail
));
2662 Fput (Qvoid_variable
, Qerror_message
,
2663 build_string ("Symbol's value as variable is void"));
2665 Fput (Qsetting_constant
, Qerror_conditions
,
2666 Fcons (Qsetting_constant
, error_tail
));
2667 Fput (Qsetting_constant
, Qerror_message
,
2668 build_string ("Attempt to set a constant symbol"));
2670 Fput (Qinvalid_read_syntax
, Qerror_conditions
,
2671 Fcons (Qinvalid_read_syntax
, error_tail
));
2672 Fput (Qinvalid_read_syntax
, Qerror_message
,
2673 build_string ("Invalid read syntax"));
2675 Fput (Qinvalid_function
, Qerror_conditions
,
2676 Fcons (Qinvalid_function
, error_tail
));
2677 Fput (Qinvalid_function
, Qerror_message
,
2678 build_string ("Invalid function"));
2680 Fput (Qwrong_number_of_arguments
, Qerror_conditions
,
2681 Fcons (Qwrong_number_of_arguments
, error_tail
));
2682 Fput (Qwrong_number_of_arguments
, Qerror_message
,
2683 build_string ("Wrong number of arguments"));
2685 Fput (Qno_catch
, Qerror_conditions
,
2686 Fcons (Qno_catch
, error_tail
));
2687 Fput (Qno_catch
, Qerror_message
,
2688 build_string ("No catch for tag"));
2690 Fput (Qend_of_file
, Qerror_conditions
,
2691 Fcons (Qend_of_file
, error_tail
));
2692 Fput (Qend_of_file
, Qerror_message
,
2693 build_string ("End of file during parsing"));
2695 arith_tail
= Fcons (Qarith_error
, error_tail
);
2696 Fput (Qarith_error
, Qerror_conditions
,
2698 Fput (Qarith_error
, Qerror_message
,
2699 build_string ("Arithmetic error"));
2701 Fput (Qbeginning_of_buffer
, Qerror_conditions
,
2702 Fcons (Qbeginning_of_buffer
, error_tail
));
2703 Fput (Qbeginning_of_buffer
, Qerror_message
,
2704 build_string ("Beginning of buffer"));
2706 Fput (Qend_of_buffer
, Qerror_conditions
,
2707 Fcons (Qend_of_buffer
, error_tail
));
2708 Fput (Qend_of_buffer
, Qerror_message
,
2709 build_string ("End of buffer"));
2711 Fput (Qbuffer_read_only
, Qerror_conditions
,
2712 Fcons (Qbuffer_read_only
, error_tail
));
2713 Fput (Qbuffer_read_only
, Qerror_message
,
2714 build_string ("Buffer is read-only"));
2716 Fput (Qtext_read_only
, Qerror_conditions
,
2717 Fcons (Qtext_read_only
, error_tail
));
2718 Fput (Qtext_read_only
, Qerror_message
,
2719 build_string ("Text is read-only"));
2721 #ifdef LISP_FLOAT_TYPE
2722 Qrange_error
= intern ("range-error");
2723 Qdomain_error
= intern ("domain-error");
2724 Qsingularity_error
= intern ("singularity-error");
2725 Qoverflow_error
= intern ("overflow-error");
2726 Qunderflow_error
= intern ("underflow-error");
2728 Fput (Qdomain_error
, Qerror_conditions
,
2729 Fcons (Qdomain_error
, arith_tail
));
2730 Fput (Qdomain_error
, Qerror_message
,
2731 build_string ("Arithmetic domain error"));
2733 Fput (Qrange_error
, Qerror_conditions
,
2734 Fcons (Qrange_error
, arith_tail
));
2735 Fput (Qrange_error
, Qerror_message
,
2736 build_string ("Arithmetic range error"));
2738 Fput (Qsingularity_error
, Qerror_conditions
,
2739 Fcons (Qsingularity_error
, Fcons (Qdomain_error
, arith_tail
)));
2740 Fput (Qsingularity_error
, Qerror_message
,
2741 build_string ("Arithmetic singularity error"));
2743 Fput (Qoverflow_error
, Qerror_conditions
,
2744 Fcons (Qoverflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2745 Fput (Qoverflow_error
, Qerror_message
,
2746 build_string ("Arithmetic overflow error"));
2748 Fput (Qunderflow_error
, Qerror_conditions
,
2749 Fcons (Qunderflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2750 Fput (Qunderflow_error
, Qerror_message
,
2751 build_string ("Arithmetic underflow error"));
2753 staticpro (&Qrange_error
);
2754 staticpro (&Qdomain_error
);
2755 staticpro (&Qsingularity_error
);
2756 staticpro (&Qoverflow_error
);
2757 staticpro (&Qunderflow_error
);
2758 #endif /* LISP_FLOAT_TYPE */
2762 staticpro (&Qquote
);
2763 staticpro (&Qlambda
);
2765 staticpro (&Qunbound
);
2766 staticpro (&Qerror_conditions
);
2767 staticpro (&Qerror_message
);
2768 staticpro (&Qtop_level
);
2770 staticpro (&Qerror
);
2772 staticpro (&Qwrong_type_argument
);
2773 staticpro (&Qargs_out_of_range
);
2774 staticpro (&Qvoid_function
);
2775 staticpro (&Qcyclic_function_indirection
);
2776 staticpro (&Qvoid_variable
);
2777 staticpro (&Qsetting_constant
);
2778 staticpro (&Qinvalid_read_syntax
);
2779 staticpro (&Qwrong_number_of_arguments
);
2780 staticpro (&Qinvalid_function
);
2781 staticpro (&Qno_catch
);
2782 staticpro (&Qend_of_file
);
2783 staticpro (&Qarith_error
);
2784 staticpro (&Qbeginning_of_buffer
);
2785 staticpro (&Qend_of_buffer
);
2786 staticpro (&Qbuffer_read_only
);
2787 staticpro (&Qtext_read_only
);
2788 staticpro (&Qmark_inactive
);
2790 staticpro (&Qlistp
);
2791 staticpro (&Qconsp
);
2792 staticpro (&Qsymbolp
);
2793 staticpro (&Qintegerp
);
2794 staticpro (&Qnatnump
);
2795 staticpro (&Qwholenump
);
2796 staticpro (&Qstringp
);
2797 staticpro (&Qarrayp
);
2798 staticpro (&Qsequencep
);
2799 staticpro (&Qbufferp
);
2800 staticpro (&Qvectorp
);
2801 staticpro (&Qchar_or_string_p
);
2802 staticpro (&Qmarkerp
);
2803 staticpro (&Qbuffer_or_string_p
);
2804 staticpro (&Qinteger_or_marker_p
);
2805 #ifdef LISP_FLOAT_TYPE
2806 staticpro (&Qfloatp
);
2807 staticpro (&Qnumberp
);
2808 staticpro (&Qnumber_or_marker_p
);
2809 #endif /* LISP_FLOAT_TYPE */
2810 staticpro (&Qchar_table_p
);
2811 staticpro (&Qvector_or_char_table_p
);
2813 staticpro (&Qboundp
);
2814 staticpro (&Qfboundp
);
2816 staticpro (&Qad_advice_info
);
2817 staticpro (&Qad_activate_internal
);
2819 /* Types that type-of returns. */
2820 Qinteger
= intern ("integer");
2821 Qsymbol
= intern ("symbol");
2822 Qstring
= intern ("string");
2823 Qcons
= intern ("cons");
2824 Qmarker
= intern ("marker");
2825 Qoverlay
= intern ("overlay");
2826 Qfloat
= intern ("float");
2827 Qwindow_configuration
= intern ("window-configuration");
2828 Qprocess
= intern ("process");
2829 Qwindow
= intern ("window");
2830 /* Qsubr = intern ("subr"); */
2831 Qcompiled_function
= intern ("compiled-function");
2832 Qbuffer
= intern ("buffer");
2833 Qframe
= intern ("frame");
2834 Qvector
= intern ("vector");
2835 Qchar_table
= intern ("char-table");
2836 Qbool_vector
= intern ("bool-vector");
2837 Qhash_table
= intern ("hash-table");
2839 staticpro (&Qinteger
);
2840 staticpro (&Qsymbol
);
2841 staticpro (&Qstring
);
2843 staticpro (&Qmarker
);
2844 staticpro (&Qoverlay
);
2845 staticpro (&Qfloat
);
2846 staticpro (&Qwindow_configuration
);
2847 staticpro (&Qprocess
);
2848 staticpro (&Qwindow
);
2849 /* staticpro (&Qsubr); */
2850 staticpro (&Qcompiled_function
);
2851 staticpro (&Qbuffer
);
2852 staticpro (&Qframe
);
2853 staticpro (&Qvector
);
2854 staticpro (&Qchar_table
);
2855 staticpro (&Qbool_vector
);
2856 staticpro (&Qhash_table
);
2858 DEFVAR_BOOL ("keyword-symbols-constant-flag", &keyword_symbols_constant_flag
,
2859 "Non-nil means it is an error to set a keyword symbol.\n\
2860 A keyword symbol is a symbol whose name starts with a colon (`:').");
2861 keyword_symbols_constant_flag
= 1;
2865 defsubr (&Stype_of
);
2870 defsubr (&Sintegerp
);
2871 defsubr (&Sinteger_or_marker_p
);
2872 defsubr (&Snumberp
);
2873 defsubr (&Snumber_or_marker_p
);
2874 #ifdef LISP_FLOAT_TYPE
2876 #endif /* LISP_FLOAT_TYPE */
2877 defsubr (&Snatnump
);
2878 defsubr (&Ssymbolp
);
2879 defsubr (&Sstringp
);
2880 defsubr (&Smultibyte_string_p
);
2881 defsubr (&Svectorp
);
2882 defsubr (&Schar_table_p
);
2883 defsubr (&Svector_or_char_table_p
);
2884 defsubr (&Sbool_vector_p
);
2886 defsubr (&Ssequencep
);
2887 defsubr (&Sbufferp
);
2888 defsubr (&Smarkerp
);
2890 defsubr (&Sbyte_code_function_p
);
2891 defsubr (&Schar_or_string_p
);
2894 defsubr (&Scar_safe
);
2895 defsubr (&Scdr_safe
);
2898 defsubr (&Ssymbol_function
);
2899 defsubr (&Sindirect_function
);
2900 defsubr (&Ssymbol_plist
);
2901 defsubr (&Ssymbol_name
);
2902 defsubr (&Smakunbound
);
2903 defsubr (&Sfmakunbound
);
2905 defsubr (&Sfboundp
);
2907 defsubr (&Sdefalias
);
2908 defsubr (&Ssetplist
);
2909 defsubr (&Ssymbol_value
);
2911 defsubr (&Sdefault_boundp
);
2912 defsubr (&Sdefault_value
);
2913 defsubr (&Sset_default
);
2914 defsubr (&Ssetq_default
);
2915 defsubr (&Smake_variable_buffer_local
);
2916 defsubr (&Smake_local_variable
);
2917 defsubr (&Skill_local_variable
);
2918 defsubr (&Smake_variable_frame_local
);
2919 defsubr (&Slocal_variable_p
);
2920 defsubr (&Slocal_variable_if_set_p
);
2923 defsubr (&Snumber_to_string
);
2924 defsubr (&Sstring_to_number
);
2925 defsubr (&Seqlsign
);
2949 XSYMBOL (Qwholenump
)->function
= XSYMBOL (Qnatnump
)->function
;
2956 #if defined(USG) && !defined(POSIX_SIGNALS)
2957 /* USG systems forget handlers when they are used;
2958 must reestablish each time */
2959 signal (signo
, arith_error
);
2962 /* VMS systems are like USG. */
2963 signal (signo
, arith_error
);
2967 #else /* not BSD4_1 */
2968 sigsetmask (SIGEMPTYMASK
);
2969 #endif /* not BSD4_1 */
2971 Fsignal (Qarith_error
, Qnil
);
2977 /* Don't do this if just dumping out.
2978 We don't want to call `signal' in this case
2979 so that we don't have trouble with dumping
2980 signal-delivering routines in an inconsistent state. */
2984 #endif /* CANNOT_DUMP */
2985 signal (SIGFPE
, arith_error
);
2988 signal (SIGEMT
, arith_error
);