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 /* Store the value NEWVAL into SYMBOL.
966 If buffer-locality is an issue, BUF specifies which buffer to use.
967 (0 stands for the current buffer.)
969 If BINDFLAG is zero, then if this symbol is supposed to become
970 local in every buffer where it is set, then we make it local.
971 If BINDFLAG is nonzero, we don't do that. */
974 set_internal (symbol
, newval
, buf
, bindflag
)
975 register Lisp_Object symbol
, newval
;
979 int voide
= EQ (newval
, Qunbound
);
981 register Lisp_Object valcontents
, tem1
, current_alist_element
;
984 buf
= current_buffer
;
986 /* If restoring in a dead buffer, do nothing. */
987 if (NILP (buf
->name
))
990 CHECK_SYMBOL (symbol
, 0);
991 if (NILP (symbol
) || EQ (symbol
, Qt
)
992 || (XSYMBOL (symbol
)->name
->data
[0] == ':'
993 && EQ (XSYMBOL (symbol
)->obarray
, initial_obarray
)
994 && keyword_symbols_constant_flag
&& ! EQ (newval
, symbol
)))
995 return Fsignal (Qsetting_constant
, Fcons (symbol
, Qnil
));
996 valcontents
= XSYMBOL (symbol
)->value
;
998 if (BUFFER_OBJFWDP (valcontents
))
1000 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1001 register int mask
= XINT (*((Lisp_Object
*)
1002 (idx
+ (char *)&buffer_local_flags
)));
1003 if (mask
> 0 && ! bindflag
)
1004 buf
->local_var_flags
|= mask
;
1007 else if (BUFFER_LOCAL_VALUEP (valcontents
)
1008 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1010 /* valcontents is actually a pointer to a struct resembling a cons,
1011 with contents something like:
1012 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE).
1014 BUFFER is the last buffer for which this symbol's value was
1017 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
1018 local_var_alist, that being the element whose car is this
1019 variable. Or it can be a pointer to the
1020 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not
1021 have an element in its alist for this variable (that is, if
1022 BUFFER sees the default value of this variable).
1024 If we want to examine or set the value and BUFFER is current,
1025 we just examine or set REALVALUE. If BUFFER is not current, we
1026 store the current REALVALUE value into CURRENT-ALIST-ELEMENT,
1027 then find the appropriate alist element for the buffer now
1028 current and set up CURRENT-ALIST-ELEMENT. Then we set
1029 REALVALUE out of that element, and store into BUFFER.
1031 If we are setting the variable and the current buffer does
1032 not have an alist entry for this variable, an alist entry is
1035 Note that REALVALUE can be a forwarding pointer. Each time
1036 it is examined or set, forwarding must be done. */
1038 /* What value are we caching right now? */
1039 current_alist_element
1040 = XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
1042 /* If the current buffer is not the buffer whose binding is
1043 currently cached, or if it's a Lisp_Buffer_Local_Value and
1044 we're looking at the default value, the cache is invalid; we
1045 need to write it out, and find the new CURRENT-ALIST-ELEMENT. */
1046 if ((XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
1047 && (buf
!= XBUFFER (XBUFFER_LOCAL_VALUE (valcontents
)->buffer
)
1048 || (BUFFER_LOCAL_VALUEP (valcontents
)
1049 && EQ (XCAR (current_alist_element
),
1050 current_alist_element
))))
1052 (XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
1053 && !EQ (selected_frame
, XBUFFER_LOCAL_VALUE (valcontents
)->frame
)))
1055 /* Write out the cached value for the old buffer; copy it
1056 back to its alist element. This works if the current
1057 buffer only sees the default value, too. */
1058 Fsetcdr (current_alist_element
,
1059 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
));
1061 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1062 tem1
= Fassq (symbol
, buf
->local_var_alist
);
1063 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 1;
1064 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 0;
1068 /* This buffer still sees the default value. */
1070 /* If the variable is a Lisp_Some_Buffer_Local_Value,
1071 or if this is `let' rather than `set',
1072 make CURRENT-ALIST-ELEMENT point to itself,
1073 indicating that we're seeing the default value. */
1074 if (bindflag
|| SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1076 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
1078 if (XBUFFER_LOCAL_VALUE (valcontents
)->check_frame
)
1079 tem1
= Fassq (symbol
,
1080 XFRAME (selected_frame
)->param_alist
);
1083 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 1;
1085 tem1
= XBUFFER_LOCAL_VALUE (valcontents
)->cdr
;
1087 /* If it's a Lisp_Buffer_Local_Value, being set not bound,
1088 give this buffer a new assoc for a local value and set
1089 CURRENT-ALIST-ELEMENT to point to that. */
1092 tem1
= Fcons (symbol
, Fcdr (current_alist_element
));
1093 buf
->local_var_alist
1094 = Fcons (tem1
, buf
->local_var_alist
);
1098 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1099 XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
)
1102 /* Set BUFFER and FRAME for binding now loaded. */
1103 XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents
)->buffer
, buf
);
1104 XBUFFER_LOCAL_VALUE (valcontents
)->frame
= selected_frame
;
1106 valcontents
= XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
;
1109 /* If storing void (making the symbol void), forward only through
1110 buffer-local indicator, not through Lisp_Objfwd, etc. */
1112 store_symval_forwarding (symbol
, Qnil
, newval
);
1114 store_symval_forwarding (symbol
, valcontents
, newval
);
1119 /* Access or set a buffer-local symbol's default value. */
1121 /* Return the default value of SYMBOL, but don't check for voidness.
1122 Return Qunbound if it is void. */
1125 default_value (symbol
)
1128 register Lisp_Object valcontents
;
1130 CHECK_SYMBOL (symbol
, 0);
1131 valcontents
= XSYMBOL (symbol
)->value
;
1133 /* For a built-in buffer-local variable, get the default value
1134 rather than letting do_symval_forwarding get the current value. */
1135 if (BUFFER_OBJFWDP (valcontents
))
1137 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1139 if (XINT (*(Lisp_Object
*) (idx
+ (char *) &buffer_local_flags
)) != 0)
1140 return *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
1143 /* Handle user-created local variables. */
1144 if (BUFFER_LOCAL_VALUEP (valcontents
)
1145 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1147 /* If var is set up for a buffer that lacks a local value for it,
1148 the current value is nominally the default value.
1149 But the current value slot may be more up to date, since
1150 ordinary setq stores just that slot. So use that. */
1151 Lisp_Object current_alist_element
, alist_element_car
;
1152 current_alist_element
1153 = XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
1154 alist_element_car
= XCAR (current_alist_element
);
1155 if (EQ (alist_element_car
, current_alist_element
))
1156 return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
);
1158 return XCDR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
1160 /* For other variables, get the current value. */
1161 return do_symval_forwarding (valcontents
);
1164 DEFUN ("default-boundp", Fdefault_boundp
, Sdefault_boundp
, 1, 1, 0,
1165 "Return t if SYMBOL has a non-void default value.\n\
1166 This is the value that is seen in buffers that do not have their own values\n\
1167 for this variable.")
1171 register Lisp_Object value
;
1173 value
= default_value (symbol
);
1174 return (EQ (value
, Qunbound
) ? Qnil
: Qt
);
1177 DEFUN ("default-value", Fdefault_value
, Sdefault_value
, 1, 1, 0,
1178 "Return SYMBOL's default value.\n\
1179 This is the value that is seen in buffers that do not have their own values\n\
1180 for this variable. The default value is meaningful for variables with\n\
1181 local bindings in certain buffers.")
1185 register Lisp_Object value
;
1187 value
= default_value (symbol
);
1188 if (EQ (value
, Qunbound
))
1189 return Fsignal (Qvoid_variable
, Fcons (symbol
, Qnil
));
1193 DEFUN ("set-default", Fset_default
, Sset_default
, 2, 2, 0,
1194 "Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.\n\
1195 The default value is seen in buffers that do not have their own values\n\
1196 for this variable.")
1198 Lisp_Object symbol
, value
;
1200 register Lisp_Object valcontents
, current_alist_element
, alist_element_buffer
;
1202 CHECK_SYMBOL (symbol
, 0);
1203 valcontents
= XSYMBOL (symbol
)->value
;
1205 /* Handle variables like case-fold-search that have special slots
1206 in the buffer. Make them work apparently like Lisp_Buffer_Local_Value
1208 if (BUFFER_OBJFWDP (valcontents
))
1210 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1211 register struct buffer
*b
;
1212 register int mask
= XINT (*((Lisp_Object
*)
1213 (idx
+ (char *)&buffer_local_flags
)));
1215 *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
) = value
;
1217 /* If this variable is not always local in all buffers,
1218 set it in the buffers that don't nominally have a local value. */
1221 for (b
= all_buffers
; b
; b
= b
->next
)
1222 if (!(b
->local_var_flags
& mask
))
1223 *(Lisp_Object
*)(idx
+ (char *) b
) = value
;
1228 if (!BUFFER_LOCAL_VALUEP (valcontents
)
1229 && !SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1230 return Fset (symbol
, value
);
1232 /* Store new value into the DEFAULT-VALUE slot */
1233 XCDR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
) = value
;
1235 /* If that slot is current, we must set the REALVALUE slot too */
1236 current_alist_element
1237 = XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
1238 alist_element_buffer
= Fcar (current_alist_element
);
1239 if (EQ (alist_element_buffer
, current_alist_element
))
1240 store_symval_forwarding (symbol
, XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
,
1246 DEFUN ("setq-default", Fsetq_default
, Ssetq_default
, 2, UNEVALLED
, 0,
1247 "Set the default value of variable VAR to VALUE.\n\
1248 VAR, the variable name, is literal (not evaluated);\n\
1249 VALUE is an expression and it is evaluated.\n\
1250 The default value of a variable is seen in buffers\n\
1251 that do not have their own values for the variable.\n\
1253 More generally, you can use multiple variables and values, as in\n\
1254 (setq-default SYMBOL VALUE SYMBOL VALUE...)\n\
1255 This sets each SYMBOL's default value to the corresponding VALUE.\n\
1256 The VALUE for the Nth SYMBOL can refer to the new default values\n\
1261 register Lisp_Object args_left
;
1262 register Lisp_Object val
, symbol
;
1263 struct gcpro gcpro1
;
1273 val
= Feval (Fcar (Fcdr (args_left
)));
1274 symbol
= Fcar (args_left
);
1275 Fset_default (symbol
, val
);
1276 args_left
= Fcdr (Fcdr (args_left
));
1278 while (!NILP (args_left
));
1284 /* Lisp functions for creating and removing buffer-local variables. */
1286 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local
, Smake_variable_buffer_local
,
1287 1, 1, "vMake Variable Buffer Local: ",
1288 "Make VARIABLE have a separate value for each buffer.\n\
1289 At any time, the value for the current buffer is in effect.\n\
1290 There is also a default value which is seen in any buffer which has not yet\n\
1291 set its own value.\n\
1292 Using `set' or `setq' to set the variable causes it to have a separate value\n\
1293 for the current buffer if it was previously using the default value.\n\
1294 The function `default-value' gets the default value and `set-default' sets it.")
1296 register Lisp_Object variable
;
1298 register Lisp_Object tem
, valcontents
, newval
;
1300 CHECK_SYMBOL (variable
, 0);
1302 valcontents
= XSYMBOL (variable
)->value
;
1303 if (EQ (variable
, Qnil
) || EQ (variable
, Qt
) || KBOARD_OBJFWDP (valcontents
))
1304 error ("Symbol %s may not be buffer-local", XSYMBOL (variable
)->name
->data
);
1306 if (BUFFER_LOCAL_VALUEP (valcontents
) || BUFFER_OBJFWDP (valcontents
))
1308 if (SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1310 XMISCTYPE (XSYMBOL (variable
)->value
) = Lisp_Misc_Buffer_Local_Value
;
1313 if (EQ (valcontents
, Qunbound
))
1314 XSYMBOL (variable
)->value
= Qnil
;
1315 tem
= Fcons (Qnil
, Fsymbol_value (variable
));
1317 newval
= allocate_misc ();
1318 XMISCTYPE (newval
) = Lisp_Misc_Buffer_Local_Value
;
1319 XBUFFER_LOCAL_VALUE (newval
)->realvalue
= XSYMBOL (variable
)->value
;
1320 XBUFFER_LOCAL_VALUE (newval
)->buffer
= Fcurrent_buffer ();
1321 XBUFFER_LOCAL_VALUE (newval
)->frame
= Qnil
;
1322 XBUFFER_LOCAL_VALUE (newval
)->found_for_buffer
= 1;
1323 XBUFFER_LOCAL_VALUE (newval
)->found_for_frame
= 0;
1324 XBUFFER_LOCAL_VALUE (newval
)->check_frame
= 0;
1325 XBUFFER_LOCAL_VALUE (newval
)->cdr
= tem
;
1326 XSYMBOL (variable
)->value
= newval
;
1330 DEFUN ("make-local-variable", Fmake_local_variable
, Smake_local_variable
,
1331 1, 1, "vMake Local Variable: ",
1332 "Make VARIABLE have a separate value in the current buffer.\n\
1333 Other buffers will continue to share a common default value.\n\
1334 \(The buffer-local value of VARIABLE starts out as the same value\n\
1335 VARIABLE previously had. If VARIABLE was void, it remains void.\)\n\
1336 See also `make-variable-buffer-local'.\n\
1338 If the variable is already arranged to become local when set,\n\
1339 this function causes a local value to exist for this buffer,\n\
1340 just as setting the variable would do.\n\
1342 This function returns VARIABLE, and therefore\n\
1343 (set (make-local-variable 'VARIABLE) VALUE-EXP)\n\
1346 Do not use `make-local-variable' to make a hook variable buffer-local.\n\
1347 Use `make-local-hook' instead.")
1349 register Lisp_Object variable
;
1351 register Lisp_Object tem
, valcontents
;
1353 CHECK_SYMBOL (variable
, 0);
1355 valcontents
= XSYMBOL (variable
)->value
;
1356 if (EQ (variable
, Qnil
) || EQ (variable
, Qt
) || KBOARD_OBJFWDP (valcontents
))
1357 error ("Symbol %s may not be buffer-local", XSYMBOL (variable
)->name
->data
);
1359 if (BUFFER_LOCAL_VALUEP (valcontents
) || BUFFER_OBJFWDP (valcontents
))
1361 tem
= Fboundp (variable
);
1363 /* Make sure the symbol has a local value in this particular buffer,
1364 by setting it to the same value it already has. */
1365 Fset (variable
, (EQ (tem
, Qt
) ? Fsymbol_value (variable
) : Qunbound
));
1368 /* Make sure symbol is set up to hold per-buffer values */
1369 if (!SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1372 tem
= Fcons (Qnil
, do_symval_forwarding (valcontents
));
1374 newval
= allocate_misc ();
1375 XMISCTYPE (newval
) = Lisp_Misc_Some_Buffer_Local_Value
;
1376 XBUFFER_LOCAL_VALUE (newval
)->realvalue
= XSYMBOL (variable
)->value
;
1377 XBUFFER_LOCAL_VALUE (newval
)->buffer
= Qnil
;
1378 XBUFFER_LOCAL_VALUE (newval
)->frame
= Qnil
;
1379 XBUFFER_LOCAL_VALUE (newval
)->found_for_buffer
= 0;
1380 XBUFFER_LOCAL_VALUE (newval
)->found_for_frame
= 0;
1381 XBUFFER_LOCAL_VALUE (newval
)->check_frame
= 0;
1382 XBUFFER_LOCAL_VALUE (newval
)->cdr
= tem
;
1383 XSYMBOL (variable
)->value
= newval
;
1385 /* Make sure this buffer has its own value of symbol */
1386 tem
= Fassq (variable
, current_buffer
->local_var_alist
);
1389 /* Swap out any local binding for some other buffer, and make
1390 sure the current value is permanently recorded, if it's the
1392 find_symbol_value (variable
);
1394 current_buffer
->local_var_alist
1395 = Fcons (Fcons (variable
, XCDR (XBUFFER_LOCAL_VALUE (XSYMBOL (variable
)->value
)->cdr
)),
1396 current_buffer
->local_var_alist
);
1398 /* Make sure symbol does not think it is set up for this buffer;
1399 force it to look once again for this buffer's value */
1401 Lisp_Object
*pvalbuf
;
1403 valcontents
= XSYMBOL (variable
)->value
;
1405 pvalbuf
= &XBUFFER_LOCAL_VALUE (valcontents
)->buffer
;
1406 if (current_buffer
== XBUFFER (*pvalbuf
))
1408 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
1412 /* If the symbol forwards into a C variable, then swap in the
1413 variable for this buffer immediately. If C code modifies the
1414 variable before we swap in, then that new value will clobber the
1415 default value the next time we swap. */
1416 valcontents
= XBUFFER_LOCAL_VALUE (XSYMBOL (variable
)->value
)->realvalue
;
1417 if (INTFWDP (valcontents
) || BOOLFWDP (valcontents
) || OBJFWDP (valcontents
))
1418 swap_in_symval_forwarding (variable
, XSYMBOL (variable
)->value
);
1423 DEFUN ("kill-local-variable", Fkill_local_variable
, Skill_local_variable
,
1424 1, 1, "vKill Local Variable: ",
1425 "Make VARIABLE no longer have a separate value in the current buffer.\n\
1426 From now on the default value will apply in this buffer.")
1428 register Lisp_Object variable
;
1430 register Lisp_Object tem
, valcontents
;
1432 CHECK_SYMBOL (variable
, 0);
1434 valcontents
= XSYMBOL (variable
)->value
;
1436 if (BUFFER_OBJFWDP (valcontents
))
1438 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1439 register int mask
= XINT (*((Lisp_Object
*)
1440 (idx
+ (char *)&buffer_local_flags
)));
1444 *(Lisp_Object
*)(idx
+ (char *) current_buffer
)
1445 = *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
1446 current_buffer
->local_var_flags
&= ~mask
;
1451 if (!BUFFER_LOCAL_VALUEP (valcontents
)
1452 && !SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1455 /* Get rid of this buffer's alist element, if any */
1457 tem
= Fassq (variable
, current_buffer
->local_var_alist
);
1459 current_buffer
->local_var_alist
1460 = Fdelq (tem
, current_buffer
->local_var_alist
);
1462 /* If the symbol is set up for the current buffer, recompute its
1463 value. We have to do it now, or else forwarded objects won't
1466 Lisp_Object
*pvalbuf
;
1467 valcontents
= XSYMBOL (variable
)->value
;
1468 pvalbuf
= &XBUFFER_LOCAL_VALUE (valcontents
)->buffer
;
1469 if (current_buffer
== XBUFFER (*pvalbuf
))
1472 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
1473 find_symbol_value (variable
);
1480 /* Lisp functions for creating and removing buffer-local variables. */
1482 DEFUN ("make-variable-frame-local", Fmake_variable_frame_local
, Smake_variable_frame_local
,
1483 1, 1, "vMake Variable Frame Local: ",
1484 "Enable VARIABLE to have frame-local bindings.\n\
1485 When a frame-local binding exists in the current frame,\n\
1486 it is in effect whenever the current buffer has no buffer-local binding.\n\
1487 A frame-local binding is actual a frame parameter value;\n\
1488 thus, any given frame has a local binding for VARIABLE\n\
1489 if it has a value for the frame parameter named VARIABLE.\n\
1490 See `modify-frame-parameters'.")
1492 register Lisp_Object variable
;
1494 register Lisp_Object tem
, valcontents
, newval
;
1496 CHECK_SYMBOL (variable
, 0);
1498 valcontents
= XSYMBOL (variable
)->value
;
1499 if (EQ (variable
, Qnil
) || EQ (variable
, Qt
) || KBOARD_OBJFWDP (valcontents
)
1500 || BUFFER_OBJFWDP (valcontents
))
1501 error ("Symbol %s may not be frame-local", XSYMBOL (variable
)->name
->data
);
1503 if (BUFFER_LOCAL_VALUEP (valcontents
)
1504 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1507 if (EQ (valcontents
, Qunbound
))
1508 XSYMBOL (variable
)->value
= Qnil
;
1509 tem
= Fcons (Qnil
, Fsymbol_value (variable
));
1511 newval
= allocate_misc ();
1512 XMISCTYPE (newval
) = Lisp_Misc_Some_Buffer_Local_Value
;
1513 XBUFFER_LOCAL_VALUE (newval
)->realvalue
= XSYMBOL (variable
)->value
;
1514 XBUFFER_LOCAL_VALUE (newval
)->buffer
= Qnil
;
1515 XBUFFER_LOCAL_VALUE (newval
)->frame
= Qnil
;
1516 XBUFFER_LOCAL_VALUE (newval
)->found_for_buffer
= 0;
1517 XBUFFER_LOCAL_VALUE (newval
)->found_for_frame
= 0;
1518 XBUFFER_LOCAL_VALUE (newval
)->check_frame
= 1;
1519 XBUFFER_LOCAL_VALUE (newval
)->cdr
= tem
;
1520 XSYMBOL (variable
)->value
= newval
;
1524 DEFUN ("local-variable-p", Flocal_variable_p
, Slocal_variable_p
,
1526 "Non-nil if VARIABLE has a local binding in buffer BUFFER.\n\
1527 BUFFER defaults to the current buffer.")
1529 register Lisp_Object variable
, buffer
;
1531 Lisp_Object valcontents
;
1532 register struct buffer
*buf
;
1535 buf
= current_buffer
;
1538 CHECK_BUFFER (buffer
, 0);
1539 buf
= XBUFFER (buffer
);
1542 CHECK_SYMBOL (variable
, 0);
1544 valcontents
= XSYMBOL (variable
)->value
;
1545 if (BUFFER_LOCAL_VALUEP (valcontents
)
1546 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1548 Lisp_Object tail
, elt
;
1549 for (tail
= buf
->local_var_alist
; CONSP (tail
); tail
= XCDR (tail
))
1552 if (EQ (variable
, XCAR (elt
)))
1556 if (BUFFER_OBJFWDP (valcontents
))
1558 int offset
= XBUFFER_OBJFWD (valcontents
)->offset
;
1559 int mask
= XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
));
1560 if (mask
== -1 || (buf
->local_var_flags
& mask
))
1566 DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p
, Slocal_variable_if_set_p
,
1568 "Non-nil if VARIABLE will be local in buffer BUFFER if it is set there.\n\
1569 BUFFER defaults to the current buffer.")
1571 register Lisp_Object variable
, buffer
;
1573 Lisp_Object valcontents
;
1574 register struct buffer
*buf
;
1577 buf
= current_buffer
;
1580 CHECK_BUFFER (buffer
, 0);
1581 buf
= XBUFFER (buffer
);
1584 CHECK_SYMBOL (variable
, 0);
1586 valcontents
= XSYMBOL (variable
)->value
;
1588 /* This means that make-variable-buffer-local was done. */
1589 if (BUFFER_LOCAL_VALUEP (valcontents
))
1591 /* All these slots become local if they are set. */
1592 if (BUFFER_OBJFWDP (valcontents
))
1594 if (SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1596 Lisp_Object tail
, elt
;
1597 for (tail
= buf
->local_var_alist
; CONSP (tail
); tail
= XCDR (tail
))
1600 if (EQ (variable
, XCAR (elt
)))
1607 /* Find the function at the end of a chain of symbol function indirections. */
1609 /* If OBJECT is a symbol, find the end of its function chain and
1610 return the value found there. If OBJECT is not a symbol, just
1611 return it. If there is a cycle in the function chain, signal a
1612 cyclic-function-indirection error.
1614 This is like Findirect_function, except that it doesn't signal an
1615 error if the chain ends up unbound. */
1617 indirect_function (object
)
1618 register Lisp_Object object
;
1620 Lisp_Object tortoise
, hare
;
1622 hare
= tortoise
= object
;
1626 if (!SYMBOLP (hare
) || EQ (hare
, Qunbound
))
1628 hare
= XSYMBOL (hare
)->function
;
1629 if (!SYMBOLP (hare
) || EQ (hare
, Qunbound
))
1631 hare
= XSYMBOL (hare
)->function
;
1633 tortoise
= XSYMBOL (tortoise
)->function
;
1635 if (EQ (hare
, tortoise
))
1636 Fsignal (Qcyclic_function_indirection
, Fcons (object
, Qnil
));
1642 DEFUN ("indirect-function", Findirect_function
, Sindirect_function
, 1, 1, 0,
1643 "Return the function at the end of OBJECT's function chain.\n\
1644 If OBJECT is a symbol, follow all function indirections and return the final\n\
1645 function binding.\n\
1646 If OBJECT is not a symbol, just return it.\n\
1647 Signal a void-function error if the final symbol is unbound.\n\
1648 Signal a cyclic-function-indirection error if there is a loop in the\n\
1649 function chain of symbols.")
1651 register Lisp_Object object
;
1655 result
= indirect_function (object
);
1657 if (EQ (result
, Qunbound
))
1658 return Fsignal (Qvoid_function
, Fcons (object
, Qnil
));
1662 /* Extract and set vector and string elements */
1664 DEFUN ("aref", Faref
, Saref
, 2, 2, 0,
1665 "Return the element of ARRAY at index IDX.\n\
1666 ARRAY may be a vector, a string, a char-table, a bool-vector,\n\
1667 or a byte-code object. IDX starts at 0.")
1669 register Lisp_Object array
;
1672 register int idxval
;
1674 CHECK_NUMBER (idx
, 1);
1675 idxval
= XINT (idx
);
1676 if (STRINGP (array
))
1680 if (idxval
< 0 || idxval
>= XSTRING (array
)->size
)
1681 args_out_of_range (array
, idx
);
1682 if (! STRING_MULTIBYTE (array
))
1683 return make_number ((unsigned char) XSTRING (array
)->data
[idxval
]);
1684 idxval_byte
= string_char_to_byte (array
, idxval
);
1686 c
= STRING_CHAR (&XSTRING (array
)->data
[idxval_byte
],
1687 STRING_BYTES (XSTRING (array
)) - idxval_byte
);
1688 return make_number (c
);
1690 else if (BOOL_VECTOR_P (array
))
1694 if (idxval
< 0 || idxval
>= XBOOL_VECTOR (array
)->size
)
1695 args_out_of_range (array
, idx
);
1697 val
= (unsigned char) XBOOL_VECTOR (array
)->data
[idxval
/ BITS_PER_CHAR
];
1698 return (val
& (1 << (idxval
% BITS_PER_CHAR
)) ? Qt
: Qnil
);
1700 else if (CHAR_TABLE_P (array
))
1705 args_out_of_range (array
, idx
);
1706 if (idxval
< CHAR_TABLE_ORDINARY_SLOTS
)
1708 /* For ASCII and 8-bit European characters, the element is
1709 stored in the top table. */
1710 val
= XCHAR_TABLE (array
)->contents
[idxval
];
1712 val
= XCHAR_TABLE (array
)->defalt
;
1713 while (NILP (val
)) /* Follow parents until we find some value. */
1715 array
= XCHAR_TABLE (array
)->parent
;
1718 val
= XCHAR_TABLE (array
)->contents
[idxval
];
1720 val
= XCHAR_TABLE (array
)->defalt
;
1727 Lisp_Object sub_table
;
1729 SPLIT_NON_ASCII_CHAR (idxval
, code
[0], code
[1], code
[2]);
1730 if (code
[1] < 32) code
[1] = -1;
1731 else if (code
[2] < 32) code
[2] = -1;
1733 /* Here, the possible range of CODE[0] (== charset ID) is
1734 128..MAX_CHARSET. Since the top level char table contains
1735 data for multibyte characters after 256th element, we must
1736 increment CODE[0] by 128 to get a correct index. */
1738 code
[3] = -1; /* anchor */
1740 try_parent_char_table
:
1742 for (i
= 0; code
[i
] >= 0; i
++)
1744 val
= XCHAR_TABLE (sub_table
)->contents
[code
[i
]];
1745 if (SUB_CHAR_TABLE_P (val
))
1750 val
= XCHAR_TABLE (sub_table
)->defalt
;
1753 array
= XCHAR_TABLE (array
)->parent
;
1755 goto try_parent_char_table
;
1760 /* Here, VAL is a sub char table. We try the default value
1762 val
= XCHAR_TABLE (val
)->defalt
;
1765 array
= XCHAR_TABLE (array
)->parent
;
1767 goto try_parent_char_table
;
1775 if (VECTORP (array
))
1776 size
= XVECTOR (array
)->size
;
1777 else if (COMPILEDP (array
))
1778 size
= XVECTOR (array
)->size
& PSEUDOVECTOR_SIZE_MASK
;
1780 wrong_type_argument (Qarrayp
, array
);
1782 if (idxval
< 0 || idxval
>= size
)
1783 args_out_of_range (array
, idx
);
1784 return XVECTOR (array
)->contents
[idxval
];
1788 DEFUN ("aset", Faset
, Saset
, 3, 3, 0,
1789 "Store into the element of ARRAY at index IDX the value NEWELT.\n\
1790 ARRAY may be a vector, a string, a char-table or a bool-vector.\n\
1792 (array
, idx
, newelt
)
1793 register Lisp_Object array
;
1794 Lisp_Object idx
, newelt
;
1796 register int idxval
;
1798 CHECK_NUMBER (idx
, 1);
1799 idxval
= XINT (idx
);
1800 if (!VECTORP (array
) && !STRINGP (array
) && !BOOL_VECTOR_P (array
)
1801 && ! CHAR_TABLE_P (array
))
1802 array
= wrong_type_argument (Qarrayp
, array
);
1803 CHECK_IMPURE (array
);
1805 if (VECTORP (array
))
1807 if (idxval
< 0 || idxval
>= XVECTOR (array
)->size
)
1808 args_out_of_range (array
, idx
);
1809 XVECTOR (array
)->contents
[idxval
] = newelt
;
1811 else if (BOOL_VECTOR_P (array
))
1815 if (idxval
< 0 || idxval
>= XBOOL_VECTOR (array
)->size
)
1816 args_out_of_range (array
, idx
);
1818 val
= (unsigned char) XBOOL_VECTOR (array
)->data
[idxval
/ BITS_PER_CHAR
];
1820 if (! NILP (newelt
))
1821 val
|= 1 << (idxval
% BITS_PER_CHAR
);
1823 val
&= ~(1 << (idxval
% BITS_PER_CHAR
));
1824 XBOOL_VECTOR (array
)->data
[idxval
/ BITS_PER_CHAR
] = val
;
1826 else if (CHAR_TABLE_P (array
))
1829 args_out_of_range (array
, idx
);
1830 if (idxval
< CHAR_TABLE_ORDINARY_SLOTS
)
1831 XCHAR_TABLE (array
)->contents
[idxval
] = newelt
;
1837 SPLIT_NON_ASCII_CHAR (idxval
, code
[0], code
[1], code
[2]);
1838 if (code
[1] < 32) code
[1] = -1;
1839 else if (code
[2] < 32) code
[2] = -1;
1841 /* See the comment of the corresponding part in Faref. */
1843 code
[3] = -1; /* anchor */
1844 for (i
= 0; code
[i
+ 1] >= 0; i
++)
1846 val
= XCHAR_TABLE (array
)->contents
[code
[i
]];
1847 if (SUB_CHAR_TABLE_P (val
))
1853 /* VAL is a leaf. Create a sub char table with the
1854 default value VAL or XCHAR_TABLE (array)->defalt
1855 and look into it. */
1857 temp
= make_sub_char_table (NILP (val
)
1858 ? XCHAR_TABLE (array
)->defalt
1860 XCHAR_TABLE (array
)->contents
[code
[i
]] = temp
;
1864 XCHAR_TABLE (array
)->contents
[code
[i
]] = newelt
;
1867 else if (STRING_MULTIBYTE (array
))
1869 int idxval_byte
, new_len
, actual_len
;
1871 unsigned char *p
, workbuf
[MAX_MULTIBYTE_LENGTH
], *str
= workbuf
;
1873 if (idxval
< 0 || idxval
>= XSTRING (array
)->size
)
1874 args_out_of_range (array
, idx
);
1876 idxval_byte
= string_char_to_byte (array
, idxval
);
1877 p
= &XSTRING (array
)->data
[idxval_byte
];
1879 actual_len
= MULTIBYTE_FORM_LENGTH (p
, STRING_BYTES (XSTRING (array
)));
1880 CHECK_NUMBER (newelt
, 2);
1881 new_len
= CHAR_STRING (XINT (newelt
), str
);
1882 if (actual_len
!= new_len
)
1883 error ("Attempt to change byte length of a string");
1885 /* We can't accept a change causing byte combining. */
1886 if (!ASCII_BYTE_P (*str
)
1887 && ((idxval
> 0 && !CHAR_HEAD_P (*str
)
1888 && (prev_byte
= string_char_to_byte (array
, idxval
- 1),
1889 BYTES_BY_CHAR_HEAD (XSTRING (array
)->data
[prev_byte
])
1890 > idxval_byte
- prev_byte
))
1891 || (idxval
< XSTRING (array
)->size
- 1
1892 && !CHAR_HEAD_P (p
[actual_len
])
1893 && new_len
< BYTES_BY_CHAR_HEAD (*str
))))
1894 error ("Attempt to change char length of a string");
1900 if (idxval
< 0 || idxval
>= XSTRING (array
)->size
)
1901 args_out_of_range (array
, idx
);
1902 CHECK_NUMBER (newelt
, 2);
1903 XSTRING (array
)->data
[idxval
] = XINT (newelt
);
1909 /* Arithmetic functions */
1911 enum comparison
{ equal
, notequal
, less
, grtr
, less_or_equal
, grtr_or_equal
};
1914 arithcompare (num1
, num2
, comparison
)
1915 Lisp_Object num1
, num2
;
1916 enum comparison comparison
;
1921 #ifdef LISP_FLOAT_TYPE
1922 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1
, 0);
1923 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2
, 0);
1925 if (FLOATP (num1
) || FLOATP (num2
))
1928 f1
= (FLOATP (num1
)) ? XFLOAT_DATA (num1
) : XINT (num1
);
1929 f2
= (FLOATP (num2
)) ? XFLOAT_DATA (num2
) : XINT (num2
);
1932 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1933 CHECK_NUMBER_COERCE_MARKER (num2
, 0);
1934 #endif /* LISP_FLOAT_TYPE */
1939 if (floatp
? f1
== f2
: XINT (num1
) == XINT (num2
))
1944 if (floatp
? f1
!= f2
: XINT (num1
) != XINT (num2
))
1949 if (floatp
? f1
< f2
: XINT (num1
) < XINT (num2
))
1954 if (floatp
? f1
<= f2
: XINT (num1
) <= XINT (num2
))
1959 if (floatp
? f1
> f2
: XINT (num1
) > XINT (num2
))
1964 if (floatp
? f1
>= f2
: XINT (num1
) >= XINT (num2
))
1973 DEFUN ("=", Feqlsign
, Seqlsign
, 2, 2, 0,
1974 "Return t if two args, both numbers or markers, are equal.")
1976 register Lisp_Object num1
, num2
;
1978 return arithcompare (num1
, num2
, equal
);
1981 DEFUN ("<", Flss
, Slss
, 2, 2, 0,
1982 "Return t if first arg is less than second arg. Both must be numbers or markers.")
1984 register Lisp_Object num1
, num2
;
1986 return arithcompare (num1
, num2
, less
);
1989 DEFUN (">", Fgtr
, Sgtr
, 2, 2, 0,
1990 "Return t if first arg is greater than second arg. Both must be numbers or markers.")
1992 register Lisp_Object num1
, num2
;
1994 return arithcompare (num1
, num2
, grtr
);
1997 DEFUN ("<=", Fleq
, Sleq
, 2, 2, 0,
1998 "Return t if first arg is less than or equal to second arg.\n\
1999 Both must be numbers or markers.")
2001 register Lisp_Object num1
, num2
;
2003 return arithcompare (num1
, num2
, less_or_equal
);
2006 DEFUN (">=", Fgeq
, Sgeq
, 2, 2, 0,
2007 "Return t if first arg is greater than or equal to second arg.\n\
2008 Both must be numbers or markers.")
2010 register Lisp_Object num1
, num2
;
2012 return arithcompare (num1
, num2
, grtr_or_equal
);
2015 DEFUN ("/=", Fneq
, Sneq
, 2, 2, 0,
2016 "Return t if first arg is not equal to second arg. Both must be numbers or markers.")
2018 register Lisp_Object num1
, num2
;
2020 return arithcompare (num1
, num2
, notequal
);
2023 DEFUN ("zerop", Fzerop
, Szerop
, 1, 1, 0, "Return t if NUMBER is zero.")
2025 register Lisp_Object number
;
2027 #ifdef LISP_FLOAT_TYPE
2028 CHECK_NUMBER_OR_FLOAT (number
, 0);
2030 if (FLOATP (number
))
2032 if (XFLOAT_DATA (number
) == 0.0)
2037 CHECK_NUMBER (number
, 0);
2038 #endif /* LISP_FLOAT_TYPE */
2045 /* Convert between long values and pairs of Lisp integers. */
2051 unsigned int top
= i
>> 16;
2052 unsigned int bot
= i
& 0xFFFF;
2054 return make_number (bot
);
2055 if (top
== (unsigned long)-1 >> 16)
2056 return Fcons (make_number (-1), make_number (bot
));
2057 return Fcons (make_number (top
), make_number (bot
));
2064 Lisp_Object top
, bot
;
2071 return ((XINT (top
) << 16) | XINT (bot
));
2074 DEFUN ("number-to-string", Fnumber_to_string
, Snumber_to_string
, 1, 1, 0,
2075 "Convert NUMBER to a string by printing it in decimal.\n\
2076 Uses a minus sign if negative.\n\
2077 NUMBER may be an integer or a floating point number.")
2081 char buffer
[VALBITS
];
2083 #ifndef LISP_FLOAT_TYPE
2084 CHECK_NUMBER (number
, 0);
2086 CHECK_NUMBER_OR_FLOAT (number
, 0);
2088 if (FLOATP (number
))
2090 char pigbuf
[350]; /* see comments in float_to_string */
2092 float_to_string (pigbuf
, XFLOAT_DATA (number
));
2093 return build_string (pigbuf
);
2095 #endif /* LISP_FLOAT_TYPE */
2097 if (sizeof (int) == sizeof (EMACS_INT
))
2098 sprintf (buffer
, "%d", XINT (number
));
2099 else if (sizeof (long) == sizeof (EMACS_INT
))
2100 sprintf (buffer
, "%ld", (long) XINT (number
));
2103 return build_string (buffer
);
2107 digit_to_number (character
, base
)
2108 int character
, base
;
2112 if (character
>= '0' && character
<= '9')
2113 digit
= character
- '0';
2114 else if (character
>= 'a' && character
<= 'z')
2115 digit
= character
- 'a' + 10;
2116 else if (character
>= 'A' && character
<= 'Z')
2117 digit
= character
- 'A' + 10;
2127 DEFUN ("string-to-number", Fstring_to_number
, Sstring_to_number
, 1, 2, 0,
2128 "Convert STRING to a number by parsing it as a decimal number.\n\
2129 This parses both integers and floating point numbers.\n\
2130 It ignores leading spaces and tabs.\n\
2132 If BASE, interpret STRING as a number in that base. If BASE isn't\n\
2133 present, base 10 is used. BASE must be between 2 and 16 (inclusive).\n\
2134 If the base used is not 10, floating point is not recognized.")
2136 register Lisp_Object string
, base
;
2138 register unsigned char *p
;
2139 register int b
, v
= 0;
2142 CHECK_STRING (string
, 0);
2148 CHECK_NUMBER (base
, 1);
2150 if (b
< 2 || b
> 16)
2151 Fsignal (Qargs_out_of_range
, Fcons (base
, Qnil
));
2154 p
= XSTRING (string
)->data
;
2156 /* Skip any whitespace at the front of the number. Some versions of
2157 atoi do this anyway, so we might as well make Emacs lisp consistent. */
2158 while (*p
== ' ' || *p
== '\t')
2169 #ifdef LISP_FLOAT_TYPE
2170 if (isfloat_string (p
) && b
== 10)
2171 return make_float (negative
* atof (p
));
2172 #endif /* LISP_FLOAT_TYPE */
2176 int digit
= digit_to_number (*p
++, b
);
2182 return make_number (negative
* v
);
2187 { Aadd
, Asub
, Amult
, Adiv
, Alogand
, Alogior
, Alogxor
, Amax
, Amin
};
2189 extern Lisp_Object
float_arith_driver ();
2190 extern Lisp_Object
fmod_float ();
2193 arith_driver (code
, nargs
, args
)
2196 register Lisp_Object
*args
;
2198 register Lisp_Object val
;
2199 register int argnum
;
2200 register EMACS_INT accum
;
2201 register EMACS_INT next
;
2203 switch (SWITCH_ENUM_CAST (code
))
2216 for (argnum
= 0; argnum
< nargs
; argnum
++)
2218 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
2219 #ifdef LISP_FLOAT_TYPE
2220 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
2222 if (FLOATP (val
)) /* time to do serious math */
2223 return (float_arith_driver ((double) accum
, argnum
, code
,
2226 CHECK_NUMBER_COERCE_MARKER (val
, argnum
);
2227 #endif /* LISP_FLOAT_TYPE */
2228 args
[argnum
] = val
; /* runs into a compiler bug. */
2229 next
= XINT (args
[argnum
]);
2230 switch (SWITCH_ENUM_CAST (code
))
2232 case Aadd
: accum
+= next
; break;
2234 accum
= argnum
? accum
- next
: nargs
== 1 ? - next
: next
;
2236 case Amult
: accum
*= next
; break;
2238 if (!argnum
) accum
= next
;
2242 Fsignal (Qarith_error
, Qnil
);
2246 case Alogand
: accum
&= next
; break;
2247 case Alogior
: accum
|= next
; break;
2248 case Alogxor
: accum
^= next
; break;
2249 case Amax
: if (!argnum
|| next
> accum
) accum
= next
; break;
2250 case Amin
: if (!argnum
|| next
< accum
) accum
= next
; break;
2254 XSETINT (val
, accum
);
2259 #define isnan(x) ((x) != (x))
2261 #ifdef LISP_FLOAT_TYPE
2264 float_arith_driver (accum
, argnum
, code
, nargs
, args
)
2266 register int argnum
;
2269 register Lisp_Object
*args
;
2271 register Lisp_Object val
;
2274 for (; argnum
< nargs
; argnum
++)
2276 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
2277 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
2281 next
= XFLOAT_DATA (val
);
2285 args
[argnum
] = val
; /* runs into a compiler bug. */
2286 next
= XINT (args
[argnum
]);
2288 switch (SWITCH_ENUM_CAST (code
))
2294 accum
= argnum
? accum
- next
: nargs
== 1 ? - next
: next
;
2304 if (! IEEE_FLOATING_POINT
&& next
== 0)
2305 Fsignal (Qarith_error
, Qnil
);
2312 return wrong_type_argument (Qinteger_or_marker_p
, val
);
2314 if (!argnum
|| isnan (next
) || next
> accum
)
2318 if (!argnum
|| isnan (next
) || next
< accum
)
2324 return make_float (accum
);
2326 #endif /* LISP_FLOAT_TYPE */
2328 DEFUN ("+", Fplus
, Splus
, 0, MANY
, 0,
2329 "Return sum of any number of arguments, which are numbers or markers.")
2334 return arith_driver (Aadd
, nargs
, args
);
2337 DEFUN ("-", Fminus
, Sminus
, 0, MANY
, 0,
2338 "Negate number or subtract numbers or markers.\n\
2339 With one arg, negates it. With more than one arg,\n\
2340 subtracts all but the first from the first.")
2345 return arith_driver (Asub
, nargs
, args
);
2348 DEFUN ("*", Ftimes
, Stimes
, 0, MANY
, 0,
2349 "Returns product of any number of arguments, which are numbers or markers.")
2354 return arith_driver (Amult
, nargs
, args
);
2357 DEFUN ("/", Fquo
, Squo
, 2, MANY
, 0,
2358 "Returns first argument divided by all the remaining arguments.\n\
2359 The arguments must be numbers or markers.")
2364 return arith_driver (Adiv
, nargs
, args
);
2367 DEFUN ("%", Frem
, Srem
, 2, 2, 0,
2368 "Returns remainder of X divided by Y.\n\
2369 Both must be integers or markers.")
2371 register Lisp_Object x
, y
;
2375 CHECK_NUMBER_COERCE_MARKER (x
, 0);
2376 CHECK_NUMBER_COERCE_MARKER (y
, 1);
2378 if (XFASTINT (y
) == 0)
2379 Fsignal (Qarith_error
, Qnil
);
2381 XSETINT (val
, XINT (x
) % XINT (y
));
2395 /* If the magnitude of the result exceeds that of the divisor, or
2396 the sign of the result does not agree with that of the dividend,
2397 iterate with the reduced value. This does not yield a
2398 particularly accurate result, but at least it will be in the
2399 range promised by fmod. */
2401 r
-= f2
* floor (r
/ f2
);
2402 while (f2
<= (r
< 0 ? -r
: r
) || ((r
< 0) != (f1
< 0) && ! isnan (r
)));
2406 #endif /* ! HAVE_FMOD */
2408 DEFUN ("mod", Fmod
, Smod
, 2, 2, 0,
2409 "Returns X modulo Y.\n\
2410 The result falls between zero (inclusive) and Y (exclusive).\n\
2411 Both X and Y must be numbers or markers.")
2413 register Lisp_Object x
, y
;
2418 #ifdef LISP_FLOAT_TYPE
2419 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (x
, 0);
2420 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (y
, 1);
2422 if (FLOATP (x
) || FLOATP (y
))
2423 return fmod_float (x
, y
);
2425 #else /* not LISP_FLOAT_TYPE */
2426 CHECK_NUMBER_COERCE_MARKER (x
, 0);
2427 CHECK_NUMBER_COERCE_MARKER (y
, 1);
2428 #endif /* not LISP_FLOAT_TYPE */
2434 Fsignal (Qarith_error
, Qnil
);
2438 /* If the "remainder" comes out with the wrong sign, fix it. */
2439 if (i2
< 0 ? i1
> 0 : i1
< 0)
2446 DEFUN ("max", Fmax
, Smax
, 1, MANY
, 0,
2447 "Return largest of all the arguments (which must be numbers or markers).\n\
2448 The value is always a number; markers are converted to numbers.")
2453 return arith_driver (Amax
, nargs
, args
);
2456 DEFUN ("min", Fmin
, Smin
, 1, MANY
, 0,
2457 "Return smallest of all the arguments (which must be numbers or markers).\n\
2458 The value is always a number; markers are converted to numbers.")
2463 return arith_driver (Amin
, nargs
, args
);
2466 DEFUN ("logand", Flogand
, Slogand
, 0, MANY
, 0,
2467 "Return bitwise-and of all the arguments.\n\
2468 Arguments may be integers, or markers converted to integers.")
2473 return arith_driver (Alogand
, nargs
, args
);
2476 DEFUN ("logior", Flogior
, Slogior
, 0, MANY
, 0,
2477 "Return bitwise-or of all the arguments.\n\
2478 Arguments may be integers, or markers converted to integers.")
2483 return arith_driver (Alogior
, nargs
, args
);
2486 DEFUN ("logxor", Flogxor
, Slogxor
, 0, MANY
, 0,
2487 "Return bitwise-exclusive-or of all the arguments.\n\
2488 Arguments may be integers, or markers converted to integers.")
2493 return arith_driver (Alogxor
, nargs
, args
);
2496 DEFUN ("ash", Fash
, Sash
, 2, 2, 0,
2497 "Return VALUE with its bits shifted left by COUNT.\n\
2498 If COUNT is negative, shifting is actually to the right.\n\
2499 In this case, the sign bit is duplicated.")
2501 register Lisp_Object value
, count
;
2503 register Lisp_Object val
;
2505 CHECK_NUMBER (value
, 0);
2506 CHECK_NUMBER (count
, 1);
2508 if (XINT (count
) >= BITS_PER_EMACS_INT
)
2510 else if (XINT (count
) > 0)
2511 XSETINT (val
, XINT (value
) << XFASTINT (count
));
2512 else if (XINT (count
) <= -BITS_PER_EMACS_INT
)
2513 XSETINT (val
, XINT (value
) < 0 ? -1 : 0);
2515 XSETINT (val
, XINT (value
) >> -XINT (count
));
2519 DEFUN ("lsh", Flsh
, Slsh
, 2, 2, 0,
2520 "Return VALUE with its bits shifted left by COUNT.\n\
2521 If COUNT is negative, shifting is actually to the right.\n\
2522 In this case, zeros are shifted in on the left.")
2524 register Lisp_Object value
, count
;
2526 register Lisp_Object val
;
2528 CHECK_NUMBER (value
, 0);
2529 CHECK_NUMBER (count
, 1);
2531 if (XINT (count
) >= BITS_PER_EMACS_INT
)
2533 else if (XINT (count
) > 0)
2534 XSETINT (val
, (EMACS_UINT
) XUINT (value
) << XFASTINT (count
));
2535 else if (XINT (count
) <= -BITS_PER_EMACS_INT
)
2538 XSETINT (val
, (EMACS_UINT
) XUINT (value
) >> -XINT (count
));
2542 DEFUN ("1+", Fadd1
, Sadd1
, 1, 1, 0,
2543 "Return NUMBER plus one. NUMBER may be a number or a marker.\n\
2544 Markers are converted to integers.")
2546 register Lisp_Object number
;
2548 #ifdef LISP_FLOAT_TYPE
2549 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number
, 0);
2551 if (FLOATP (number
))
2552 return (make_float (1.0 + XFLOAT_DATA (number
)));
2554 CHECK_NUMBER_COERCE_MARKER (number
, 0);
2555 #endif /* LISP_FLOAT_TYPE */
2557 XSETINT (number
, XINT (number
) + 1);
2561 DEFUN ("1-", Fsub1
, Ssub1
, 1, 1, 0,
2562 "Return NUMBER minus one. NUMBER may be a number or a marker.\n\
2563 Markers are converted to integers.")
2565 register Lisp_Object number
;
2567 #ifdef LISP_FLOAT_TYPE
2568 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number
, 0);
2570 if (FLOATP (number
))
2571 return (make_float (-1.0 + XFLOAT_DATA (number
)));
2573 CHECK_NUMBER_COERCE_MARKER (number
, 0);
2574 #endif /* LISP_FLOAT_TYPE */
2576 XSETINT (number
, XINT (number
) - 1);
2580 DEFUN ("lognot", Flognot
, Slognot
, 1, 1, 0,
2581 "Return the bitwise complement of NUMBER. NUMBER must be an integer.")
2583 register Lisp_Object number
;
2585 CHECK_NUMBER (number
, 0);
2586 XSETINT (number
, ~XINT (number
));
2593 Lisp_Object error_tail
, arith_tail
;
2595 Qquote
= intern ("quote");
2596 Qlambda
= intern ("lambda");
2597 Qsubr
= intern ("subr");
2598 Qerror_conditions
= intern ("error-conditions");
2599 Qerror_message
= intern ("error-message");
2600 Qtop_level
= intern ("top-level");
2602 Qerror
= intern ("error");
2603 Qquit
= intern ("quit");
2604 Qwrong_type_argument
= intern ("wrong-type-argument");
2605 Qargs_out_of_range
= intern ("args-out-of-range");
2606 Qvoid_function
= intern ("void-function");
2607 Qcyclic_function_indirection
= intern ("cyclic-function-indirection");
2608 Qvoid_variable
= intern ("void-variable");
2609 Qsetting_constant
= intern ("setting-constant");
2610 Qinvalid_read_syntax
= intern ("invalid-read-syntax");
2612 Qinvalid_function
= intern ("invalid-function");
2613 Qwrong_number_of_arguments
= intern ("wrong-number-of-arguments");
2614 Qno_catch
= intern ("no-catch");
2615 Qend_of_file
= intern ("end-of-file");
2616 Qarith_error
= intern ("arith-error");
2617 Qbeginning_of_buffer
= intern ("beginning-of-buffer");
2618 Qend_of_buffer
= intern ("end-of-buffer");
2619 Qbuffer_read_only
= intern ("buffer-read-only");
2620 Qtext_read_only
= intern ("text-read-only");
2621 Qmark_inactive
= intern ("mark-inactive");
2623 Qlistp
= intern ("listp");
2624 Qconsp
= intern ("consp");
2625 Qsymbolp
= intern ("symbolp");
2626 Qkeywordp
= intern ("keywordp");
2627 Qintegerp
= intern ("integerp");
2628 Qnatnump
= intern ("natnump");
2629 Qwholenump
= intern ("wholenump");
2630 Qstringp
= intern ("stringp");
2631 Qarrayp
= intern ("arrayp");
2632 Qsequencep
= intern ("sequencep");
2633 Qbufferp
= intern ("bufferp");
2634 Qvectorp
= intern ("vectorp");
2635 Qchar_or_string_p
= intern ("char-or-string-p");
2636 Qmarkerp
= intern ("markerp");
2637 Qbuffer_or_string_p
= intern ("buffer-or-string-p");
2638 Qinteger_or_marker_p
= intern ("integer-or-marker-p");
2639 Qboundp
= intern ("boundp");
2640 Qfboundp
= intern ("fboundp");
2642 #ifdef LISP_FLOAT_TYPE
2643 Qfloatp
= intern ("floatp");
2644 Qnumberp
= intern ("numberp");
2645 Qnumber_or_marker_p
= intern ("number-or-marker-p");
2646 #endif /* LISP_FLOAT_TYPE */
2648 Qchar_table_p
= intern ("char-table-p");
2649 Qvector_or_char_table_p
= intern ("vector-or-char-table-p");
2651 Qcdr
= intern ("cdr");
2653 /* Handle automatic advice activation */
2654 Qad_advice_info
= intern ("ad-advice-info");
2655 Qad_activate_internal
= intern ("ad-activate-internal");
2657 error_tail
= Fcons (Qerror
, Qnil
);
2659 /* ERROR is used as a signaler for random errors for which nothing else is right */
2661 Fput (Qerror
, Qerror_conditions
,
2663 Fput (Qerror
, Qerror_message
,
2664 build_string ("error"));
2666 Fput (Qquit
, Qerror_conditions
,
2667 Fcons (Qquit
, Qnil
));
2668 Fput (Qquit
, Qerror_message
,
2669 build_string ("Quit"));
2671 Fput (Qwrong_type_argument
, Qerror_conditions
,
2672 Fcons (Qwrong_type_argument
, error_tail
));
2673 Fput (Qwrong_type_argument
, Qerror_message
,
2674 build_string ("Wrong type argument"));
2676 Fput (Qargs_out_of_range
, Qerror_conditions
,
2677 Fcons (Qargs_out_of_range
, error_tail
));
2678 Fput (Qargs_out_of_range
, Qerror_message
,
2679 build_string ("Args out of range"));
2681 Fput (Qvoid_function
, Qerror_conditions
,
2682 Fcons (Qvoid_function
, error_tail
));
2683 Fput (Qvoid_function
, Qerror_message
,
2684 build_string ("Symbol's function definition is void"));
2686 Fput (Qcyclic_function_indirection
, Qerror_conditions
,
2687 Fcons (Qcyclic_function_indirection
, error_tail
));
2688 Fput (Qcyclic_function_indirection
, Qerror_message
,
2689 build_string ("Symbol's chain of function indirections contains a loop"));
2691 Fput (Qvoid_variable
, Qerror_conditions
,
2692 Fcons (Qvoid_variable
, error_tail
));
2693 Fput (Qvoid_variable
, Qerror_message
,
2694 build_string ("Symbol's value as variable is void"));
2696 Fput (Qsetting_constant
, Qerror_conditions
,
2697 Fcons (Qsetting_constant
, error_tail
));
2698 Fput (Qsetting_constant
, Qerror_message
,
2699 build_string ("Attempt to set a constant symbol"));
2701 Fput (Qinvalid_read_syntax
, Qerror_conditions
,
2702 Fcons (Qinvalid_read_syntax
, error_tail
));
2703 Fput (Qinvalid_read_syntax
, Qerror_message
,
2704 build_string ("Invalid read syntax"));
2706 Fput (Qinvalid_function
, Qerror_conditions
,
2707 Fcons (Qinvalid_function
, error_tail
));
2708 Fput (Qinvalid_function
, Qerror_message
,
2709 build_string ("Invalid function"));
2711 Fput (Qwrong_number_of_arguments
, Qerror_conditions
,
2712 Fcons (Qwrong_number_of_arguments
, error_tail
));
2713 Fput (Qwrong_number_of_arguments
, Qerror_message
,
2714 build_string ("Wrong number of arguments"));
2716 Fput (Qno_catch
, Qerror_conditions
,
2717 Fcons (Qno_catch
, error_tail
));
2718 Fput (Qno_catch
, Qerror_message
,
2719 build_string ("No catch for tag"));
2721 Fput (Qend_of_file
, Qerror_conditions
,
2722 Fcons (Qend_of_file
, error_tail
));
2723 Fput (Qend_of_file
, Qerror_message
,
2724 build_string ("End of file during parsing"));
2726 arith_tail
= Fcons (Qarith_error
, error_tail
);
2727 Fput (Qarith_error
, Qerror_conditions
,
2729 Fput (Qarith_error
, Qerror_message
,
2730 build_string ("Arithmetic error"));
2732 Fput (Qbeginning_of_buffer
, Qerror_conditions
,
2733 Fcons (Qbeginning_of_buffer
, error_tail
));
2734 Fput (Qbeginning_of_buffer
, Qerror_message
,
2735 build_string ("Beginning of buffer"));
2737 Fput (Qend_of_buffer
, Qerror_conditions
,
2738 Fcons (Qend_of_buffer
, error_tail
));
2739 Fput (Qend_of_buffer
, Qerror_message
,
2740 build_string ("End of buffer"));
2742 Fput (Qbuffer_read_only
, Qerror_conditions
,
2743 Fcons (Qbuffer_read_only
, error_tail
));
2744 Fput (Qbuffer_read_only
, Qerror_message
,
2745 build_string ("Buffer is read-only"));
2747 Fput (Qtext_read_only
, Qerror_conditions
,
2748 Fcons (Qtext_read_only
, error_tail
));
2749 Fput (Qtext_read_only
, Qerror_message
,
2750 build_string ("Text is read-only"));
2752 #ifdef LISP_FLOAT_TYPE
2753 Qrange_error
= intern ("range-error");
2754 Qdomain_error
= intern ("domain-error");
2755 Qsingularity_error
= intern ("singularity-error");
2756 Qoverflow_error
= intern ("overflow-error");
2757 Qunderflow_error
= intern ("underflow-error");
2759 Fput (Qdomain_error
, Qerror_conditions
,
2760 Fcons (Qdomain_error
, arith_tail
));
2761 Fput (Qdomain_error
, Qerror_message
,
2762 build_string ("Arithmetic domain error"));
2764 Fput (Qrange_error
, Qerror_conditions
,
2765 Fcons (Qrange_error
, arith_tail
));
2766 Fput (Qrange_error
, Qerror_message
,
2767 build_string ("Arithmetic range error"));
2769 Fput (Qsingularity_error
, Qerror_conditions
,
2770 Fcons (Qsingularity_error
, Fcons (Qdomain_error
, arith_tail
)));
2771 Fput (Qsingularity_error
, Qerror_message
,
2772 build_string ("Arithmetic singularity error"));
2774 Fput (Qoverflow_error
, Qerror_conditions
,
2775 Fcons (Qoverflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2776 Fput (Qoverflow_error
, Qerror_message
,
2777 build_string ("Arithmetic overflow error"));
2779 Fput (Qunderflow_error
, Qerror_conditions
,
2780 Fcons (Qunderflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2781 Fput (Qunderflow_error
, Qerror_message
,
2782 build_string ("Arithmetic underflow error"));
2784 staticpro (&Qrange_error
);
2785 staticpro (&Qdomain_error
);
2786 staticpro (&Qsingularity_error
);
2787 staticpro (&Qoverflow_error
);
2788 staticpro (&Qunderflow_error
);
2789 #endif /* LISP_FLOAT_TYPE */
2793 staticpro (&Qquote
);
2794 staticpro (&Qlambda
);
2796 staticpro (&Qunbound
);
2797 staticpro (&Qerror_conditions
);
2798 staticpro (&Qerror_message
);
2799 staticpro (&Qtop_level
);
2801 staticpro (&Qerror
);
2803 staticpro (&Qwrong_type_argument
);
2804 staticpro (&Qargs_out_of_range
);
2805 staticpro (&Qvoid_function
);
2806 staticpro (&Qcyclic_function_indirection
);
2807 staticpro (&Qvoid_variable
);
2808 staticpro (&Qsetting_constant
);
2809 staticpro (&Qinvalid_read_syntax
);
2810 staticpro (&Qwrong_number_of_arguments
);
2811 staticpro (&Qinvalid_function
);
2812 staticpro (&Qno_catch
);
2813 staticpro (&Qend_of_file
);
2814 staticpro (&Qarith_error
);
2815 staticpro (&Qbeginning_of_buffer
);
2816 staticpro (&Qend_of_buffer
);
2817 staticpro (&Qbuffer_read_only
);
2818 staticpro (&Qtext_read_only
);
2819 staticpro (&Qmark_inactive
);
2821 staticpro (&Qlistp
);
2822 staticpro (&Qconsp
);
2823 staticpro (&Qsymbolp
);
2824 staticpro (&Qkeywordp
);
2825 staticpro (&Qintegerp
);
2826 staticpro (&Qnatnump
);
2827 staticpro (&Qwholenump
);
2828 staticpro (&Qstringp
);
2829 staticpro (&Qarrayp
);
2830 staticpro (&Qsequencep
);
2831 staticpro (&Qbufferp
);
2832 staticpro (&Qvectorp
);
2833 staticpro (&Qchar_or_string_p
);
2834 staticpro (&Qmarkerp
);
2835 staticpro (&Qbuffer_or_string_p
);
2836 staticpro (&Qinteger_or_marker_p
);
2837 #ifdef LISP_FLOAT_TYPE
2838 staticpro (&Qfloatp
);
2839 staticpro (&Qnumberp
);
2840 staticpro (&Qnumber_or_marker_p
);
2841 #endif /* LISP_FLOAT_TYPE */
2842 staticpro (&Qchar_table_p
);
2843 staticpro (&Qvector_or_char_table_p
);
2845 staticpro (&Qboundp
);
2846 staticpro (&Qfboundp
);
2848 staticpro (&Qad_advice_info
);
2849 staticpro (&Qad_activate_internal
);
2851 /* Types that type-of returns. */
2852 Qinteger
= intern ("integer");
2853 Qsymbol
= intern ("symbol");
2854 Qstring
= intern ("string");
2855 Qcons
= intern ("cons");
2856 Qmarker
= intern ("marker");
2857 Qoverlay
= intern ("overlay");
2858 Qfloat
= intern ("float");
2859 Qwindow_configuration
= intern ("window-configuration");
2860 Qprocess
= intern ("process");
2861 Qwindow
= intern ("window");
2862 /* Qsubr = intern ("subr"); */
2863 Qcompiled_function
= intern ("compiled-function");
2864 Qbuffer
= intern ("buffer");
2865 Qframe
= intern ("frame");
2866 Qvector
= intern ("vector");
2867 Qchar_table
= intern ("char-table");
2868 Qbool_vector
= intern ("bool-vector");
2869 Qhash_table
= intern ("hash-table");
2871 staticpro (&Qinteger
);
2872 staticpro (&Qsymbol
);
2873 staticpro (&Qstring
);
2875 staticpro (&Qmarker
);
2876 staticpro (&Qoverlay
);
2877 staticpro (&Qfloat
);
2878 staticpro (&Qwindow_configuration
);
2879 staticpro (&Qprocess
);
2880 staticpro (&Qwindow
);
2881 /* staticpro (&Qsubr); */
2882 staticpro (&Qcompiled_function
);
2883 staticpro (&Qbuffer
);
2884 staticpro (&Qframe
);
2885 staticpro (&Qvector
);
2886 staticpro (&Qchar_table
);
2887 staticpro (&Qbool_vector
);
2888 staticpro (&Qhash_table
);
2890 DEFVAR_BOOL ("keyword-symbols-constant-flag", &keyword_symbols_constant_flag
,
2891 "Non-nil means it is an error to set a keyword symbol.\n\
2892 A keyword symbol is a symbol whose name starts with a colon (`:').");
2893 keyword_symbols_constant_flag
= 1;
2897 defsubr (&Stype_of
);
2902 defsubr (&Sintegerp
);
2903 defsubr (&Sinteger_or_marker_p
);
2904 defsubr (&Snumberp
);
2905 defsubr (&Snumber_or_marker_p
);
2906 #ifdef LISP_FLOAT_TYPE
2908 #endif /* LISP_FLOAT_TYPE */
2909 defsubr (&Snatnump
);
2910 defsubr (&Ssymbolp
);
2911 defsubr (&Skeywordp
);
2912 defsubr (&Sstringp
);
2913 defsubr (&Smultibyte_string_p
);
2914 defsubr (&Svectorp
);
2915 defsubr (&Schar_table_p
);
2916 defsubr (&Svector_or_char_table_p
);
2917 defsubr (&Sbool_vector_p
);
2919 defsubr (&Ssequencep
);
2920 defsubr (&Sbufferp
);
2921 defsubr (&Smarkerp
);
2923 defsubr (&Sbyte_code_function_p
);
2924 defsubr (&Schar_or_string_p
);
2927 defsubr (&Scar_safe
);
2928 defsubr (&Scdr_safe
);
2931 defsubr (&Ssymbol_function
);
2932 defsubr (&Sindirect_function
);
2933 defsubr (&Ssymbol_plist
);
2934 defsubr (&Ssymbol_name
);
2935 defsubr (&Smakunbound
);
2936 defsubr (&Sfmakunbound
);
2938 defsubr (&Sfboundp
);
2940 defsubr (&Sdefalias
);
2941 defsubr (&Ssetplist
);
2942 defsubr (&Ssymbol_value
);
2944 defsubr (&Sdefault_boundp
);
2945 defsubr (&Sdefault_value
);
2946 defsubr (&Sset_default
);
2947 defsubr (&Ssetq_default
);
2948 defsubr (&Smake_variable_buffer_local
);
2949 defsubr (&Smake_local_variable
);
2950 defsubr (&Skill_local_variable
);
2951 defsubr (&Smake_variable_frame_local
);
2952 defsubr (&Slocal_variable_p
);
2953 defsubr (&Slocal_variable_if_set_p
);
2956 defsubr (&Snumber_to_string
);
2957 defsubr (&Sstring_to_number
);
2958 defsubr (&Seqlsign
);
2982 XSYMBOL (Qwholenump
)->function
= XSYMBOL (Qnatnump
)->function
;
2989 #if defined(USG) && !defined(POSIX_SIGNALS)
2990 /* USG systems forget handlers when they are used;
2991 must reestablish each time */
2992 signal (signo
, arith_error
);
2995 /* VMS systems are like USG. */
2996 signal (signo
, arith_error
);
3000 #else /* not BSD4_1 */
3001 sigsetmask (SIGEMPTYMASK
);
3002 #endif /* not BSD4_1 */
3004 Fsignal (Qarith_error
, Qnil
);
3010 /* Don't do this if just dumping out.
3011 We don't want to call `signal' in this case
3012 so that we don't have trouble with dumping
3013 signal-delivering routines in an inconsistent state. */
3017 #endif /* CANNOT_DUMP */
3018 signal (SIGFPE
, arith_error
);
3021 signal (SIGEMT
, arith_error
);