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
, Qkeywordp
;
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 /* Define this in C to avoid unnecessarily consing up the symbol
316 DEFUN ("keywordp", Fkeywordp
, Skeywordp
, 1, 1, 0,
317 "Return t if OBJECT is a keyword.\n\
318 This means that it is a symbol with a print name beginning with `:'\n\
319 interned in the initial obarray.")
324 && XSYMBOL (object
)->name
->data
[0] == ':'
325 && EQ (XSYMBOL (object
)->obarray
, initial_obarray
))
330 DEFUN ("vectorp", Fvectorp
, Svectorp
, 1, 1, 0,
331 "Return t if OBJECT is a vector.")
335 if (VECTORP (object
))
340 DEFUN ("stringp", Fstringp
, Sstringp
, 1, 1, 0,
341 "Return t if OBJECT is a string.")
345 if (STRINGP (object
))
350 DEFUN ("multibyte-string-p", Fmultibyte_string_p
, Smultibyte_string_p
,
351 1, 1, 0, "Return t if OBJECT is a multibyte string.")
355 if (STRINGP (object
) && STRING_MULTIBYTE (object
))
360 DEFUN ("char-table-p", Fchar_table_p
, Schar_table_p
, 1, 1, 0,
361 "Return t if OBJECT is a char-table.")
365 if (CHAR_TABLE_P (object
))
370 DEFUN ("vector-or-char-table-p", Fvector_or_char_table_p
,
371 Svector_or_char_table_p
, 1, 1, 0,
372 "Return t if OBJECT is a char-table or vector.")
376 if (VECTORP (object
) || CHAR_TABLE_P (object
))
381 DEFUN ("bool-vector-p", Fbool_vector_p
, Sbool_vector_p
, 1, 1, 0, "Return t if OBJECT is a bool-vector.")
385 if (BOOL_VECTOR_P (object
))
390 DEFUN ("arrayp", Farrayp
, Sarrayp
, 1, 1, 0, "Return t if OBJECT is an array (string or vector).")
394 if (VECTORP (object
) || STRINGP (object
)
395 || CHAR_TABLE_P (object
) || BOOL_VECTOR_P (object
))
400 DEFUN ("sequencep", Fsequencep
, Ssequencep
, 1, 1, 0,
401 "Return t if OBJECT is a sequence (list or array).")
403 register Lisp_Object object
;
405 if (CONSP (object
) || NILP (object
) || VECTORP (object
) || STRINGP (object
)
406 || CHAR_TABLE_P (object
) || BOOL_VECTOR_P (object
))
411 DEFUN ("bufferp", Fbufferp
, Sbufferp
, 1, 1, 0, "Return t if OBJECT is an editor buffer.")
415 if (BUFFERP (object
))
420 DEFUN ("markerp", Fmarkerp
, Smarkerp
, 1, 1, 0, "Return t if OBJECT is a marker (editor pointer).")
424 if (MARKERP (object
))
429 DEFUN ("subrp", Fsubrp
, Ssubrp
, 1, 1, 0, "Return t if OBJECT is a built-in function.")
438 DEFUN ("byte-code-function-p", Fbyte_code_function_p
, Sbyte_code_function_p
,
439 1, 1, 0, "Return t if OBJECT is a byte-compiled function object.")
443 if (COMPILEDP (object
))
448 DEFUN ("char-or-string-p", Fchar_or_string_p
, Schar_or_string_p
, 1, 1, 0,
449 "Return t if OBJECT is a character (an integer) or a string.")
451 register Lisp_Object object
;
453 if (INTEGERP (object
) || STRINGP (object
))
458 DEFUN ("integerp", Fintegerp
, Sintegerp
, 1, 1, 0, "Return t if OBJECT is an integer.")
462 if (INTEGERP (object
))
467 DEFUN ("integer-or-marker-p", Finteger_or_marker_p
, Sinteger_or_marker_p
, 1, 1, 0,
468 "Return t if OBJECT is an integer or a marker (editor pointer).")
470 register Lisp_Object object
;
472 if (MARKERP (object
) || INTEGERP (object
))
477 DEFUN ("natnump", Fnatnump
, Snatnump
, 1, 1, 0,
478 "Return t if OBJECT is a nonnegative integer.")
482 if (NATNUMP (object
))
487 DEFUN ("numberp", Fnumberp
, Snumberp
, 1, 1, 0,
488 "Return t if OBJECT is a number (floating point or integer).")
492 if (NUMBERP (object
))
498 DEFUN ("number-or-marker-p", Fnumber_or_marker_p
,
499 Snumber_or_marker_p
, 1, 1, 0,
500 "Return t if OBJECT is a number or a marker.")
504 if (NUMBERP (object
) || MARKERP (object
))
509 #ifdef LISP_FLOAT_TYPE
510 DEFUN ("floatp", Ffloatp
, Sfloatp
, 1, 1, 0,
511 "Return t if OBJECT is a floating point number.")
519 #endif /* LISP_FLOAT_TYPE */
521 /* Extract and set components of lists */
523 DEFUN ("car", Fcar
, Scar
, 1, 1, 0,
524 "Return the car of LIST. If arg is nil, return nil.\n\
525 Error if arg is not nil and not a cons cell. See also `car-safe'.")
527 register Lisp_Object list
;
533 else if (EQ (list
, Qnil
))
536 list
= wrong_type_argument (Qlistp
, list
);
540 DEFUN ("car-safe", Fcar_safe
, Scar_safe
, 1, 1, 0,
541 "Return the car of OBJECT if it is a cons cell, or else nil.")
546 return XCAR (object
);
551 DEFUN ("cdr", Fcdr
, Scdr
, 1, 1, 0,
552 "Return the cdr of LIST. If arg is nil, return nil.\n\
553 Error if arg is not nil and not a cons cell. See also `cdr-safe'.")
556 register Lisp_Object list
;
562 else if (EQ (list
, Qnil
))
565 list
= wrong_type_argument (Qlistp
, list
);
569 DEFUN ("cdr-safe", Fcdr_safe
, Scdr_safe
, 1, 1, 0,
570 "Return the cdr of OBJECT if it is a cons cell, or else nil.")
575 return XCDR (object
);
580 DEFUN ("setcar", Fsetcar
, Ssetcar
, 2, 2, 0,
581 "Set the car of CELL to be NEWCAR. Returns NEWCAR.")
583 register Lisp_Object cell
, newcar
;
586 cell
= wrong_type_argument (Qconsp
, cell
);
589 XCAR (cell
) = newcar
;
593 DEFUN ("setcdr", Fsetcdr
, Ssetcdr
, 2, 2, 0,
594 "Set the cdr of CELL to be NEWCDR. Returns NEWCDR.")
596 register Lisp_Object cell
, newcdr
;
599 cell
= wrong_type_argument (Qconsp
, cell
);
602 XCDR (cell
) = newcdr
;
606 /* Extract and set components of symbols */
608 DEFUN ("boundp", Fboundp
, Sboundp
, 1, 1, 0, "Return t if SYMBOL's value is not void.")
610 register Lisp_Object symbol
;
612 Lisp_Object valcontents
;
613 CHECK_SYMBOL (symbol
, 0);
615 valcontents
= XSYMBOL (symbol
)->value
;
617 if (BUFFER_LOCAL_VALUEP (valcontents
)
618 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
619 valcontents
= swap_in_symval_forwarding (symbol
, valcontents
);
621 return (EQ (valcontents
, Qunbound
) ? Qnil
: Qt
);
624 DEFUN ("fboundp", Ffboundp
, Sfboundp
, 1, 1, 0, "Return t if SYMBOL's function definition is not void.")
626 register Lisp_Object symbol
;
628 CHECK_SYMBOL (symbol
, 0);
629 return (EQ (XSYMBOL (symbol
)->function
, Qunbound
) ? Qnil
: Qt
);
632 DEFUN ("makunbound", Fmakunbound
, Smakunbound
, 1, 1, 0, "Make SYMBOL's value be void.")
634 register Lisp_Object symbol
;
636 CHECK_SYMBOL (symbol
, 0);
637 if (NILP (symbol
) || EQ (symbol
, Qt
)
638 || (XSYMBOL (symbol
)->name
->data
[0] == ':'
639 && EQ (XSYMBOL (symbol
)->obarray
, initial_obarray
)
640 && keyword_symbols_constant_flag
))
641 return Fsignal (Qsetting_constant
, Fcons (symbol
, Qnil
));
642 Fset (symbol
, Qunbound
);
646 DEFUN ("fmakunbound", Ffmakunbound
, Sfmakunbound
, 1, 1, 0, "Make SYMBOL's function definition be void.")
648 register Lisp_Object symbol
;
650 CHECK_SYMBOL (symbol
, 0);
651 if (NILP (symbol
) || EQ (symbol
, Qt
))
652 return Fsignal (Qsetting_constant
, Fcons (symbol
, Qnil
));
653 XSYMBOL (symbol
)->function
= Qunbound
;
657 DEFUN ("symbol-function", Fsymbol_function
, Ssymbol_function
, 1, 1, 0,
658 "Return SYMBOL's function definition. Error if that is void.")
660 register Lisp_Object symbol
;
662 CHECK_SYMBOL (symbol
, 0);
663 if (EQ (XSYMBOL (symbol
)->function
, Qunbound
))
664 return Fsignal (Qvoid_function
, Fcons (symbol
, Qnil
));
665 return XSYMBOL (symbol
)->function
;
668 DEFUN ("symbol-plist", Fsymbol_plist
, Ssymbol_plist
, 1, 1, 0, "Return SYMBOL's property list.")
670 register Lisp_Object symbol
;
672 CHECK_SYMBOL (symbol
, 0);
673 return XSYMBOL (symbol
)->plist
;
676 DEFUN ("symbol-name", Fsymbol_name
, Ssymbol_name
, 1, 1, 0, "Return SYMBOL's name, a string.")
678 register Lisp_Object symbol
;
680 register Lisp_Object name
;
682 CHECK_SYMBOL (symbol
, 0);
683 XSETSTRING (name
, XSYMBOL (symbol
)->name
);
687 DEFUN ("fset", Ffset
, Sfset
, 2, 2, 0,
688 "Set SYMBOL's function definition to DEFINITION, and return DEFINITION.")
690 register Lisp_Object symbol
, definition
;
692 CHECK_SYMBOL (symbol
, 0);
693 if (NILP (symbol
) || EQ (symbol
, Qt
))
694 return Fsignal (Qsetting_constant
, Fcons (symbol
, Qnil
));
695 if (!NILP (Vautoload_queue
) && !EQ (XSYMBOL (symbol
)->function
, Qunbound
))
696 Vautoload_queue
= Fcons (Fcons (symbol
, XSYMBOL (symbol
)->function
),
698 XSYMBOL (symbol
)->function
= definition
;
699 /* Handle automatic advice activation */
700 if (CONSP (XSYMBOL (symbol
)->plist
) && !NILP (Fget (symbol
, Qad_advice_info
)))
702 call2 (Qad_activate_internal
, symbol
, Qnil
);
703 definition
= XSYMBOL (symbol
)->function
;
708 DEFUN ("defalias", Fdefalias
, Sdefalias
, 2, 2, 0,
709 "Set SYMBOL's function definition to DEFINITION, and return DEFINITION.\n\
710 Associates the function with the current load file, if any.")
712 register Lisp_Object symbol
, definition
;
714 definition
= Ffset (symbol
, definition
);
715 LOADHIST_ATTACH (symbol
);
719 DEFUN ("setplist", Fsetplist
, Ssetplist
, 2, 2, 0,
720 "Set SYMBOL's property list to NEWVAL, and return NEWVAL.")
722 register Lisp_Object symbol
, newplist
;
724 CHECK_SYMBOL (symbol
, 0);
725 XSYMBOL (symbol
)->plist
= newplist
;
730 /* Getting and setting values of symbols */
732 /* Given the raw contents of a symbol value cell,
733 return the Lisp value of the symbol.
734 This does not handle buffer-local variables; use
735 swap_in_symval_forwarding for that. */
738 do_symval_forwarding (valcontents
)
739 register Lisp_Object valcontents
;
741 register Lisp_Object val
;
743 if (MISCP (valcontents
))
744 switch (XMISCTYPE (valcontents
))
746 case Lisp_Misc_Intfwd
:
747 XSETINT (val
, *XINTFWD (valcontents
)->intvar
);
750 case Lisp_Misc_Boolfwd
:
751 return (*XBOOLFWD (valcontents
)->boolvar
? Qt
: Qnil
);
753 case Lisp_Misc_Objfwd
:
754 return *XOBJFWD (valcontents
)->objvar
;
756 case Lisp_Misc_Buffer_Objfwd
:
757 offset
= XBUFFER_OBJFWD (valcontents
)->offset
;
758 return *(Lisp_Object
*)(offset
+ (char *)current_buffer
);
760 case Lisp_Misc_Kboard_Objfwd
:
761 offset
= XKBOARD_OBJFWD (valcontents
)->offset
;
762 return *(Lisp_Object
*)(offset
+ (char *)current_kboard
);
767 /* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell
768 of SYMBOL. If SYMBOL is buffer-local, VALCONTENTS should be the
769 buffer-independent contents of the value cell: forwarded just one
770 step past the buffer-localness. */
773 store_symval_forwarding (symbol
, valcontents
, newval
)
775 register Lisp_Object valcontents
, newval
;
777 switch (SWITCH_ENUM_CAST (XTYPE (valcontents
)))
780 switch (XMISCTYPE (valcontents
))
782 case Lisp_Misc_Intfwd
:
783 CHECK_NUMBER (newval
, 1);
784 *XINTFWD (valcontents
)->intvar
= XINT (newval
);
785 if (*XINTFWD (valcontents
)->intvar
!= XINT (newval
))
786 error ("Value out of range for variable `%s'",
787 XSYMBOL (symbol
)->name
->data
);
790 case Lisp_Misc_Boolfwd
:
791 *XBOOLFWD (valcontents
)->boolvar
= NILP (newval
) ? 0 : 1;
794 case Lisp_Misc_Objfwd
:
795 *XOBJFWD (valcontents
)->objvar
= newval
;
798 case Lisp_Misc_Buffer_Objfwd
:
800 int offset
= XBUFFER_OBJFWD (valcontents
)->offset
;
803 type
= *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
);
804 if (XINT (type
) == -1)
805 error ("Variable %s is read-only", XSYMBOL (symbol
)->name
->data
);
807 if (! NILP (type
) && ! NILP (newval
)
808 && XTYPE (newval
) != XINT (type
))
809 buffer_slot_type_mismatch (offset
);
811 *(Lisp_Object
*)(offset
+ (char *)current_buffer
) = newval
;
815 case Lisp_Misc_Kboard_Objfwd
:
816 (*(Lisp_Object
*)((char *)current_kboard
817 + XKBOARD_OBJFWD (valcontents
)->offset
))
828 valcontents
= XSYMBOL (symbol
)->value
;
829 if (BUFFER_LOCAL_VALUEP (valcontents
)
830 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
831 XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
= newval
;
833 XSYMBOL (symbol
)->value
= newval
;
837 /* Set up the buffer-local symbol SYMBOL for validity in the current buffer.
838 VALCONTENTS is the contents of its value cell.
839 Return the value forwarded one step past the buffer-local indicator. */
842 swap_in_symval_forwarding (symbol
, valcontents
)
843 Lisp_Object symbol
, valcontents
;
845 /* valcontents is a pointer to a struct resembling the cons
846 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)).
848 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
849 local_var_alist, that being the element whose car is this
850 variable. Or it can be a pointer to the
851 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not have
852 an element in its alist for this variable.
854 If the current buffer is not BUFFER, we store the current
855 REALVALUE value into CURRENT-ALIST-ELEMENT, then find the
856 appropriate alist element for the buffer now current and set up
857 CURRENT-ALIST-ELEMENT. Then we set REALVALUE out of that
858 element, and store into BUFFER.
860 Note that REALVALUE can be a forwarding pointer. */
862 register Lisp_Object tem1
;
863 tem1
= XBUFFER_LOCAL_VALUE (valcontents
)->buffer
;
865 if (NILP (tem1
) || current_buffer
!= XBUFFER (tem1
)
866 || !EQ (selected_frame
, XBUFFER_LOCAL_VALUE (valcontents
)->frame
))
868 tem1
= XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
870 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
));
871 tem1
= assq_no_quit (symbol
, current_buffer
->local_var_alist
);
872 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 0;
873 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
876 if (XBUFFER_LOCAL_VALUE (valcontents
)->check_frame
)
877 tem1
= assq_no_quit (symbol
, XFRAME (selected_frame
)->param_alist
);
879 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 1;
881 tem1
= XBUFFER_LOCAL_VALUE (valcontents
)->cdr
;
884 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 1;
886 XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
) = tem1
;
887 XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents
)->buffer
, current_buffer
);
888 XBUFFER_LOCAL_VALUE (valcontents
)->frame
= selected_frame
;
889 store_symval_forwarding (symbol
,
890 XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
,
893 return XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
;
896 /* Find the value of a symbol, returning Qunbound if it's not bound.
897 This is helpful for code which just wants to get a variable's value
898 if it has one, without signaling an error.
899 Note that it must not be possible to quit
900 within this function. Great care is required for this. */
903 find_symbol_value (symbol
)
906 register Lisp_Object valcontents
;
907 register Lisp_Object val
;
908 CHECK_SYMBOL (symbol
, 0);
909 valcontents
= XSYMBOL (symbol
)->value
;
911 if (BUFFER_LOCAL_VALUEP (valcontents
)
912 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
913 valcontents
= swap_in_symval_forwarding (symbol
, valcontents
,
916 if (MISCP (valcontents
))
918 switch (XMISCTYPE (valcontents
))
920 case Lisp_Misc_Intfwd
:
921 XSETINT (val
, *XINTFWD (valcontents
)->intvar
);
924 case Lisp_Misc_Boolfwd
:
925 return (*XBOOLFWD (valcontents
)->boolvar
? Qt
: Qnil
);
927 case Lisp_Misc_Objfwd
:
928 return *XOBJFWD (valcontents
)->objvar
;
930 case Lisp_Misc_Buffer_Objfwd
:
931 return *(Lisp_Object
*)(XBUFFER_OBJFWD (valcontents
)->offset
932 + (char *)current_buffer
);
934 case Lisp_Misc_Kboard_Objfwd
:
935 return *(Lisp_Object
*)(XKBOARD_OBJFWD (valcontents
)->offset
936 + (char *)current_kboard
);
943 DEFUN ("symbol-value", Fsymbol_value
, Ssymbol_value
, 1, 1, 0,
944 "Return SYMBOL's value. Error if that is void.")
950 val
= find_symbol_value (symbol
);
951 if (EQ (val
, Qunbound
))
952 return Fsignal (Qvoid_variable
, Fcons (symbol
, Qnil
));
957 DEFUN ("set", Fset
, Sset
, 2, 2, 0,
958 "Set SYMBOL's value to NEWVAL, and return NEWVAL.")
960 register Lisp_Object symbol
, newval
;
962 return set_internal (symbol
, newval
, current_buffer
, 0);
965 /* Return 1 if SYMBOL currently has a let-binding
966 which was made in the buffer that is now current. */
969 let_shadows_buffer_binding_p (symbol
)
972 struct specbinding
*p
;
974 for (p
= specpdl_ptr
- 1; p
>= specpdl
; p
--)
975 if (p
->func
== 0 && CONSP (p
->symbol
)
976 && XBUFFER (XCDR (XCDR (p
->symbol
))) == current_buffer
)
982 /* Store the value NEWVAL into SYMBOL.
983 If buffer-locality is an issue, BUF specifies which buffer to use.
984 (0 stands for the current buffer.)
986 If BINDFLAG is zero, then if this symbol is supposed to become
987 local in every buffer where it is set, then we make it local.
988 If BINDFLAG is nonzero, we don't do that. */
991 set_internal (symbol
, newval
, buf
, bindflag
)
992 register Lisp_Object symbol
, newval
;
996 int voide
= EQ (newval
, Qunbound
);
998 register Lisp_Object valcontents
, tem1
, current_alist_element
;
1001 buf
= current_buffer
;
1003 /* If restoring in a dead buffer, do nothing. */
1004 if (NILP (buf
->name
))
1007 CHECK_SYMBOL (symbol
, 0);
1008 if (NILP (symbol
) || EQ (symbol
, Qt
)
1009 || (XSYMBOL (symbol
)->name
->data
[0] == ':'
1010 && EQ (XSYMBOL (symbol
)->obarray
, initial_obarray
)
1011 && keyword_symbols_constant_flag
&& ! EQ (newval
, symbol
)))
1012 return Fsignal (Qsetting_constant
, Fcons (symbol
, Qnil
));
1013 valcontents
= XSYMBOL (symbol
)->value
;
1015 if (BUFFER_OBJFWDP (valcontents
))
1017 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1018 register int mask
= XINT (*((Lisp_Object
*)
1019 (idx
+ (char *)&buffer_local_flags
)));
1020 if (mask
> 0 && ! bindflag
1021 && ! let_shadows_buffer_binding_p (symbol
))
1022 buf
->local_var_flags
|= mask
;
1025 else if (BUFFER_LOCAL_VALUEP (valcontents
)
1026 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1028 /* valcontents is actually a pointer to a struct resembling a cons,
1029 with contents something like:
1030 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE).
1032 BUFFER is the last buffer for which this symbol's value was
1035 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
1036 local_var_alist, that being the element whose car is this
1037 variable. Or it can be a pointer to the
1038 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not
1039 have an element in its alist for this variable (that is, if
1040 BUFFER sees the default value of this variable).
1042 If we want to examine or set the value and BUFFER is current,
1043 we just examine or set REALVALUE. If BUFFER is not current, we
1044 store the current REALVALUE value into CURRENT-ALIST-ELEMENT,
1045 then find the appropriate alist element for the buffer now
1046 current and set up CURRENT-ALIST-ELEMENT. Then we set
1047 REALVALUE out of that element, and store into BUFFER.
1049 If we are setting the variable and the current buffer does
1050 not have an alist entry for this variable, an alist entry is
1053 Note that REALVALUE can be a forwarding pointer. Each time
1054 it is examined or set, forwarding must be done. */
1056 /* What value are we caching right now? */
1057 current_alist_element
1058 = XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
1060 /* If the current buffer is not the buffer whose binding is
1061 currently cached, or if it's a Lisp_Buffer_Local_Value and
1062 we're looking at the default value, the cache is invalid; we
1063 need to write it out, and find the new CURRENT-ALIST-ELEMENT. */
1064 if (XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
1065 ? !EQ (selected_frame
, XBUFFER_LOCAL_VALUE (valcontents
)->frame
)
1066 : (buf
!= XBUFFER (XBUFFER_LOCAL_VALUE (valcontents
)->buffer
)
1067 || (BUFFER_LOCAL_VALUEP (valcontents
)
1068 && EQ (XCAR (current_alist_element
),
1069 current_alist_element
))))
1071 /* Write out the cached value for the old buffer; copy it
1072 back to its alist element. This works if the current
1073 buffer only sees the default value, too. */
1074 Fsetcdr (current_alist_element
,
1075 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
));
1077 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1078 tem1
= Fassq (symbol
, buf
->local_var_alist
);
1079 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 1;
1080 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 0;
1084 /* This buffer still sees the default value. */
1086 /* If the variable is a Lisp_Some_Buffer_Local_Value,
1087 or if this is `let' rather than `set',
1088 make CURRENT-ALIST-ELEMENT point to itself,
1089 indicating that we're seeing the default value.
1090 Likewise if the variable has been let-bound
1091 in the current buffer. */
1092 if (bindflag
|| SOME_BUFFER_LOCAL_VALUEP (valcontents
)
1093 || let_shadows_buffer_binding_p (symbol
))
1095 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
1097 if (XBUFFER_LOCAL_VALUE (valcontents
)->check_frame
)
1098 tem1
= Fassq (symbol
,
1099 XFRAME (selected_frame
)->param_alist
);
1102 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 1;
1104 tem1
= XBUFFER_LOCAL_VALUE (valcontents
)->cdr
;
1106 /* If it's a Lisp_Buffer_Local_Value, being set not bound,
1107 and we're not within a let that was made for this buffer,
1108 create a new buffer-local binding for the variable.
1109 That means, give this buffer a new assoc for a local value
1110 and set CURRENT-ALIST-ELEMENT to point to that. */
1113 tem1
= Fcons (symbol
, Fcdr (current_alist_element
));
1114 buf
->local_var_alist
1115 = Fcons (tem1
, buf
->local_var_alist
);
1119 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1120 XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
)
1123 /* Set BUFFER and FRAME for binding now loaded. */
1124 XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents
)->buffer
, buf
);
1125 XBUFFER_LOCAL_VALUE (valcontents
)->frame
= selected_frame
;
1127 valcontents
= XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
;
1130 /* If storing void (making the symbol void), forward only through
1131 buffer-local indicator, not through Lisp_Objfwd, etc. */
1133 store_symval_forwarding (symbol
, Qnil
, newval
);
1135 store_symval_forwarding (symbol
, valcontents
, newval
);
1140 /* Access or set a buffer-local symbol's default value. */
1142 /* Return the default value of SYMBOL, but don't check for voidness.
1143 Return Qunbound if it is void. */
1146 default_value (symbol
)
1149 register Lisp_Object valcontents
;
1151 CHECK_SYMBOL (symbol
, 0);
1152 valcontents
= XSYMBOL (symbol
)->value
;
1154 /* For a built-in buffer-local variable, get the default value
1155 rather than letting do_symval_forwarding get the current value. */
1156 if (BUFFER_OBJFWDP (valcontents
))
1158 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1160 if (XINT (*(Lisp_Object
*) (idx
+ (char *) &buffer_local_flags
)) != 0)
1161 return *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
1164 /* Handle user-created local variables. */
1165 if (BUFFER_LOCAL_VALUEP (valcontents
)
1166 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1168 /* If var is set up for a buffer that lacks a local value for it,
1169 the current value is nominally the default value.
1170 But the current value slot may be more up to date, since
1171 ordinary setq stores just that slot. So use that. */
1172 Lisp_Object current_alist_element
, alist_element_car
;
1173 current_alist_element
1174 = XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
1175 alist_element_car
= XCAR (current_alist_element
);
1176 if (EQ (alist_element_car
, current_alist_element
))
1177 return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
);
1179 return XCDR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
1181 /* For other variables, get the current value. */
1182 return do_symval_forwarding (valcontents
);
1185 DEFUN ("default-boundp", Fdefault_boundp
, Sdefault_boundp
, 1, 1, 0,
1186 "Return t if SYMBOL has a non-void default value.\n\
1187 This is the value that is seen in buffers that do not have their own values\n\
1188 for this variable.")
1192 register Lisp_Object value
;
1194 value
= default_value (symbol
);
1195 return (EQ (value
, Qunbound
) ? Qnil
: Qt
);
1198 DEFUN ("default-value", Fdefault_value
, Sdefault_value
, 1, 1, 0,
1199 "Return SYMBOL's default value.\n\
1200 This is the value that is seen in buffers that do not have their own values\n\
1201 for this variable. The default value is meaningful for variables with\n\
1202 local bindings in certain buffers.")
1206 register Lisp_Object value
;
1208 value
= default_value (symbol
);
1209 if (EQ (value
, Qunbound
))
1210 return Fsignal (Qvoid_variable
, Fcons (symbol
, Qnil
));
1214 DEFUN ("set-default", Fset_default
, Sset_default
, 2, 2, 0,
1215 "Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.\n\
1216 The default value is seen in buffers that do not have their own values\n\
1217 for this variable.")
1219 Lisp_Object symbol
, value
;
1221 register Lisp_Object valcontents
, current_alist_element
, alist_element_buffer
;
1223 CHECK_SYMBOL (symbol
, 0);
1224 valcontents
= XSYMBOL (symbol
)->value
;
1226 /* Handle variables like case-fold-search that have special slots
1227 in the buffer. Make them work apparently like Lisp_Buffer_Local_Value
1229 if (BUFFER_OBJFWDP (valcontents
))
1231 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1232 register struct buffer
*b
;
1233 register int mask
= XINT (*((Lisp_Object
*)
1234 (idx
+ (char *)&buffer_local_flags
)));
1236 *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
) = value
;
1238 /* If this variable is not always local in all buffers,
1239 set it in the buffers that don't nominally have a local value. */
1242 for (b
= all_buffers
; b
; b
= b
->next
)
1243 if (!(b
->local_var_flags
& mask
))
1244 *(Lisp_Object
*)(idx
+ (char *) b
) = value
;
1249 if (!BUFFER_LOCAL_VALUEP (valcontents
)
1250 && !SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1251 return Fset (symbol
, value
);
1253 /* Store new value into the DEFAULT-VALUE slot */
1254 XCDR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
) = value
;
1256 /* If that slot is current, we must set the REALVALUE slot too */
1257 current_alist_element
1258 = XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
1259 alist_element_buffer
= Fcar (current_alist_element
);
1260 if (EQ (alist_element_buffer
, current_alist_element
))
1261 store_symval_forwarding (symbol
, XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
,
1267 DEFUN ("setq-default", Fsetq_default
, Ssetq_default
, 2, UNEVALLED
, 0,
1268 "Set the default value of variable VAR to VALUE.\n\
1269 VAR, the variable name, is literal (not evaluated);\n\
1270 VALUE is an expression and it is evaluated.\n\
1271 The default value of a variable is seen in buffers\n\
1272 that do not have their own values for the variable.\n\
1274 More generally, you can use multiple variables and values, as in\n\
1275 (setq-default SYMBOL VALUE SYMBOL VALUE...)\n\
1276 This sets each SYMBOL's default value to the corresponding VALUE.\n\
1277 The VALUE for the Nth SYMBOL can refer to the new default values\n\
1282 register Lisp_Object args_left
;
1283 register Lisp_Object val
, symbol
;
1284 struct gcpro gcpro1
;
1294 val
= Feval (Fcar (Fcdr (args_left
)));
1295 symbol
= Fcar (args_left
);
1296 Fset_default (symbol
, val
);
1297 args_left
= Fcdr (Fcdr (args_left
));
1299 while (!NILP (args_left
));
1305 /* Lisp functions for creating and removing buffer-local variables. */
1307 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local
, Smake_variable_buffer_local
,
1308 1, 1, "vMake Variable Buffer Local: ",
1309 "Make VARIABLE have a separate value for each buffer.\n\
1310 At any time, the value for the current buffer is in effect.\n\
1311 There is also a default value which is seen in any buffer which has not yet\n\
1312 set its own value.\n\
1313 Using `set' or `setq' to set the variable causes it to have a separate value\n\
1314 for the current buffer if it was previously using the default value.\n\
1315 The function `default-value' gets the default value and `set-default' sets it.")
1317 register Lisp_Object variable
;
1319 register Lisp_Object tem
, valcontents
, newval
;
1321 CHECK_SYMBOL (variable
, 0);
1323 valcontents
= XSYMBOL (variable
)->value
;
1324 if (EQ (variable
, Qnil
) || EQ (variable
, Qt
) || KBOARD_OBJFWDP (valcontents
))
1325 error ("Symbol %s may not be buffer-local", XSYMBOL (variable
)->name
->data
);
1327 if (BUFFER_LOCAL_VALUEP (valcontents
) || BUFFER_OBJFWDP (valcontents
))
1329 if (SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1331 XMISCTYPE (XSYMBOL (variable
)->value
) = Lisp_Misc_Buffer_Local_Value
;
1334 if (EQ (valcontents
, Qunbound
))
1335 XSYMBOL (variable
)->value
= Qnil
;
1336 tem
= Fcons (Qnil
, Fsymbol_value (variable
));
1338 newval
= allocate_misc ();
1339 XMISCTYPE (newval
) = Lisp_Misc_Buffer_Local_Value
;
1340 XBUFFER_LOCAL_VALUE (newval
)->realvalue
= XSYMBOL (variable
)->value
;
1341 XBUFFER_LOCAL_VALUE (newval
)->buffer
= Fcurrent_buffer ();
1342 XBUFFER_LOCAL_VALUE (newval
)->frame
= Qnil
;
1343 XBUFFER_LOCAL_VALUE (newval
)->found_for_buffer
= 1;
1344 XBUFFER_LOCAL_VALUE (newval
)->found_for_frame
= 0;
1345 XBUFFER_LOCAL_VALUE (newval
)->check_frame
= 0;
1346 XBUFFER_LOCAL_VALUE (newval
)->cdr
= tem
;
1347 XSYMBOL (variable
)->value
= newval
;
1351 DEFUN ("make-local-variable", Fmake_local_variable
, Smake_local_variable
,
1352 1, 1, "vMake Local Variable: ",
1353 "Make VARIABLE have a separate value in the current buffer.\n\
1354 Other buffers will continue to share a common default value.\n\
1355 \(The buffer-local value of VARIABLE starts out as the same value\n\
1356 VARIABLE previously had. If VARIABLE was void, it remains void.\)\n\
1357 See also `make-variable-buffer-local'.\n\
1359 If the variable is already arranged to become local when set,\n\
1360 this function causes a local value to exist for this buffer,\n\
1361 just as setting the variable would do.\n\
1363 This function returns VARIABLE, and therefore\n\
1364 (set (make-local-variable 'VARIABLE) VALUE-EXP)\n\
1367 Do not use `make-local-variable' to make a hook variable buffer-local.\n\
1368 Use `make-local-hook' instead.")
1370 register Lisp_Object variable
;
1372 register Lisp_Object tem
, valcontents
;
1374 CHECK_SYMBOL (variable
, 0);
1376 valcontents
= XSYMBOL (variable
)->value
;
1377 if (EQ (variable
, Qnil
) || EQ (variable
, Qt
) || KBOARD_OBJFWDP (valcontents
))
1378 error ("Symbol %s may not be buffer-local", XSYMBOL (variable
)->name
->data
);
1380 if (BUFFER_LOCAL_VALUEP (valcontents
) || BUFFER_OBJFWDP (valcontents
))
1382 tem
= Fboundp (variable
);
1384 /* Make sure the symbol has a local value in this particular buffer,
1385 by setting it to the same value it already has. */
1386 Fset (variable
, (EQ (tem
, Qt
) ? Fsymbol_value (variable
) : Qunbound
));
1389 /* Make sure symbol is set up to hold per-buffer values */
1390 if (!SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1393 tem
= Fcons (Qnil
, do_symval_forwarding (valcontents
));
1395 newval
= allocate_misc ();
1396 XMISCTYPE (newval
) = Lisp_Misc_Some_Buffer_Local_Value
;
1397 XBUFFER_LOCAL_VALUE (newval
)->realvalue
= XSYMBOL (variable
)->value
;
1398 XBUFFER_LOCAL_VALUE (newval
)->buffer
= Qnil
;
1399 XBUFFER_LOCAL_VALUE (newval
)->frame
= Qnil
;
1400 XBUFFER_LOCAL_VALUE (newval
)->found_for_buffer
= 0;
1401 XBUFFER_LOCAL_VALUE (newval
)->found_for_frame
= 0;
1402 XBUFFER_LOCAL_VALUE (newval
)->check_frame
= 0;
1403 XBUFFER_LOCAL_VALUE (newval
)->cdr
= tem
;
1404 XSYMBOL (variable
)->value
= newval
;
1406 /* Make sure this buffer has its own value of symbol */
1407 tem
= Fassq (variable
, current_buffer
->local_var_alist
);
1410 /* Swap out any local binding for some other buffer, and make
1411 sure the current value is permanently recorded, if it's the
1413 find_symbol_value (variable
);
1415 current_buffer
->local_var_alist
1416 = Fcons (Fcons (variable
, XCDR (XBUFFER_LOCAL_VALUE (XSYMBOL (variable
)->value
)->cdr
)),
1417 current_buffer
->local_var_alist
);
1419 /* Make sure symbol does not think it is set up for this buffer;
1420 force it to look once again for this buffer's value */
1422 Lisp_Object
*pvalbuf
;
1424 valcontents
= XSYMBOL (variable
)->value
;
1426 pvalbuf
= &XBUFFER_LOCAL_VALUE (valcontents
)->buffer
;
1427 if (current_buffer
== XBUFFER (*pvalbuf
))
1429 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
1433 /* If the symbol forwards into a C variable, then swap in the
1434 variable for this buffer immediately. If C code modifies the
1435 variable before we swap in, then that new value will clobber the
1436 default value the next time we swap. */
1437 valcontents
= XBUFFER_LOCAL_VALUE (XSYMBOL (variable
)->value
)->realvalue
;
1438 if (INTFWDP (valcontents
) || BOOLFWDP (valcontents
) || OBJFWDP (valcontents
))
1439 swap_in_symval_forwarding (variable
, XSYMBOL (variable
)->value
);
1444 DEFUN ("kill-local-variable", Fkill_local_variable
, Skill_local_variable
,
1445 1, 1, "vKill Local Variable: ",
1446 "Make VARIABLE no longer have a separate value in the current buffer.\n\
1447 From now on the default value will apply in this buffer.")
1449 register Lisp_Object variable
;
1451 register Lisp_Object tem
, valcontents
;
1453 CHECK_SYMBOL (variable
, 0);
1455 valcontents
= XSYMBOL (variable
)->value
;
1457 if (BUFFER_OBJFWDP (valcontents
))
1459 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1460 register int mask
= XINT (*((Lisp_Object
*)
1461 (idx
+ (char *)&buffer_local_flags
)));
1465 *(Lisp_Object
*)(idx
+ (char *) current_buffer
)
1466 = *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
1467 current_buffer
->local_var_flags
&= ~mask
;
1472 if (!BUFFER_LOCAL_VALUEP (valcontents
)
1473 && !SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1476 /* Get rid of this buffer's alist element, if any */
1478 tem
= Fassq (variable
, current_buffer
->local_var_alist
);
1480 current_buffer
->local_var_alist
1481 = Fdelq (tem
, current_buffer
->local_var_alist
);
1483 /* If the symbol is set up for the current buffer, recompute its
1484 value. We have to do it now, or else forwarded objects won't
1487 Lisp_Object
*pvalbuf
;
1488 valcontents
= XSYMBOL (variable
)->value
;
1489 pvalbuf
= &XBUFFER_LOCAL_VALUE (valcontents
)->buffer
;
1490 if (current_buffer
== XBUFFER (*pvalbuf
))
1493 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
1494 find_symbol_value (variable
);
1501 /* Lisp functions for creating and removing buffer-local variables. */
1503 DEFUN ("make-variable-frame-local", Fmake_variable_frame_local
, Smake_variable_frame_local
,
1504 1, 1, "vMake Variable Frame Local: ",
1505 "Enable VARIABLE to have frame-local bindings.\n\
1506 When a frame-local binding exists in the current frame,\n\
1507 it is in effect whenever the current buffer has no buffer-local binding.\n\
1508 A frame-local binding is actual a frame parameter value;\n\
1509 thus, any given frame has a local binding for VARIABLE\n\
1510 if it has a value for the frame parameter named VARIABLE.\n\
1511 See `modify-frame-parameters'.")
1513 register Lisp_Object variable
;
1515 register Lisp_Object tem
, valcontents
, newval
;
1517 CHECK_SYMBOL (variable
, 0);
1519 valcontents
= XSYMBOL (variable
)->value
;
1520 if (EQ (variable
, Qnil
) || EQ (variable
, Qt
) || KBOARD_OBJFWDP (valcontents
)
1521 || BUFFER_OBJFWDP (valcontents
))
1522 error ("Symbol %s may not be frame-local", XSYMBOL (variable
)->name
->data
);
1524 if (BUFFER_LOCAL_VALUEP (valcontents
)
1525 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1528 if (EQ (valcontents
, Qunbound
))
1529 XSYMBOL (variable
)->value
= Qnil
;
1530 tem
= Fcons (Qnil
, Fsymbol_value (variable
));
1532 newval
= allocate_misc ();
1533 XMISCTYPE (newval
) = Lisp_Misc_Some_Buffer_Local_Value
;
1534 XBUFFER_LOCAL_VALUE (newval
)->realvalue
= XSYMBOL (variable
)->value
;
1535 XBUFFER_LOCAL_VALUE (newval
)->buffer
= Qnil
;
1536 XBUFFER_LOCAL_VALUE (newval
)->frame
= Qnil
;
1537 XBUFFER_LOCAL_VALUE (newval
)->found_for_buffer
= 0;
1538 XBUFFER_LOCAL_VALUE (newval
)->found_for_frame
= 0;
1539 XBUFFER_LOCAL_VALUE (newval
)->check_frame
= 1;
1540 XBUFFER_LOCAL_VALUE (newval
)->cdr
= tem
;
1541 XSYMBOL (variable
)->value
= newval
;
1545 DEFUN ("local-variable-p", Flocal_variable_p
, Slocal_variable_p
,
1547 "Non-nil if VARIABLE has a local binding in buffer BUFFER.\n\
1548 BUFFER defaults to the current buffer.")
1550 register Lisp_Object variable
, buffer
;
1552 Lisp_Object valcontents
;
1553 register struct buffer
*buf
;
1556 buf
= current_buffer
;
1559 CHECK_BUFFER (buffer
, 0);
1560 buf
= XBUFFER (buffer
);
1563 CHECK_SYMBOL (variable
, 0);
1565 valcontents
= XSYMBOL (variable
)->value
;
1566 if (BUFFER_LOCAL_VALUEP (valcontents
)
1567 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1569 Lisp_Object tail
, elt
;
1570 for (tail
= buf
->local_var_alist
; CONSP (tail
); tail
= XCDR (tail
))
1573 if (EQ (variable
, XCAR (elt
)))
1577 if (BUFFER_OBJFWDP (valcontents
))
1579 int offset
= XBUFFER_OBJFWD (valcontents
)->offset
;
1580 int mask
= XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
));
1581 if (mask
== -1 || (buf
->local_var_flags
& mask
))
1587 DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p
, Slocal_variable_if_set_p
,
1589 "Non-nil if VARIABLE will be local in buffer BUFFER if it is set there.\n\
1590 BUFFER defaults to the current buffer.")
1592 register Lisp_Object variable
, buffer
;
1594 Lisp_Object valcontents
;
1595 register struct buffer
*buf
;
1598 buf
= current_buffer
;
1601 CHECK_BUFFER (buffer
, 0);
1602 buf
= XBUFFER (buffer
);
1605 CHECK_SYMBOL (variable
, 0);
1607 valcontents
= XSYMBOL (variable
)->value
;
1609 /* This means that make-variable-buffer-local was done. */
1610 if (BUFFER_LOCAL_VALUEP (valcontents
))
1612 /* All these slots become local if they are set. */
1613 if (BUFFER_OBJFWDP (valcontents
))
1615 if (SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1617 Lisp_Object tail
, elt
;
1618 for (tail
= buf
->local_var_alist
; CONSP (tail
); tail
= XCDR (tail
))
1621 if (EQ (variable
, XCAR (elt
)))
1628 /* Find the function at the end of a chain of symbol function indirections. */
1630 /* If OBJECT is a symbol, find the end of its function chain and
1631 return the value found there. If OBJECT is not a symbol, just
1632 return it. If there is a cycle in the function chain, signal a
1633 cyclic-function-indirection error.
1635 This is like Findirect_function, except that it doesn't signal an
1636 error if the chain ends up unbound. */
1638 indirect_function (object
)
1639 register Lisp_Object object
;
1641 Lisp_Object tortoise
, hare
;
1643 hare
= tortoise
= object
;
1647 if (!SYMBOLP (hare
) || EQ (hare
, Qunbound
))
1649 hare
= XSYMBOL (hare
)->function
;
1650 if (!SYMBOLP (hare
) || EQ (hare
, Qunbound
))
1652 hare
= XSYMBOL (hare
)->function
;
1654 tortoise
= XSYMBOL (tortoise
)->function
;
1656 if (EQ (hare
, tortoise
))
1657 Fsignal (Qcyclic_function_indirection
, Fcons (object
, Qnil
));
1663 DEFUN ("indirect-function", Findirect_function
, Sindirect_function
, 1, 1, 0,
1664 "Return the function at the end of OBJECT's function chain.\n\
1665 If OBJECT is a symbol, follow all function indirections and return the final\n\
1666 function binding.\n\
1667 If OBJECT is not a symbol, just return it.\n\
1668 Signal a void-function error if the final symbol is unbound.\n\
1669 Signal a cyclic-function-indirection error if there is a loop in the\n\
1670 function chain of symbols.")
1672 register Lisp_Object object
;
1676 result
= indirect_function (object
);
1678 if (EQ (result
, Qunbound
))
1679 return Fsignal (Qvoid_function
, Fcons (object
, Qnil
));
1683 /* Extract and set vector and string elements */
1685 DEFUN ("aref", Faref
, Saref
, 2, 2, 0,
1686 "Return the element of ARRAY at index IDX.\n\
1687 ARRAY may be a vector, a string, a char-table, a bool-vector,\n\
1688 or a byte-code object. IDX starts at 0.")
1690 register Lisp_Object array
;
1693 register int idxval
;
1695 CHECK_NUMBER (idx
, 1);
1696 idxval
= XINT (idx
);
1697 if (STRINGP (array
))
1701 if (idxval
< 0 || idxval
>= XSTRING (array
)->size
)
1702 args_out_of_range (array
, idx
);
1703 if (! STRING_MULTIBYTE (array
))
1704 return make_number ((unsigned char) XSTRING (array
)->data
[idxval
]);
1705 idxval_byte
= string_char_to_byte (array
, idxval
);
1707 c
= STRING_CHAR (&XSTRING (array
)->data
[idxval_byte
],
1708 STRING_BYTES (XSTRING (array
)) - idxval_byte
);
1709 return make_number (c
);
1711 else if (BOOL_VECTOR_P (array
))
1715 if (idxval
< 0 || idxval
>= XBOOL_VECTOR (array
)->size
)
1716 args_out_of_range (array
, idx
);
1718 val
= (unsigned char) XBOOL_VECTOR (array
)->data
[idxval
/ BITS_PER_CHAR
];
1719 return (val
& (1 << (idxval
% BITS_PER_CHAR
)) ? Qt
: Qnil
);
1721 else if (CHAR_TABLE_P (array
))
1726 args_out_of_range (array
, idx
);
1727 if (idxval
< CHAR_TABLE_ORDINARY_SLOTS
)
1729 /* For ASCII and 8-bit European characters, the element is
1730 stored in the top table. */
1731 val
= XCHAR_TABLE (array
)->contents
[idxval
];
1733 val
= XCHAR_TABLE (array
)->defalt
;
1734 while (NILP (val
)) /* Follow parents until we find some value. */
1736 array
= XCHAR_TABLE (array
)->parent
;
1739 val
= XCHAR_TABLE (array
)->contents
[idxval
];
1741 val
= XCHAR_TABLE (array
)->defalt
;
1748 Lisp_Object sub_table
;
1750 SPLIT_NON_ASCII_CHAR (idxval
, code
[0], code
[1], code
[2]);
1751 if (code
[1] < 32) code
[1] = -1;
1752 else if (code
[2] < 32) code
[2] = -1;
1754 /* Here, the possible range of CODE[0] (== charset ID) is
1755 128..MAX_CHARSET. Since the top level char table contains
1756 data for multibyte characters after 256th element, we must
1757 increment CODE[0] by 128 to get a correct index. */
1759 code
[3] = -1; /* anchor */
1761 try_parent_char_table
:
1763 for (i
= 0; code
[i
] >= 0; i
++)
1765 val
= XCHAR_TABLE (sub_table
)->contents
[code
[i
]];
1766 if (SUB_CHAR_TABLE_P (val
))
1771 val
= XCHAR_TABLE (sub_table
)->defalt
;
1774 array
= XCHAR_TABLE (array
)->parent
;
1776 goto try_parent_char_table
;
1781 /* Here, VAL is a sub char table. We try the default value
1783 val
= XCHAR_TABLE (val
)->defalt
;
1786 array
= XCHAR_TABLE (array
)->parent
;
1788 goto try_parent_char_table
;
1796 if (VECTORP (array
))
1797 size
= XVECTOR (array
)->size
;
1798 else if (COMPILEDP (array
))
1799 size
= XVECTOR (array
)->size
& PSEUDOVECTOR_SIZE_MASK
;
1801 wrong_type_argument (Qarrayp
, array
);
1803 if (idxval
< 0 || idxval
>= size
)
1804 args_out_of_range (array
, idx
);
1805 return XVECTOR (array
)->contents
[idxval
];
1809 DEFUN ("aset", Faset
, Saset
, 3, 3, 0,
1810 "Store into the element of ARRAY at index IDX the value NEWELT.\n\
1811 ARRAY may be a vector, a string, a char-table or a bool-vector.\n\
1813 (array
, idx
, newelt
)
1814 register Lisp_Object array
;
1815 Lisp_Object idx
, newelt
;
1817 register int idxval
;
1819 CHECK_NUMBER (idx
, 1);
1820 idxval
= XINT (idx
);
1821 if (!VECTORP (array
) && !STRINGP (array
) && !BOOL_VECTOR_P (array
)
1822 && ! CHAR_TABLE_P (array
))
1823 array
= wrong_type_argument (Qarrayp
, array
);
1824 CHECK_IMPURE (array
);
1826 if (VECTORP (array
))
1828 if (idxval
< 0 || idxval
>= XVECTOR (array
)->size
)
1829 args_out_of_range (array
, idx
);
1830 XVECTOR (array
)->contents
[idxval
] = newelt
;
1832 else if (BOOL_VECTOR_P (array
))
1836 if (idxval
< 0 || idxval
>= XBOOL_VECTOR (array
)->size
)
1837 args_out_of_range (array
, idx
);
1839 val
= (unsigned char) XBOOL_VECTOR (array
)->data
[idxval
/ BITS_PER_CHAR
];
1841 if (! NILP (newelt
))
1842 val
|= 1 << (idxval
% BITS_PER_CHAR
);
1844 val
&= ~(1 << (idxval
% BITS_PER_CHAR
));
1845 XBOOL_VECTOR (array
)->data
[idxval
/ BITS_PER_CHAR
] = val
;
1847 else if (CHAR_TABLE_P (array
))
1850 args_out_of_range (array
, idx
);
1851 if (idxval
< CHAR_TABLE_ORDINARY_SLOTS
)
1852 XCHAR_TABLE (array
)->contents
[idxval
] = newelt
;
1858 SPLIT_NON_ASCII_CHAR (idxval
, code
[0], code
[1], code
[2]);
1859 if (code
[1] < 32) code
[1] = -1;
1860 else if (code
[2] < 32) code
[2] = -1;
1862 /* See the comment of the corresponding part in Faref. */
1864 code
[3] = -1; /* anchor */
1865 for (i
= 0; code
[i
+ 1] >= 0; i
++)
1867 val
= XCHAR_TABLE (array
)->contents
[code
[i
]];
1868 if (SUB_CHAR_TABLE_P (val
))
1874 /* VAL is a leaf. Create a sub char table with the
1875 default value VAL or XCHAR_TABLE (array)->defalt
1876 and look into it. */
1878 temp
= make_sub_char_table (NILP (val
)
1879 ? XCHAR_TABLE (array
)->defalt
1881 XCHAR_TABLE (array
)->contents
[code
[i
]] = temp
;
1885 XCHAR_TABLE (array
)->contents
[code
[i
]] = newelt
;
1888 else if (STRING_MULTIBYTE (array
))
1890 int idxval_byte
, new_len
, actual_len
;
1892 unsigned char *p
, workbuf
[MAX_MULTIBYTE_LENGTH
], *str
= workbuf
;
1894 if (idxval
< 0 || idxval
>= XSTRING (array
)->size
)
1895 args_out_of_range (array
, idx
);
1897 idxval_byte
= string_char_to_byte (array
, idxval
);
1898 p
= &XSTRING (array
)->data
[idxval_byte
];
1900 actual_len
= MULTIBYTE_FORM_LENGTH (p
, STRING_BYTES (XSTRING (array
)));
1901 CHECK_NUMBER (newelt
, 2);
1902 new_len
= CHAR_STRING (XINT (newelt
), str
);
1903 if (actual_len
!= new_len
)
1904 error ("Attempt to change byte length of a string");
1906 /* We can't accept a change causing byte combining. */
1907 if (!ASCII_BYTE_P (*str
)
1908 && ((idxval
> 0 && !CHAR_HEAD_P (*str
)
1909 && (prev_byte
= string_char_to_byte (array
, idxval
- 1),
1910 BYTES_BY_CHAR_HEAD (XSTRING (array
)->data
[prev_byte
])
1911 > idxval_byte
- prev_byte
))
1912 || (idxval
< XSTRING (array
)->size
- 1
1913 && !CHAR_HEAD_P (p
[actual_len
])
1914 && new_len
< BYTES_BY_CHAR_HEAD (*str
))))
1915 error ("Attempt to change char length of a string");
1921 if (idxval
< 0 || idxval
>= XSTRING (array
)->size
)
1922 args_out_of_range (array
, idx
);
1923 CHECK_NUMBER (newelt
, 2);
1924 XSTRING (array
)->data
[idxval
] = XINT (newelt
);
1930 /* Arithmetic functions */
1932 enum comparison
{ equal
, notequal
, less
, grtr
, less_or_equal
, grtr_or_equal
};
1935 arithcompare (num1
, num2
, comparison
)
1936 Lisp_Object num1
, num2
;
1937 enum comparison comparison
;
1942 #ifdef LISP_FLOAT_TYPE
1943 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1
, 0);
1944 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2
, 0);
1946 if (FLOATP (num1
) || FLOATP (num2
))
1949 f1
= (FLOATP (num1
)) ? XFLOAT_DATA (num1
) : XINT (num1
);
1950 f2
= (FLOATP (num2
)) ? XFLOAT_DATA (num2
) : XINT (num2
);
1953 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1954 CHECK_NUMBER_COERCE_MARKER (num2
, 0);
1955 #endif /* LISP_FLOAT_TYPE */
1960 if (floatp
? f1
== f2
: XINT (num1
) == XINT (num2
))
1965 if (floatp
? f1
!= f2
: XINT (num1
) != XINT (num2
))
1970 if (floatp
? f1
< f2
: XINT (num1
) < XINT (num2
))
1975 if (floatp
? f1
<= f2
: XINT (num1
) <= XINT (num2
))
1980 if (floatp
? f1
> f2
: XINT (num1
) > XINT (num2
))
1985 if (floatp
? f1
>= f2
: XINT (num1
) >= XINT (num2
))
1994 DEFUN ("=", Feqlsign
, Seqlsign
, 2, 2, 0,
1995 "Return t if two args, both numbers or markers, are equal.")
1997 register Lisp_Object num1
, num2
;
1999 return arithcompare (num1
, num2
, equal
);
2002 DEFUN ("<", Flss
, Slss
, 2, 2, 0,
2003 "Return t if first arg is less than second arg. Both must be numbers or markers.")
2005 register Lisp_Object num1
, num2
;
2007 return arithcompare (num1
, num2
, less
);
2010 DEFUN (">", Fgtr
, Sgtr
, 2, 2, 0,
2011 "Return t if first arg is greater than second arg. Both must be numbers or markers.")
2013 register Lisp_Object num1
, num2
;
2015 return arithcompare (num1
, num2
, grtr
);
2018 DEFUN ("<=", Fleq
, Sleq
, 2, 2, 0,
2019 "Return t if first arg is less than or equal to second arg.\n\
2020 Both must be numbers or markers.")
2022 register Lisp_Object num1
, num2
;
2024 return arithcompare (num1
, num2
, less_or_equal
);
2027 DEFUN (">=", Fgeq
, Sgeq
, 2, 2, 0,
2028 "Return t if first arg is greater than or equal to second arg.\n\
2029 Both must be numbers or markers.")
2031 register Lisp_Object num1
, num2
;
2033 return arithcompare (num1
, num2
, grtr_or_equal
);
2036 DEFUN ("/=", Fneq
, Sneq
, 2, 2, 0,
2037 "Return t if first arg is not equal to second arg. Both must be numbers or markers.")
2039 register Lisp_Object num1
, num2
;
2041 return arithcompare (num1
, num2
, notequal
);
2044 DEFUN ("zerop", Fzerop
, Szerop
, 1, 1, 0, "Return t if NUMBER is zero.")
2046 register Lisp_Object number
;
2048 #ifdef LISP_FLOAT_TYPE
2049 CHECK_NUMBER_OR_FLOAT (number
, 0);
2051 if (FLOATP (number
))
2053 if (XFLOAT_DATA (number
) == 0.0)
2058 CHECK_NUMBER (number
, 0);
2059 #endif /* LISP_FLOAT_TYPE */
2066 /* Convert between long values and pairs of Lisp integers. */
2072 unsigned int top
= i
>> 16;
2073 unsigned int bot
= i
& 0xFFFF;
2075 return make_number (bot
);
2076 if (top
== (unsigned long)-1 >> 16)
2077 return Fcons (make_number (-1), make_number (bot
));
2078 return Fcons (make_number (top
), make_number (bot
));
2085 Lisp_Object top
, bot
;
2092 return ((XINT (top
) << 16) | XINT (bot
));
2095 DEFUN ("number-to-string", Fnumber_to_string
, Snumber_to_string
, 1, 1, 0,
2096 "Convert NUMBER to a string by printing it in decimal.\n\
2097 Uses a minus sign if negative.\n\
2098 NUMBER may be an integer or a floating point number.")
2102 char buffer
[VALBITS
];
2104 #ifndef LISP_FLOAT_TYPE
2105 CHECK_NUMBER (number
, 0);
2107 CHECK_NUMBER_OR_FLOAT (number
, 0);
2109 if (FLOATP (number
))
2111 char pigbuf
[350]; /* see comments in float_to_string */
2113 float_to_string (pigbuf
, XFLOAT_DATA (number
));
2114 return build_string (pigbuf
);
2116 #endif /* LISP_FLOAT_TYPE */
2118 if (sizeof (int) == sizeof (EMACS_INT
))
2119 sprintf (buffer
, "%d", XINT (number
));
2120 else if (sizeof (long) == sizeof (EMACS_INT
))
2121 sprintf (buffer
, "%ld", (long) XINT (number
));
2124 return build_string (buffer
);
2128 digit_to_number (character
, base
)
2129 int character
, base
;
2133 if (character
>= '0' && character
<= '9')
2134 digit
= character
- '0';
2135 else if (character
>= 'a' && character
<= 'z')
2136 digit
= character
- 'a' + 10;
2137 else if (character
>= 'A' && character
<= 'Z')
2138 digit
= character
- 'A' + 10;
2148 DEFUN ("string-to-number", Fstring_to_number
, Sstring_to_number
, 1, 2, 0,
2149 "Convert STRING to a number by parsing it as a decimal number.\n\
2150 This parses both integers and floating point numbers.\n\
2151 It ignores leading spaces and tabs.\n\
2153 If BASE, interpret STRING as a number in that base. If BASE isn't\n\
2154 present, base 10 is used. BASE must be between 2 and 16 (inclusive).\n\
2155 If the base used is not 10, floating point is not recognized.")
2157 register Lisp_Object string
, base
;
2159 register unsigned char *p
;
2160 register int b
, v
= 0;
2163 CHECK_STRING (string
, 0);
2169 CHECK_NUMBER (base
, 1);
2171 if (b
< 2 || b
> 16)
2172 Fsignal (Qargs_out_of_range
, Fcons (base
, Qnil
));
2175 p
= XSTRING (string
)->data
;
2177 /* Skip any whitespace at the front of the number. Some versions of
2178 atoi do this anyway, so we might as well make Emacs lisp consistent. */
2179 while (*p
== ' ' || *p
== '\t')
2190 #ifdef LISP_FLOAT_TYPE
2191 if (isfloat_string (p
) && b
== 10)
2192 return make_float (negative
* atof (p
));
2193 #endif /* LISP_FLOAT_TYPE */
2197 int digit
= digit_to_number (*p
++, b
);
2203 return make_number (negative
* v
);
2208 { Aadd
, Asub
, Amult
, Adiv
, Alogand
, Alogior
, Alogxor
, Amax
, Amin
};
2210 extern Lisp_Object
float_arith_driver ();
2211 extern Lisp_Object
fmod_float ();
2214 arith_driver (code
, nargs
, args
)
2217 register Lisp_Object
*args
;
2219 register Lisp_Object val
;
2220 register int argnum
;
2221 register EMACS_INT accum
;
2222 register EMACS_INT next
;
2224 switch (SWITCH_ENUM_CAST (code
))
2237 for (argnum
= 0; argnum
< nargs
; argnum
++)
2239 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
2240 #ifdef LISP_FLOAT_TYPE
2241 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
2243 if (FLOATP (val
)) /* time to do serious math */
2244 return (float_arith_driver ((double) accum
, argnum
, code
,
2247 CHECK_NUMBER_COERCE_MARKER (val
, argnum
);
2248 #endif /* LISP_FLOAT_TYPE */
2249 args
[argnum
] = val
; /* runs into a compiler bug. */
2250 next
= XINT (args
[argnum
]);
2251 switch (SWITCH_ENUM_CAST (code
))
2253 case Aadd
: accum
+= next
; break;
2255 accum
= argnum
? accum
- next
: nargs
== 1 ? - next
: next
;
2257 case Amult
: accum
*= next
; break;
2259 if (!argnum
) accum
= next
;
2263 Fsignal (Qarith_error
, Qnil
);
2267 case Alogand
: accum
&= next
; break;
2268 case Alogior
: accum
|= next
; break;
2269 case Alogxor
: accum
^= next
; break;
2270 case Amax
: if (!argnum
|| next
> accum
) accum
= next
; break;
2271 case Amin
: if (!argnum
|| next
< accum
) accum
= next
; break;
2275 XSETINT (val
, accum
);
2280 #define isnan(x) ((x) != (x))
2282 #ifdef LISP_FLOAT_TYPE
2285 float_arith_driver (accum
, argnum
, code
, nargs
, args
)
2287 register int argnum
;
2290 register Lisp_Object
*args
;
2292 register Lisp_Object val
;
2295 for (; argnum
< nargs
; argnum
++)
2297 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
2298 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
2302 next
= XFLOAT_DATA (val
);
2306 args
[argnum
] = val
; /* runs into a compiler bug. */
2307 next
= XINT (args
[argnum
]);
2309 switch (SWITCH_ENUM_CAST (code
))
2315 accum
= argnum
? accum
- next
: nargs
== 1 ? - next
: next
;
2325 if (! IEEE_FLOATING_POINT
&& next
== 0)
2326 Fsignal (Qarith_error
, Qnil
);
2333 return wrong_type_argument (Qinteger_or_marker_p
, val
);
2335 if (!argnum
|| isnan (next
) || next
> accum
)
2339 if (!argnum
|| isnan (next
) || next
< accum
)
2345 return make_float (accum
);
2347 #endif /* LISP_FLOAT_TYPE */
2349 DEFUN ("+", Fplus
, Splus
, 0, MANY
, 0,
2350 "Return sum of any number of arguments, which are numbers or markers.")
2355 return arith_driver (Aadd
, nargs
, args
);
2358 DEFUN ("-", Fminus
, Sminus
, 0, MANY
, 0,
2359 "Negate number or subtract numbers or markers.\n\
2360 With one arg, negates it. With more than one arg,\n\
2361 subtracts all but the first from the first.")
2366 return arith_driver (Asub
, nargs
, args
);
2369 DEFUN ("*", Ftimes
, Stimes
, 0, MANY
, 0,
2370 "Returns product of any number of arguments, which are numbers or markers.")
2375 return arith_driver (Amult
, nargs
, args
);
2378 DEFUN ("/", Fquo
, Squo
, 2, MANY
, 0,
2379 "Returns first argument divided by all the remaining arguments.\n\
2380 The arguments must be numbers or markers.")
2385 return arith_driver (Adiv
, nargs
, args
);
2388 DEFUN ("%", Frem
, Srem
, 2, 2, 0,
2389 "Returns remainder of X divided by Y.\n\
2390 Both must be integers or markers.")
2392 register Lisp_Object x
, y
;
2396 CHECK_NUMBER_COERCE_MARKER (x
, 0);
2397 CHECK_NUMBER_COERCE_MARKER (y
, 1);
2399 if (XFASTINT (y
) == 0)
2400 Fsignal (Qarith_error
, Qnil
);
2402 XSETINT (val
, XINT (x
) % XINT (y
));
2416 /* If the magnitude of the result exceeds that of the divisor, or
2417 the sign of the result does not agree with that of the dividend,
2418 iterate with the reduced value. This does not yield a
2419 particularly accurate result, but at least it will be in the
2420 range promised by fmod. */
2422 r
-= f2
* floor (r
/ f2
);
2423 while (f2
<= (r
< 0 ? -r
: r
) || ((r
< 0) != (f1
< 0) && ! isnan (r
)));
2427 #endif /* ! HAVE_FMOD */
2429 DEFUN ("mod", Fmod
, Smod
, 2, 2, 0,
2430 "Returns X modulo Y.\n\
2431 The result falls between zero (inclusive) and Y (exclusive).\n\
2432 Both X and Y must be numbers or markers.")
2434 register Lisp_Object x
, y
;
2439 #ifdef LISP_FLOAT_TYPE
2440 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (x
, 0);
2441 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (y
, 1);
2443 if (FLOATP (x
) || FLOATP (y
))
2444 return fmod_float (x
, y
);
2446 #else /* not LISP_FLOAT_TYPE */
2447 CHECK_NUMBER_COERCE_MARKER (x
, 0);
2448 CHECK_NUMBER_COERCE_MARKER (y
, 1);
2449 #endif /* not LISP_FLOAT_TYPE */
2455 Fsignal (Qarith_error
, Qnil
);
2459 /* If the "remainder" comes out with the wrong sign, fix it. */
2460 if (i2
< 0 ? i1
> 0 : i1
< 0)
2467 DEFUN ("max", Fmax
, Smax
, 1, MANY
, 0,
2468 "Return largest of all the arguments (which must be numbers or markers).\n\
2469 The value is always a number; markers are converted to numbers.")
2474 return arith_driver (Amax
, nargs
, args
);
2477 DEFUN ("min", Fmin
, Smin
, 1, MANY
, 0,
2478 "Return smallest of all the arguments (which must be numbers or markers).\n\
2479 The value is always a number; markers are converted to numbers.")
2484 return arith_driver (Amin
, nargs
, args
);
2487 DEFUN ("logand", Flogand
, Slogand
, 0, MANY
, 0,
2488 "Return bitwise-and of all the arguments.\n\
2489 Arguments may be integers, or markers converted to integers.")
2494 return arith_driver (Alogand
, nargs
, args
);
2497 DEFUN ("logior", Flogior
, Slogior
, 0, MANY
, 0,
2498 "Return bitwise-or of all the arguments.\n\
2499 Arguments may be integers, or markers converted to integers.")
2504 return arith_driver (Alogior
, nargs
, args
);
2507 DEFUN ("logxor", Flogxor
, Slogxor
, 0, MANY
, 0,
2508 "Return bitwise-exclusive-or of all the arguments.\n\
2509 Arguments may be integers, or markers converted to integers.")
2514 return arith_driver (Alogxor
, nargs
, args
);
2517 DEFUN ("ash", Fash
, Sash
, 2, 2, 0,
2518 "Return VALUE with its bits shifted left by COUNT.\n\
2519 If COUNT is negative, shifting is actually to the right.\n\
2520 In this case, the sign bit is duplicated.")
2522 register Lisp_Object value
, count
;
2524 register Lisp_Object val
;
2526 CHECK_NUMBER (value
, 0);
2527 CHECK_NUMBER (count
, 1);
2529 if (XINT (count
) >= BITS_PER_EMACS_INT
)
2531 else if (XINT (count
) > 0)
2532 XSETINT (val
, XINT (value
) << XFASTINT (count
));
2533 else if (XINT (count
) <= -BITS_PER_EMACS_INT
)
2534 XSETINT (val
, XINT (value
) < 0 ? -1 : 0);
2536 XSETINT (val
, XINT (value
) >> -XINT (count
));
2540 DEFUN ("lsh", Flsh
, Slsh
, 2, 2, 0,
2541 "Return VALUE with its bits shifted left by COUNT.\n\
2542 If COUNT is negative, shifting is actually to the right.\n\
2543 In this case, zeros are shifted in on the left.")
2545 register Lisp_Object value
, count
;
2547 register Lisp_Object val
;
2549 CHECK_NUMBER (value
, 0);
2550 CHECK_NUMBER (count
, 1);
2552 if (XINT (count
) >= BITS_PER_EMACS_INT
)
2554 else if (XINT (count
) > 0)
2555 XSETINT (val
, (EMACS_UINT
) XUINT (value
) << XFASTINT (count
));
2556 else if (XINT (count
) <= -BITS_PER_EMACS_INT
)
2559 XSETINT (val
, (EMACS_UINT
) XUINT (value
) >> -XINT (count
));
2563 DEFUN ("1+", Fadd1
, Sadd1
, 1, 1, 0,
2564 "Return NUMBER plus one. NUMBER may be a number or a marker.\n\
2565 Markers are converted to integers.")
2567 register Lisp_Object number
;
2569 #ifdef LISP_FLOAT_TYPE
2570 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number
, 0);
2572 if (FLOATP (number
))
2573 return (make_float (1.0 + XFLOAT_DATA (number
)));
2575 CHECK_NUMBER_COERCE_MARKER (number
, 0);
2576 #endif /* LISP_FLOAT_TYPE */
2578 XSETINT (number
, XINT (number
) + 1);
2582 DEFUN ("1-", Fsub1
, Ssub1
, 1, 1, 0,
2583 "Return NUMBER minus one. NUMBER may be a number or a marker.\n\
2584 Markers are converted to integers.")
2586 register Lisp_Object number
;
2588 #ifdef LISP_FLOAT_TYPE
2589 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number
, 0);
2591 if (FLOATP (number
))
2592 return (make_float (-1.0 + XFLOAT_DATA (number
)));
2594 CHECK_NUMBER_COERCE_MARKER (number
, 0);
2595 #endif /* LISP_FLOAT_TYPE */
2597 XSETINT (number
, XINT (number
) - 1);
2601 DEFUN ("lognot", Flognot
, Slognot
, 1, 1, 0,
2602 "Return the bitwise complement of NUMBER. NUMBER must be an integer.")
2604 register Lisp_Object number
;
2606 CHECK_NUMBER (number
, 0);
2607 XSETINT (number
, ~XINT (number
));
2614 Lisp_Object error_tail
, arith_tail
;
2616 Qquote
= intern ("quote");
2617 Qlambda
= intern ("lambda");
2618 Qsubr
= intern ("subr");
2619 Qerror_conditions
= intern ("error-conditions");
2620 Qerror_message
= intern ("error-message");
2621 Qtop_level
= intern ("top-level");
2623 Qerror
= intern ("error");
2624 Qquit
= intern ("quit");
2625 Qwrong_type_argument
= intern ("wrong-type-argument");
2626 Qargs_out_of_range
= intern ("args-out-of-range");
2627 Qvoid_function
= intern ("void-function");
2628 Qcyclic_function_indirection
= intern ("cyclic-function-indirection");
2629 Qvoid_variable
= intern ("void-variable");
2630 Qsetting_constant
= intern ("setting-constant");
2631 Qinvalid_read_syntax
= intern ("invalid-read-syntax");
2633 Qinvalid_function
= intern ("invalid-function");
2634 Qwrong_number_of_arguments
= intern ("wrong-number-of-arguments");
2635 Qno_catch
= intern ("no-catch");
2636 Qend_of_file
= intern ("end-of-file");
2637 Qarith_error
= intern ("arith-error");
2638 Qbeginning_of_buffer
= intern ("beginning-of-buffer");
2639 Qend_of_buffer
= intern ("end-of-buffer");
2640 Qbuffer_read_only
= intern ("buffer-read-only");
2641 Qtext_read_only
= intern ("text-read-only");
2642 Qmark_inactive
= intern ("mark-inactive");
2644 Qlistp
= intern ("listp");
2645 Qconsp
= intern ("consp");
2646 Qsymbolp
= intern ("symbolp");
2647 Qkeywordp
= intern ("keywordp");
2648 Qintegerp
= intern ("integerp");
2649 Qnatnump
= intern ("natnump");
2650 Qwholenump
= intern ("wholenump");
2651 Qstringp
= intern ("stringp");
2652 Qarrayp
= intern ("arrayp");
2653 Qsequencep
= intern ("sequencep");
2654 Qbufferp
= intern ("bufferp");
2655 Qvectorp
= intern ("vectorp");
2656 Qchar_or_string_p
= intern ("char-or-string-p");
2657 Qmarkerp
= intern ("markerp");
2658 Qbuffer_or_string_p
= intern ("buffer-or-string-p");
2659 Qinteger_or_marker_p
= intern ("integer-or-marker-p");
2660 Qboundp
= intern ("boundp");
2661 Qfboundp
= intern ("fboundp");
2663 #ifdef LISP_FLOAT_TYPE
2664 Qfloatp
= intern ("floatp");
2665 Qnumberp
= intern ("numberp");
2666 Qnumber_or_marker_p
= intern ("number-or-marker-p");
2667 #endif /* LISP_FLOAT_TYPE */
2669 Qchar_table_p
= intern ("char-table-p");
2670 Qvector_or_char_table_p
= intern ("vector-or-char-table-p");
2672 Qcdr
= intern ("cdr");
2674 /* Handle automatic advice activation */
2675 Qad_advice_info
= intern ("ad-advice-info");
2676 Qad_activate_internal
= intern ("ad-activate-internal");
2678 error_tail
= Fcons (Qerror
, Qnil
);
2680 /* ERROR is used as a signaler for random errors for which nothing else is right */
2682 Fput (Qerror
, Qerror_conditions
,
2684 Fput (Qerror
, Qerror_message
,
2685 build_string ("error"));
2687 Fput (Qquit
, Qerror_conditions
,
2688 Fcons (Qquit
, Qnil
));
2689 Fput (Qquit
, Qerror_message
,
2690 build_string ("Quit"));
2692 Fput (Qwrong_type_argument
, Qerror_conditions
,
2693 Fcons (Qwrong_type_argument
, error_tail
));
2694 Fput (Qwrong_type_argument
, Qerror_message
,
2695 build_string ("Wrong type argument"));
2697 Fput (Qargs_out_of_range
, Qerror_conditions
,
2698 Fcons (Qargs_out_of_range
, error_tail
));
2699 Fput (Qargs_out_of_range
, Qerror_message
,
2700 build_string ("Args out of range"));
2702 Fput (Qvoid_function
, Qerror_conditions
,
2703 Fcons (Qvoid_function
, error_tail
));
2704 Fput (Qvoid_function
, Qerror_message
,
2705 build_string ("Symbol's function definition is void"));
2707 Fput (Qcyclic_function_indirection
, Qerror_conditions
,
2708 Fcons (Qcyclic_function_indirection
, error_tail
));
2709 Fput (Qcyclic_function_indirection
, Qerror_message
,
2710 build_string ("Symbol's chain of function indirections contains a loop"));
2712 Fput (Qvoid_variable
, Qerror_conditions
,
2713 Fcons (Qvoid_variable
, error_tail
));
2714 Fput (Qvoid_variable
, Qerror_message
,
2715 build_string ("Symbol's value as variable is void"));
2717 Fput (Qsetting_constant
, Qerror_conditions
,
2718 Fcons (Qsetting_constant
, error_tail
));
2719 Fput (Qsetting_constant
, Qerror_message
,
2720 build_string ("Attempt to set a constant symbol"));
2722 Fput (Qinvalid_read_syntax
, Qerror_conditions
,
2723 Fcons (Qinvalid_read_syntax
, error_tail
));
2724 Fput (Qinvalid_read_syntax
, Qerror_message
,
2725 build_string ("Invalid read syntax"));
2727 Fput (Qinvalid_function
, Qerror_conditions
,
2728 Fcons (Qinvalid_function
, error_tail
));
2729 Fput (Qinvalid_function
, Qerror_message
,
2730 build_string ("Invalid function"));
2732 Fput (Qwrong_number_of_arguments
, Qerror_conditions
,
2733 Fcons (Qwrong_number_of_arguments
, error_tail
));
2734 Fput (Qwrong_number_of_arguments
, Qerror_message
,
2735 build_string ("Wrong number of arguments"));
2737 Fput (Qno_catch
, Qerror_conditions
,
2738 Fcons (Qno_catch
, error_tail
));
2739 Fput (Qno_catch
, Qerror_message
,
2740 build_string ("No catch for tag"));
2742 Fput (Qend_of_file
, Qerror_conditions
,
2743 Fcons (Qend_of_file
, error_tail
));
2744 Fput (Qend_of_file
, Qerror_message
,
2745 build_string ("End of file during parsing"));
2747 arith_tail
= Fcons (Qarith_error
, error_tail
);
2748 Fput (Qarith_error
, Qerror_conditions
,
2750 Fput (Qarith_error
, Qerror_message
,
2751 build_string ("Arithmetic error"));
2753 Fput (Qbeginning_of_buffer
, Qerror_conditions
,
2754 Fcons (Qbeginning_of_buffer
, error_tail
));
2755 Fput (Qbeginning_of_buffer
, Qerror_message
,
2756 build_string ("Beginning of buffer"));
2758 Fput (Qend_of_buffer
, Qerror_conditions
,
2759 Fcons (Qend_of_buffer
, error_tail
));
2760 Fput (Qend_of_buffer
, Qerror_message
,
2761 build_string ("End of buffer"));
2763 Fput (Qbuffer_read_only
, Qerror_conditions
,
2764 Fcons (Qbuffer_read_only
, error_tail
));
2765 Fput (Qbuffer_read_only
, Qerror_message
,
2766 build_string ("Buffer is read-only"));
2768 Fput (Qtext_read_only
, Qerror_conditions
,
2769 Fcons (Qtext_read_only
, error_tail
));
2770 Fput (Qtext_read_only
, Qerror_message
,
2771 build_string ("Text is read-only"));
2773 #ifdef LISP_FLOAT_TYPE
2774 Qrange_error
= intern ("range-error");
2775 Qdomain_error
= intern ("domain-error");
2776 Qsingularity_error
= intern ("singularity-error");
2777 Qoverflow_error
= intern ("overflow-error");
2778 Qunderflow_error
= intern ("underflow-error");
2780 Fput (Qdomain_error
, Qerror_conditions
,
2781 Fcons (Qdomain_error
, arith_tail
));
2782 Fput (Qdomain_error
, Qerror_message
,
2783 build_string ("Arithmetic domain error"));
2785 Fput (Qrange_error
, Qerror_conditions
,
2786 Fcons (Qrange_error
, arith_tail
));
2787 Fput (Qrange_error
, Qerror_message
,
2788 build_string ("Arithmetic range error"));
2790 Fput (Qsingularity_error
, Qerror_conditions
,
2791 Fcons (Qsingularity_error
, Fcons (Qdomain_error
, arith_tail
)));
2792 Fput (Qsingularity_error
, Qerror_message
,
2793 build_string ("Arithmetic singularity error"));
2795 Fput (Qoverflow_error
, Qerror_conditions
,
2796 Fcons (Qoverflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2797 Fput (Qoverflow_error
, Qerror_message
,
2798 build_string ("Arithmetic overflow error"));
2800 Fput (Qunderflow_error
, Qerror_conditions
,
2801 Fcons (Qunderflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2802 Fput (Qunderflow_error
, Qerror_message
,
2803 build_string ("Arithmetic underflow error"));
2805 staticpro (&Qrange_error
);
2806 staticpro (&Qdomain_error
);
2807 staticpro (&Qsingularity_error
);
2808 staticpro (&Qoverflow_error
);
2809 staticpro (&Qunderflow_error
);
2810 #endif /* LISP_FLOAT_TYPE */
2814 staticpro (&Qquote
);
2815 staticpro (&Qlambda
);
2817 staticpro (&Qunbound
);
2818 staticpro (&Qerror_conditions
);
2819 staticpro (&Qerror_message
);
2820 staticpro (&Qtop_level
);
2822 staticpro (&Qerror
);
2824 staticpro (&Qwrong_type_argument
);
2825 staticpro (&Qargs_out_of_range
);
2826 staticpro (&Qvoid_function
);
2827 staticpro (&Qcyclic_function_indirection
);
2828 staticpro (&Qvoid_variable
);
2829 staticpro (&Qsetting_constant
);
2830 staticpro (&Qinvalid_read_syntax
);
2831 staticpro (&Qwrong_number_of_arguments
);
2832 staticpro (&Qinvalid_function
);
2833 staticpro (&Qno_catch
);
2834 staticpro (&Qend_of_file
);
2835 staticpro (&Qarith_error
);
2836 staticpro (&Qbeginning_of_buffer
);
2837 staticpro (&Qend_of_buffer
);
2838 staticpro (&Qbuffer_read_only
);
2839 staticpro (&Qtext_read_only
);
2840 staticpro (&Qmark_inactive
);
2842 staticpro (&Qlistp
);
2843 staticpro (&Qconsp
);
2844 staticpro (&Qsymbolp
);
2845 staticpro (&Qkeywordp
);
2846 staticpro (&Qintegerp
);
2847 staticpro (&Qnatnump
);
2848 staticpro (&Qwholenump
);
2849 staticpro (&Qstringp
);
2850 staticpro (&Qarrayp
);
2851 staticpro (&Qsequencep
);
2852 staticpro (&Qbufferp
);
2853 staticpro (&Qvectorp
);
2854 staticpro (&Qchar_or_string_p
);
2855 staticpro (&Qmarkerp
);
2856 staticpro (&Qbuffer_or_string_p
);
2857 staticpro (&Qinteger_or_marker_p
);
2858 #ifdef LISP_FLOAT_TYPE
2859 staticpro (&Qfloatp
);
2860 staticpro (&Qnumberp
);
2861 staticpro (&Qnumber_or_marker_p
);
2862 #endif /* LISP_FLOAT_TYPE */
2863 staticpro (&Qchar_table_p
);
2864 staticpro (&Qvector_or_char_table_p
);
2866 staticpro (&Qboundp
);
2867 staticpro (&Qfboundp
);
2869 staticpro (&Qad_advice_info
);
2870 staticpro (&Qad_activate_internal
);
2872 /* Types that type-of returns. */
2873 Qinteger
= intern ("integer");
2874 Qsymbol
= intern ("symbol");
2875 Qstring
= intern ("string");
2876 Qcons
= intern ("cons");
2877 Qmarker
= intern ("marker");
2878 Qoverlay
= intern ("overlay");
2879 Qfloat
= intern ("float");
2880 Qwindow_configuration
= intern ("window-configuration");
2881 Qprocess
= intern ("process");
2882 Qwindow
= intern ("window");
2883 /* Qsubr = intern ("subr"); */
2884 Qcompiled_function
= intern ("compiled-function");
2885 Qbuffer
= intern ("buffer");
2886 Qframe
= intern ("frame");
2887 Qvector
= intern ("vector");
2888 Qchar_table
= intern ("char-table");
2889 Qbool_vector
= intern ("bool-vector");
2890 Qhash_table
= intern ("hash-table");
2892 staticpro (&Qinteger
);
2893 staticpro (&Qsymbol
);
2894 staticpro (&Qstring
);
2896 staticpro (&Qmarker
);
2897 staticpro (&Qoverlay
);
2898 staticpro (&Qfloat
);
2899 staticpro (&Qwindow_configuration
);
2900 staticpro (&Qprocess
);
2901 staticpro (&Qwindow
);
2902 /* staticpro (&Qsubr); */
2903 staticpro (&Qcompiled_function
);
2904 staticpro (&Qbuffer
);
2905 staticpro (&Qframe
);
2906 staticpro (&Qvector
);
2907 staticpro (&Qchar_table
);
2908 staticpro (&Qbool_vector
);
2909 staticpro (&Qhash_table
);
2911 DEFVAR_BOOL ("keyword-symbols-constant-flag", &keyword_symbols_constant_flag
,
2912 "Non-nil means it is an error to set a keyword symbol.\n\
2913 A keyword symbol is a symbol whose name starts with a colon (`:').");
2914 keyword_symbols_constant_flag
= 1;
2918 defsubr (&Stype_of
);
2923 defsubr (&Sintegerp
);
2924 defsubr (&Sinteger_or_marker_p
);
2925 defsubr (&Snumberp
);
2926 defsubr (&Snumber_or_marker_p
);
2927 #ifdef LISP_FLOAT_TYPE
2929 #endif /* LISP_FLOAT_TYPE */
2930 defsubr (&Snatnump
);
2931 defsubr (&Ssymbolp
);
2932 defsubr (&Skeywordp
);
2933 defsubr (&Sstringp
);
2934 defsubr (&Smultibyte_string_p
);
2935 defsubr (&Svectorp
);
2936 defsubr (&Schar_table_p
);
2937 defsubr (&Svector_or_char_table_p
);
2938 defsubr (&Sbool_vector_p
);
2940 defsubr (&Ssequencep
);
2941 defsubr (&Sbufferp
);
2942 defsubr (&Smarkerp
);
2944 defsubr (&Sbyte_code_function_p
);
2945 defsubr (&Schar_or_string_p
);
2948 defsubr (&Scar_safe
);
2949 defsubr (&Scdr_safe
);
2952 defsubr (&Ssymbol_function
);
2953 defsubr (&Sindirect_function
);
2954 defsubr (&Ssymbol_plist
);
2955 defsubr (&Ssymbol_name
);
2956 defsubr (&Smakunbound
);
2957 defsubr (&Sfmakunbound
);
2959 defsubr (&Sfboundp
);
2961 defsubr (&Sdefalias
);
2962 defsubr (&Ssetplist
);
2963 defsubr (&Ssymbol_value
);
2965 defsubr (&Sdefault_boundp
);
2966 defsubr (&Sdefault_value
);
2967 defsubr (&Sset_default
);
2968 defsubr (&Ssetq_default
);
2969 defsubr (&Smake_variable_buffer_local
);
2970 defsubr (&Smake_local_variable
);
2971 defsubr (&Skill_local_variable
);
2972 defsubr (&Smake_variable_frame_local
);
2973 defsubr (&Slocal_variable_p
);
2974 defsubr (&Slocal_variable_if_set_p
);
2977 defsubr (&Snumber_to_string
);
2978 defsubr (&Sstring_to_number
);
2979 defsubr (&Seqlsign
);
3003 XSYMBOL (Qwholenump
)->function
= XSYMBOL (Qnatnump
)->function
;
3010 #if defined(USG) && !defined(POSIX_SIGNALS)
3011 /* USG systems forget handlers when they are used;
3012 must reestablish each time */
3013 signal (signo
, arith_error
);
3016 /* VMS systems are like USG. */
3017 signal (signo
, arith_error
);
3021 #else /* not BSD4_1 */
3022 sigsetmask (SIGEMPTYMASK
);
3023 #endif /* not BSD4_1 */
3025 Fsignal (Qarith_error
, Qnil
);
3031 /* Don't do this if just dumping out.
3032 We don't want to call `signal' in this case
3033 so that we don't have trouble with dumping
3034 signal-delivering routines in an inconsistent state. */
3038 #endif /* CANNOT_DUMP */
3039 signal (SIGFPE
, arith_error
);
3042 signal (SIGEMT
, arith_error
);