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_frame
1047 ? !EQ (selected_frame
, XBUFFER_LOCAL_VALUE (valcontents
)->frame
)
1048 : (buf
!= XBUFFER (XBUFFER_LOCAL_VALUE (valcontents
)->buffer
)
1049 || (BUFFER_LOCAL_VALUEP (valcontents
)
1050 && EQ (XCAR (current_alist_element
),
1051 current_alist_element
))))
1053 /* Write out the cached value for the old buffer; copy it
1054 back to its alist element. This works if the current
1055 buffer only sees the default value, too. */
1056 Fsetcdr (current_alist_element
,
1057 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
));
1059 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1060 tem1
= Fassq (symbol
, buf
->local_var_alist
);
1061 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 1;
1062 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 0;
1066 /* This buffer still sees the default value. */
1068 /* If the variable is a Lisp_Some_Buffer_Local_Value,
1069 or if this is `let' rather than `set',
1070 make CURRENT-ALIST-ELEMENT point to itself,
1071 indicating that we're seeing the default value. */
1072 if (bindflag
|| SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1074 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
1076 if (XBUFFER_LOCAL_VALUE (valcontents
)->check_frame
)
1077 tem1
= Fassq (symbol
,
1078 XFRAME (selected_frame
)->param_alist
);
1081 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 1;
1083 tem1
= XBUFFER_LOCAL_VALUE (valcontents
)->cdr
;
1085 /* If it's a Lisp_Buffer_Local_Value, being set not bound,
1086 give this buffer a new assoc for a local value and set
1087 CURRENT-ALIST-ELEMENT to point to that. */
1090 tem1
= Fcons (symbol
, Fcdr (current_alist_element
));
1091 buf
->local_var_alist
1092 = Fcons (tem1
, buf
->local_var_alist
);
1096 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1097 XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
)
1100 /* Set BUFFER and FRAME for binding now loaded. */
1101 XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents
)->buffer
, buf
);
1102 XBUFFER_LOCAL_VALUE (valcontents
)->frame
= selected_frame
;
1104 valcontents
= XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
;
1107 /* If storing void (making the symbol void), forward only through
1108 buffer-local indicator, not through Lisp_Objfwd, etc. */
1110 store_symval_forwarding (symbol
, Qnil
, newval
);
1112 store_symval_forwarding (symbol
, valcontents
, newval
);
1117 /* Access or set a buffer-local symbol's default value. */
1119 /* Return the default value of SYMBOL, but don't check for voidness.
1120 Return Qunbound if it is void. */
1123 default_value (symbol
)
1126 register Lisp_Object valcontents
;
1128 CHECK_SYMBOL (symbol
, 0);
1129 valcontents
= XSYMBOL (symbol
)->value
;
1131 /* For a built-in buffer-local variable, get the default value
1132 rather than letting do_symval_forwarding get the current value. */
1133 if (BUFFER_OBJFWDP (valcontents
))
1135 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1137 if (XINT (*(Lisp_Object
*) (idx
+ (char *) &buffer_local_flags
)) != 0)
1138 return *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
1141 /* Handle user-created local variables. */
1142 if (BUFFER_LOCAL_VALUEP (valcontents
)
1143 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1145 /* If var is set up for a buffer that lacks a local value for it,
1146 the current value is nominally the default value.
1147 But the current value slot may be more up to date, since
1148 ordinary setq stores just that slot. So use that. */
1149 Lisp_Object current_alist_element
, alist_element_car
;
1150 current_alist_element
1151 = XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
1152 alist_element_car
= XCAR (current_alist_element
);
1153 if (EQ (alist_element_car
, current_alist_element
))
1154 return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
);
1156 return XCDR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
1158 /* For other variables, get the current value. */
1159 return do_symval_forwarding (valcontents
);
1162 DEFUN ("default-boundp", Fdefault_boundp
, Sdefault_boundp
, 1, 1, 0,
1163 "Return t if SYMBOL has a non-void default value.\n\
1164 This is the value that is seen in buffers that do not have their own values\n\
1165 for this variable.")
1169 register Lisp_Object value
;
1171 value
= default_value (symbol
);
1172 return (EQ (value
, Qunbound
) ? Qnil
: Qt
);
1175 DEFUN ("default-value", Fdefault_value
, Sdefault_value
, 1, 1, 0,
1176 "Return SYMBOL's default value.\n\
1177 This is the value that is seen in buffers that do not have their own values\n\
1178 for this variable. The default value is meaningful for variables with\n\
1179 local bindings in certain buffers.")
1183 register Lisp_Object value
;
1185 value
= default_value (symbol
);
1186 if (EQ (value
, Qunbound
))
1187 return Fsignal (Qvoid_variable
, Fcons (symbol
, Qnil
));
1191 DEFUN ("set-default", Fset_default
, Sset_default
, 2, 2, 0,
1192 "Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.\n\
1193 The default value is seen in buffers that do not have their own values\n\
1194 for this variable.")
1196 Lisp_Object symbol
, value
;
1198 register Lisp_Object valcontents
, current_alist_element
, alist_element_buffer
;
1200 CHECK_SYMBOL (symbol
, 0);
1201 valcontents
= XSYMBOL (symbol
)->value
;
1203 /* Handle variables like case-fold-search that have special slots
1204 in the buffer. Make them work apparently like Lisp_Buffer_Local_Value
1206 if (BUFFER_OBJFWDP (valcontents
))
1208 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1209 register struct buffer
*b
;
1210 register int mask
= XINT (*((Lisp_Object
*)
1211 (idx
+ (char *)&buffer_local_flags
)));
1213 *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
) = value
;
1215 /* If this variable is not always local in all buffers,
1216 set it in the buffers that don't nominally have a local value. */
1219 for (b
= all_buffers
; b
; b
= b
->next
)
1220 if (!(b
->local_var_flags
& mask
))
1221 *(Lisp_Object
*)(idx
+ (char *) b
) = value
;
1226 if (!BUFFER_LOCAL_VALUEP (valcontents
)
1227 && !SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1228 return Fset (symbol
, value
);
1230 /* Store new value into the DEFAULT-VALUE slot */
1231 XCDR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
) = value
;
1233 /* If that slot is current, we must set the REALVALUE slot too */
1234 current_alist_element
1235 = XCAR (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
);
1236 alist_element_buffer
= Fcar (current_alist_element
);
1237 if (EQ (alist_element_buffer
, current_alist_element
))
1238 store_symval_forwarding (symbol
, XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
,
1244 DEFUN ("setq-default", Fsetq_default
, Ssetq_default
, 2, UNEVALLED
, 0,
1245 "Set the default value of variable VAR to VALUE.\n\
1246 VAR, the variable name, is literal (not evaluated);\n\
1247 VALUE is an expression and it is evaluated.\n\
1248 The default value of a variable is seen in buffers\n\
1249 that do not have their own values for the variable.\n\
1251 More generally, you can use multiple variables and values, as in\n\
1252 (setq-default SYMBOL VALUE SYMBOL VALUE...)\n\
1253 This sets each SYMBOL's default value to the corresponding VALUE.\n\
1254 The VALUE for the Nth SYMBOL can refer to the new default values\n\
1259 register Lisp_Object args_left
;
1260 register Lisp_Object val
, symbol
;
1261 struct gcpro gcpro1
;
1271 val
= Feval (Fcar (Fcdr (args_left
)));
1272 symbol
= Fcar (args_left
);
1273 Fset_default (symbol
, val
);
1274 args_left
= Fcdr (Fcdr (args_left
));
1276 while (!NILP (args_left
));
1282 /* Lisp functions for creating and removing buffer-local variables. */
1284 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local
, Smake_variable_buffer_local
,
1285 1, 1, "vMake Variable Buffer Local: ",
1286 "Make VARIABLE have a separate value for each buffer.\n\
1287 At any time, the value for the current buffer is in effect.\n\
1288 There is also a default value which is seen in any buffer which has not yet\n\
1289 set its own value.\n\
1290 Using `set' or `setq' to set the variable causes it to have a separate value\n\
1291 for the current buffer if it was previously using the default value.\n\
1292 The function `default-value' gets the default value and `set-default' sets it.")
1294 register Lisp_Object variable
;
1296 register Lisp_Object tem
, valcontents
, newval
;
1298 CHECK_SYMBOL (variable
, 0);
1300 valcontents
= XSYMBOL (variable
)->value
;
1301 if (EQ (variable
, Qnil
) || EQ (variable
, Qt
) || KBOARD_OBJFWDP (valcontents
))
1302 error ("Symbol %s may not be buffer-local", XSYMBOL (variable
)->name
->data
);
1304 if (BUFFER_LOCAL_VALUEP (valcontents
) || BUFFER_OBJFWDP (valcontents
))
1306 if (SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1308 XMISCTYPE (XSYMBOL (variable
)->value
) = Lisp_Misc_Buffer_Local_Value
;
1311 if (EQ (valcontents
, Qunbound
))
1312 XSYMBOL (variable
)->value
= Qnil
;
1313 tem
= Fcons (Qnil
, Fsymbol_value (variable
));
1315 newval
= allocate_misc ();
1316 XMISCTYPE (newval
) = Lisp_Misc_Buffer_Local_Value
;
1317 XBUFFER_LOCAL_VALUE (newval
)->realvalue
= XSYMBOL (variable
)->value
;
1318 XBUFFER_LOCAL_VALUE (newval
)->buffer
= Fcurrent_buffer ();
1319 XBUFFER_LOCAL_VALUE (newval
)->frame
= Qnil
;
1320 XBUFFER_LOCAL_VALUE (newval
)->found_for_buffer
= 1;
1321 XBUFFER_LOCAL_VALUE (newval
)->found_for_frame
= 0;
1322 XBUFFER_LOCAL_VALUE (newval
)->check_frame
= 0;
1323 XBUFFER_LOCAL_VALUE (newval
)->cdr
= tem
;
1324 XSYMBOL (variable
)->value
= newval
;
1328 DEFUN ("make-local-variable", Fmake_local_variable
, Smake_local_variable
,
1329 1, 1, "vMake Local Variable: ",
1330 "Make VARIABLE have a separate value in the current buffer.\n\
1331 Other buffers will continue to share a common default value.\n\
1332 \(The buffer-local value of VARIABLE starts out as the same value\n\
1333 VARIABLE previously had. If VARIABLE was void, it remains void.\)\n\
1334 See also `make-variable-buffer-local'.\n\
1336 If the variable is already arranged to become local when set,\n\
1337 this function causes a local value to exist for this buffer,\n\
1338 just as setting the variable would do.\n\
1340 This function returns VARIABLE, and therefore\n\
1341 (set (make-local-variable 'VARIABLE) VALUE-EXP)\n\
1344 Do not use `make-local-variable' to make a hook variable buffer-local.\n\
1345 Use `make-local-hook' instead.")
1347 register Lisp_Object variable
;
1349 register Lisp_Object tem
, valcontents
;
1351 CHECK_SYMBOL (variable
, 0);
1353 valcontents
= XSYMBOL (variable
)->value
;
1354 if (EQ (variable
, Qnil
) || EQ (variable
, Qt
) || KBOARD_OBJFWDP (valcontents
))
1355 error ("Symbol %s may not be buffer-local", XSYMBOL (variable
)->name
->data
);
1357 if (BUFFER_LOCAL_VALUEP (valcontents
) || BUFFER_OBJFWDP (valcontents
))
1359 tem
= Fboundp (variable
);
1361 /* Make sure the symbol has a local value in this particular buffer,
1362 by setting it to the same value it already has. */
1363 Fset (variable
, (EQ (tem
, Qt
) ? Fsymbol_value (variable
) : Qunbound
));
1366 /* Make sure symbol is set up to hold per-buffer values */
1367 if (!SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1370 tem
= Fcons (Qnil
, do_symval_forwarding (valcontents
));
1372 newval
= allocate_misc ();
1373 XMISCTYPE (newval
) = Lisp_Misc_Some_Buffer_Local_Value
;
1374 XBUFFER_LOCAL_VALUE (newval
)->realvalue
= XSYMBOL (variable
)->value
;
1375 XBUFFER_LOCAL_VALUE (newval
)->buffer
= Qnil
;
1376 XBUFFER_LOCAL_VALUE (newval
)->frame
= Qnil
;
1377 XBUFFER_LOCAL_VALUE (newval
)->found_for_buffer
= 0;
1378 XBUFFER_LOCAL_VALUE (newval
)->found_for_frame
= 0;
1379 XBUFFER_LOCAL_VALUE (newval
)->check_frame
= 0;
1380 XBUFFER_LOCAL_VALUE (newval
)->cdr
= tem
;
1381 XSYMBOL (variable
)->value
= newval
;
1383 /* Make sure this buffer has its own value of symbol */
1384 tem
= Fassq (variable
, current_buffer
->local_var_alist
);
1387 /* Swap out any local binding for some other buffer, and make
1388 sure the current value is permanently recorded, if it's the
1390 find_symbol_value (variable
);
1392 current_buffer
->local_var_alist
1393 = Fcons (Fcons (variable
, XCDR (XBUFFER_LOCAL_VALUE (XSYMBOL (variable
)->value
)->cdr
)),
1394 current_buffer
->local_var_alist
);
1396 /* Make sure symbol does not think it is set up for this buffer;
1397 force it to look once again for this buffer's value */
1399 Lisp_Object
*pvalbuf
;
1401 valcontents
= XSYMBOL (variable
)->value
;
1403 pvalbuf
= &XBUFFER_LOCAL_VALUE (valcontents
)->buffer
;
1404 if (current_buffer
== XBUFFER (*pvalbuf
))
1406 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
1410 /* If the symbol forwards into a C variable, then swap in the
1411 variable for this buffer immediately. If C code modifies the
1412 variable before we swap in, then that new value will clobber the
1413 default value the next time we swap. */
1414 valcontents
= XBUFFER_LOCAL_VALUE (XSYMBOL (variable
)->value
)->realvalue
;
1415 if (INTFWDP (valcontents
) || BOOLFWDP (valcontents
) || OBJFWDP (valcontents
))
1416 swap_in_symval_forwarding (variable
, XSYMBOL (variable
)->value
);
1421 DEFUN ("kill-local-variable", Fkill_local_variable
, Skill_local_variable
,
1422 1, 1, "vKill Local Variable: ",
1423 "Make VARIABLE no longer have a separate value in the current buffer.\n\
1424 From now on the default value will apply in this buffer.")
1426 register Lisp_Object variable
;
1428 register Lisp_Object tem
, valcontents
;
1430 CHECK_SYMBOL (variable
, 0);
1432 valcontents
= XSYMBOL (variable
)->value
;
1434 if (BUFFER_OBJFWDP (valcontents
))
1436 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1437 register int mask
= XINT (*((Lisp_Object
*)
1438 (idx
+ (char *)&buffer_local_flags
)));
1442 *(Lisp_Object
*)(idx
+ (char *) current_buffer
)
1443 = *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
1444 current_buffer
->local_var_flags
&= ~mask
;
1449 if (!BUFFER_LOCAL_VALUEP (valcontents
)
1450 && !SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1453 /* Get rid of this buffer's alist element, if any */
1455 tem
= Fassq (variable
, current_buffer
->local_var_alist
);
1457 current_buffer
->local_var_alist
1458 = Fdelq (tem
, current_buffer
->local_var_alist
);
1460 /* If the symbol is set up for the current buffer, recompute its
1461 value. We have to do it now, or else forwarded objects won't
1464 Lisp_Object
*pvalbuf
;
1465 valcontents
= XSYMBOL (variable
)->value
;
1466 pvalbuf
= &XBUFFER_LOCAL_VALUE (valcontents
)->buffer
;
1467 if (current_buffer
== XBUFFER (*pvalbuf
))
1470 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
1471 find_symbol_value (variable
);
1478 /* Lisp functions for creating and removing buffer-local variables. */
1480 DEFUN ("make-variable-frame-local", Fmake_variable_frame_local
, Smake_variable_frame_local
,
1481 1, 1, "vMake Variable Frame Local: ",
1482 "Enable VARIABLE to have frame-local bindings.\n\
1483 When a frame-local binding exists in the current frame,\n\
1484 it is in effect whenever the current buffer has no buffer-local binding.\n\
1485 A frame-local binding is actual a frame parameter value;\n\
1486 thus, any given frame has a local binding for VARIABLE\n\
1487 if it has a value for the frame parameter named VARIABLE.\n\
1488 See `modify-frame-parameters'.")
1490 register Lisp_Object variable
;
1492 register Lisp_Object tem
, valcontents
, newval
;
1494 CHECK_SYMBOL (variable
, 0);
1496 valcontents
= XSYMBOL (variable
)->value
;
1497 if (EQ (variable
, Qnil
) || EQ (variable
, Qt
) || KBOARD_OBJFWDP (valcontents
)
1498 || BUFFER_OBJFWDP (valcontents
))
1499 error ("Symbol %s may not be frame-local", XSYMBOL (variable
)->name
->data
);
1501 if (BUFFER_LOCAL_VALUEP (valcontents
)
1502 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1505 if (EQ (valcontents
, Qunbound
))
1506 XSYMBOL (variable
)->value
= Qnil
;
1507 tem
= Fcons (Qnil
, Fsymbol_value (variable
));
1509 newval
= allocate_misc ();
1510 XMISCTYPE (newval
) = Lisp_Misc_Some_Buffer_Local_Value
;
1511 XBUFFER_LOCAL_VALUE (newval
)->realvalue
= XSYMBOL (variable
)->value
;
1512 XBUFFER_LOCAL_VALUE (newval
)->buffer
= Qnil
;
1513 XBUFFER_LOCAL_VALUE (newval
)->frame
= Qnil
;
1514 XBUFFER_LOCAL_VALUE (newval
)->found_for_buffer
= 0;
1515 XBUFFER_LOCAL_VALUE (newval
)->found_for_frame
= 0;
1516 XBUFFER_LOCAL_VALUE (newval
)->check_frame
= 1;
1517 XBUFFER_LOCAL_VALUE (newval
)->cdr
= tem
;
1518 XSYMBOL (variable
)->value
= newval
;
1522 DEFUN ("local-variable-p", Flocal_variable_p
, Slocal_variable_p
,
1524 "Non-nil if VARIABLE has a local binding in buffer BUFFER.\n\
1525 BUFFER defaults to the current buffer.")
1527 register Lisp_Object variable
, buffer
;
1529 Lisp_Object valcontents
;
1530 register struct buffer
*buf
;
1533 buf
= current_buffer
;
1536 CHECK_BUFFER (buffer
, 0);
1537 buf
= XBUFFER (buffer
);
1540 CHECK_SYMBOL (variable
, 0);
1542 valcontents
= XSYMBOL (variable
)->value
;
1543 if (BUFFER_LOCAL_VALUEP (valcontents
)
1544 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1546 Lisp_Object tail
, elt
;
1547 for (tail
= buf
->local_var_alist
; CONSP (tail
); tail
= XCDR (tail
))
1550 if (EQ (variable
, XCAR (elt
)))
1554 if (BUFFER_OBJFWDP (valcontents
))
1556 int offset
= XBUFFER_OBJFWD (valcontents
)->offset
;
1557 int mask
= XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
));
1558 if (mask
== -1 || (buf
->local_var_flags
& mask
))
1564 DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p
, Slocal_variable_if_set_p
,
1566 "Non-nil if VARIABLE will be local in buffer BUFFER if it is set there.\n\
1567 BUFFER defaults to the current buffer.")
1569 register Lisp_Object variable
, buffer
;
1571 Lisp_Object valcontents
;
1572 register struct buffer
*buf
;
1575 buf
= current_buffer
;
1578 CHECK_BUFFER (buffer
, 0);
1579 buf
= XBUFFER (buffer
);
1582 CHECK_SYMBOL (variable
, 0);
1584 valcontents
= XSYMBOL (variable
)->value
;
1586 /* This means that make-variable-buffer-local was done. */
1587 if (BUFFER_LOCAL_VALUEP (valcontents
))
1589 /* All these slots become local if they are set. */
1590 if (BUFFER_OBJFWDP (valcontents
))
1592 if (SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1594 Lisp_Object tail
, elt
;
1595 for (tail
= buf
->local_var_alist
; CONSP (tail
); tail
= XCDR (tail
))
1598 if (EQ (variable
, XCAR (elt
)))
1605 /* Find the function at the end of a chain of symbol function indirections. */
1607 /* If OBJECT is a symbol, find the end of its function chain and
1608 return the value found there. If OBJECT is not a symbol, just
1609 return it. If there is a cycle in the function chain, signal a
1610 cyclic-function-indirection error.
1612 This is like Findirect_function, except that it doesn't signal an
1613 error if the chain ends up unbound. */
1615 indirect_function (object
)
1616 register Lisp_Object object
;
1618 Lisp_Object tortoise
, hare
;
1620 hare
= tortoise
= object
;
1624 if (!SYMBOLP (hare
) || EQ (hare
, Qunbound
))
1626 hare
= XSYMBOL (hare
)->function
;
1627 if (!SYMBOLP (hare
) || EQ (hare
, Qunbound
))
1629 hare
= XSYMBOL (hare
)->function
;
1631 tortoise
= XSYMBOL (tortoise
)->function
;
1633 if (EQ (hare
, tortoise
))
1634 Fsignal (Qcyclic_function_indirection
, Fcons (object
, Qnil
));
1640 DEFUN ("indirect-function", Findirect_function
, Sindirect_function
, 1, 1, 0,
1641 "Return the function at the end of OBJECT's function chain.\n\
1642 If OBJECT is a symbol, follow all function indirections and return the final\n\
1643 function binding.\n\
1644 If OBJECT is not a symbol, just return it.\n\
1645 Signal a void-function error if the final symbol is unbound.\n\
1646 Signal a cyclic-function-indirection error if there is a loop in the\n\
1647 function chain of symbols.")
1649 register Lisp_Object object
;
1653 result
= indirect_function (object
);
1655 if (EQ (result
, Qunbound
))
1656 return Fsignal (Qvoid_function
, Fcons (object
, Qnil
));
1660 /* Extract and set vector and string elements */
1662 DEFUN ("aref", Faref
, Saref
, 2, 2, 0,
1663 "Return the element of ARRAY at index IDX.\n\
1664 ARRAY may be a vector, a string, a char-table, a bool-vector,\n\
1665 or a byte-code object. IDX starts at 0.")
1667 register Lisp_Object array
;
1670 register int idxval
;
1672 CHECK_NUMBER (idx
, 1);
1673 idxval
= XINT (idx
);
1674 if (STRINGP (array
))
1678 if (idxval
< 0 || idxval
>= XSTRING (array
)->size
)
1679 args_out_of_range (array
, idx
);
1680 if (! STRING_MULTIBYTE (array
))
1681 return make_number ((unsigned char) XSTRING (array
)->data
[idxval
]);
1682 idxval_byte
= string_char_to_byte (array
, idxval
);
1684 c
= STRING_CHAR (&XSTRING (array
)->data
[idxval_byte
],
1685 STRING_BYTES (XSTRING (array
)) - idxval_byte
);
1686 return make_number (c
);
1688 else if (BOOL_VECTOR_P (array
))
1692 if (idxval
< 0 || idxval
>= XBOOL_VECTOR (array
)->size
)
1693 args_out_of_range (array
, idx
);
1695 val
= (unsigned char) XBOOL_VECTOR (array
)->data
[idxval
/ BITS_PER_CHAR
];
1696 return (val
& (1 << (idxval
% BITS_PER_CHAR
)) ? Qt
: Qnil
);
1698 else if (CHAR_TABLE_P (array
))
1703 args_out_of_range (array
, idx
);
1704 if (idxval
< CHAR_TABLE_ORDINARY_SLOTS
)
1706 /* For ASCII and 8-bit European characters, the element is
1707 stored in the top table. */
1708 val
= XCHAR_TABLE (array
)->contents
[idxval
];
1710 val
= XCHAR_TABLE (array
)->defalt
;
1711 while (NILP (val
)) /* Follow parents until we find some value. */
1713 array
= XCHAR_TABLE (array
)->parent
;
1716 val
= XCHAR_TABLE (array
)->contents
[idxval
];
1718 val
= XCHAR_TABLE (array
)->defalt
;
1725 Lisp_Object sub_table
;
1727 SPLIT_NON_ASCII_CHAR (idxval
, code
[0], code
[1], code
[2]);
1728 if (code
[1] < 32) code
[1] = -1;
1729 else if (code
[2] < 32) code
[2] = -1;
1731 /* Here, the possible range of CODE[0] (== charset ID) is
1732 128..MAX_CHARSET. Since the top level char table contains
1733 data for multibyte characters after 256th element, we must
1734 increment CODE[0] by 128 to get a correct index. */
1736 code
[3] = -1; /* anchor */
1738 try_parent_char_table
:
1740 for (i
= 0; code
[i
] >= 0; i
++)
1742 val
= XCHAR_TABLE (sub_table
)->contents
[code
[i
]];
1743 if (SUB_CHAR_TABLE_P (val
))
1748 val
= XCHAR_TABLE (sub_table
)->defalt
;
1751 array
= XCHAR_TABLE (array
)->parent
;
1753 goto try_parent_char_table
;
1758 /* Here, VAL is a sub char table. We try the default value
1760 val
= XCHAR_TABLE (val
)->defalt
;
1763 array
= XCHAR_TABLE (array
)->parent
;
1765 goto try_parent_char_table
;
1773 if (VECTORP (array
))
1774 size
= XVECTOR (array
)->size
;
1775 else if (COMPILEDP (array
))
1776 size
= XVECTOR (array
)->size
& PSEUDOVECTOR_SIZE_MASK
;
1778 wrong_type_argument (Qarrayp
, array
);
1780 if (idxval
< 0 || idxval
>= size
)
1781 args_out_of_range (array
, idx
);
1782 return XVECTOR (array
)->contents
[idxval
];
1786 DEFUN ("aset", Faset
, Saset
, 3, 3, 0,
1787 "Store into the element of ARRAY at index IDX the value NEWELT.\n\
1788 ARRAY may be a vector, a string, a char-table or a bool-vector.\n\
1790 (array
, idx
, newelt
)
1791 register Lisp_Object array
;
1792 Lisp_Object idx
, newelt
;
1794 register int idxval
;
1796 CHECK_NUMBER (idx
, 1);
1797 idxval
= XINT (idx
);
1798 if (!VECTORP (array
) && !STRINGP (array
) && !BOOL_VECTOR_P (array
)
1799 && ! CHAR_TABLE_P (array
))
1800 array
= wrong_type_argument (Qarrayp
, array
);
1801 CHECK_IMPURE (array
);
1803 if (VECTORP (array
))
1805 if (idxval
< 0 || idxval
>= XVECTOR (array
)->size
)
1806 args_out_of_range (array
, idx
);
1807 XVECTOR (array
)->contents
[idxval
] = newelt
;
1809 else if (BOOL_VECTOR_P (array
))
1813 if (idxval
< 0 || idxval
>= XBOOL_VECTOR (array
)->size
)
1814 args_out_of_range (array
, idx
);
1816 val
= (unsigned char) XBOOL_VECTOR (array
)->data
[idxval
/ BITS_PER_CHAR
];
1818 if (! NILP (newelt
))
1819 val
|= 1 << (idxval
% BITS_PER_CHAR
);
1821 val
&= ~(1 << (idxval
% BITS_PER_CHAR
));
1822 XBOOL_VECTOR (array
)->data
[idxval
/ BITS_PER_CHAR
] = val
;
1824 else if (CHAR_TABLE_P (array
))
1827 args_out_of_range (array
, idx
);
1828 if (idxval
< CHAR_TABLE_ORDINARY_SLOTS
)
1829 XCHAR_TABLE (array
)->contents
[idxval
] = newelt
;
1835 SPLIT_NON_ASCII_CHAR (idxval
, code
[0], code
[1], code
[2]);
1836 if (code
[1] < 32) code
[1] = -1;
1837 else if (code
[2] < 32) code
[2] = -1;
1839 /* See the comment of the corresponding part in Faref. */
1841 code
[3] = -1; /* anchor */
1842 for (i
= 0; code
[i
+ 1] >= 0; i
++)
1844 val
= XCHAR_TABLE (array
)->contents
[code
[i
]];
1845 if (SUB_CHAR_TABLE_P (val
))
1851 /* VAL is a leaf. Create a sub char table with the
1852 default value VAL or XCHAR_TABLE (array)->defalt
1853 and look into it. */
1855 temp
= make_sub_char_table (NILP (val
)
1856 ? XCHAR_TABLE (array
)->defalt
1858 XCHAR_TABLE (array
)->contents
[code
[i
]] = temp
;
1862 XCHAR_TABLE (array
)->contents
[code
[i
]] = newelt
;
1865 else if (STRING_MULTIBYTE (array
))
1867 int idxval_byte
, new_len
, actual_len
;
1869 unsigned char *p
, workbuf
[MAX_MULTIBYTE_LENGTH
], *str
= workbuf
;
1871 if (idxval
< 0 || idxval
>= XSTRING (array
)->size
)
1872 args_out_of_range (array
, idx
);
1874 idxval_byte
= string_char_to_byte (array
, idxval
);
1875 p
= &XSTRING (array
)->data
[idxval_byte
];
1877 actual_len
= MULTIBYTE_FORM_LENGTH (p
, STRING_BYTES (XSTRING (array
)));
1878 CHECK_NUMBER (newelt
, 2);
1879 new_len
= CHAR_STRING (XINT (newelt
), str
);
1880 if (actual_len
!= new_len
)
1881 error ("Attempt to change byte length of a string");
1883 /* We can't accept a change causing byte combining. */
1884 if (!ASCII_BYTE_P (*str
)
1885 && ((idxval
> 0 && !CHAR_HEAD_P (*str
)
1886 && (prev_byte
= string_char_to_byte (array
, idxval
- 1),
1887 BYTES_BY_CHAR_HEAD (XSTRING (array
)->data
[prev_byte
])
1888 > idxval_byte
- prev_byte
))
1889 || (idxval
< XSTRING (array
)->size
- 1
1890 && !CHAR_HEAD_P (p
[actual_len
])
1891 && new_len
< BYTES_BY_CHAR_HEAD (*str
))))
1892 error ("Attempt to change char length of a string");
1898 if (idxval
< 0 || idxval
>= XSTRING (array
)->size
)
1899 args_out_of_range (array
, idx
);
1900 CHECK_NUMBER (newelt
, 2);
1901 XSTRING (array
)->data
[idxval
] = XINT (newelt
);
1907 /* Arithmetic functions */
1909 enum comparison
{ equal
, notequal
, less
, grtr
, less_or_equal
, grtr_or_equal
};
1912 arithcompare (num1
, num2
, comparison
)
1913 Lisp_Object num1
, num2
;
1914 enum comparison comparison
;
1919 #ifdef LISP_FLOAT_TYPE
1920 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1
, 0);
1921 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2
, 0);
1923 if (FLOATP (num1
) || FLOATP (num2
))
1926 f1
= (FLOATP (num1
)) ? XFLOAT_DATA (num1
) : XINT (num1
);
1927 f2
= (FLOATP (num2
)) ? XFLOAT_DATA (num2
) : XINT (num2
);
1930 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1931 CHECK_NUMBER_COERCE_MARKER (num2
, 0);
1932 #endif /* LISP_FLOAT_TYPE */
1937 if (floatp
? f1
== f2
: XINT (num1
) == XINT (num2
))
1942 if (floatp
? f1
!= f2
: XINT (num1
) != XINT (num2
))
1947 if (floatp
? f1
< f2
: XINT (num1
) < XINT (num2
))
1952 if (floatp
? f1
<= f2
: XINT (num1
) <= XINT (num2
))
1957 if (floatp
? f1
> f2
: XINT (num1
) > XINT (num2
))
1962 if (floatp
? f1
>= f2
: XINT (num1
) >= XINT (num2
))
1971 DEFUN ("=", Feqlsign
, Seqlsign
, 2, 2, 0,
1972 "Return t if two args, both numbers or markers, are equal.")
1974 register Lisp_Object num1
, num2
;
1976 return arithcompare (num1
, num2
, equal
);
1979 DEFUN ("<", Flss
, Slss
, 2, 2, 0,
1980 "Return t if first arg is less than second arg. Both must be numbers or markers.")
1982 register Lisp_Object num1
, num2
;
1984 return arithcompare (num1
, num2
, less
);
1987 DEFUN (">", Fgtr
, Sgtr
, 2, 2, 0,
1988 "Return t if first arg is greater than second arg. Both must be numbers or markers.")
1990 register Lisp_Object num1
, num2
;
1992 return arithcompare (num1
, num2
, grtr
);
1995 DEFUN ("<=", Fleq
, Sleq
, 2, 2, 0,
1996 "Return t if first arg is less than or equal to second arg.\n\
1997 Both must be numbers or markers.")
1999 register Lisp_Object num1
, num2
;
2001 return arithcompare (num1
, num2
, less_or_equal
);
2004 DEFUN (">=", Fgeq
, Sgeq
, 2, 2, 0,
2005 "Return t if first arg is greater than or equal to second arg.\n\
2006 Both must be numbers or markers.")
2008 register Lisp_Object num1
, num2
;
2010 return arithcompare (num1
, num2
, grtr_or_equal
);
2013 DEFUN ("/=", Fneq
, Sneq
, 2, 2, 0,
2014 "Return t if first arg is not equal to second arg. Both must be numbers or markers.")
2016 register Lisp_Object num1
, num2
;
2018 return arithcompare (num1
, num2
, notequal
);
2021 DEFUN ("zerop", Fzerop
, Szerop
, 1, 1, 0, "Return t if NUMBER is zero.")
2023 register Lisp_Object number
;
2025 #ifdef LISP_FLOAT_TYPE
2026 CHECK_NUMBER_OR_FLOAT (number
, 0);
2028 if (FLOATP (number
))
2030 if (XFLOAT_DATA (number
) == 0.0)
2035 CHECK_NUMBER (number
, 0);
2036 #endif /* LISP_FLOAT_TYPE */
2043 /* Convert between long values and pairs of Lisp integers. */
2049 unsigned int top
= i
>> 16;
2050 unsigned int bot
= i
& 0xFFFF;
2052 return make_number (bot
);
2053 if (top
== (unsigned long)-1 >> 16)
2054 return Fcons (make_number (-1), make_number (bot
));
2055 return Fcons (make_number (top
), make_number (bot
));
2062 Lisp_Object top
, bot
;
2069 return ((XINT (top
) << 16) | XINT (bot
));
2072 DEFUN ("number-to-string", Fnumber_to_string
, Snumber_to_string
, 1, 1, 0,
2073 "Convert NUMBER to a string by printing it in decimal.\n\
2074 Uses a minus sign if negative.\n\
2075 NUMBER may be an integer or a floating point number.")
2079 char buffer
[VALBITS
];
2081 #ifndef LISP_FLOAT_TYPE
2082 CHECK_NUMBER (number
, 0);
2084 CHECK_NUMBER_OR_FLOAT (number
, 0);
2086 if (FLOATP (number
))
2088 char pigbuf
[350]; /* see comments in float_to_string */
2090 float_to_string (pigbuf
, XFLOAT_DATA (number
));
2091 return build_string (pigbuf
);
2093 #endif /* LISP_FLOAT_TYPE */
2095 if (sizeof (int) == sizeof (EMACS_INT
))
2096 sprintf (buffer
, "%d", XINT (number
));
2097 else if (sizeof (long) == sizeof (EMACS_INT
))
2098 sprintf (buffer
, "%ld", (long) XINT (number
));
2101 return build_string (buffer
);
2105 digit_to_number (character
, base
)
2106 int character
, base
;
2110 if (character
>= '0' && character
<= '9')
2111 digit
= character
- '0';
2112 else if (character
>= 'a' && character
<= 'z')
2113 digit
= character
- 'a' + 10;
2114 else if (character
>= 'A' && character
<= 'Z')
2115 digit
= character
- 'A' + 10;
2125 DEFUN ("string-to-number", Fstring_to_number
, Sstring_to_number
, 1, 2, 0,
2126 "Convert STRING to a number by parsing it as a decimal number.\n\
2127 This parses both integers and floating point numbers.\n\
2128 It ignores leading spaces and tabs.\n\
2130 If BASE, interpret STRING as a number in that base. If BASE isn't\n\
2131 present, base 10 is used. BASE must be between 2 and 16 (inclusive).\n\
2132 If the base used is not 10, floating point is not recognized.")
2134 register Lisp_Object string
, base
;
2136 register unsigned char *p
;
2137 register int b
, v
= 0;
2140 CHECK_STRING (string
, 0);
2146 CHECK_NUMBER (base
, 1);
2148 if (b
< 2 || b
> 16)
2149 Fsignal (Qargs_out_of_range
, Fcons (base
, Qnil
));
2152 p
= XSTRING (string
)->data
;
2154 /* Skip any whitespace at the front of the number. Some versions of
2155 atoi do this anyway, so we might as well make Emacs lisp consistent. */
2156 while (*p
== ' ' || *p
== '\t')
2167 #ifdef LISP_FLOAT_TYPE
2168 if (isfloat_string (p
) && b
== 10)
2169 return make_float (negative
* atof (p
));
2170 #endif /* LISP_FLOAT_TYPE */
2174 int digit
= digit_to_number (*p
++, b
);
2180 return make_number (negative
* v
);
2185 { Aadd
, Asub
, Amult
, Adiv
, Alogand
, Alogior
, Alogxor
, Amax
, Amin
};
2187 extern Lisp_Object
float_arith_driver ();
2188 extern Lisp_Object
fmod_float ();
2191 arith_driver (code
, nargs
, args
)
2194 register Lisp_Object
*args
;
2196 register Lisp_Object val
;
2197 register int argnum
;
2198 register EMACS_INT accum
;
2199 register EMACS_INT next
;
2201 switch (SWITCH_ENUM_CAST (code
))
2214 for (argnum
= 0; argnum
< nargs
; argnum
++)
2216 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
2217 #ifdef LISP_FLOAT_TYPE
2218 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
2220 if (FLOATP (val
)) /* time to do serious math */
2221 return (float_arith_driver ((double) accum
, argnum
, code
,
2224 CHECK_NUMBER_COERCE_MARKER (val
, argnum
);
2225 #endif /* LISP_FLOAT_TYPE */
2226 args
[argnum
] = val
; /* runs into a compiler bug. */
2227 next
= XINT (args
[argnum
]);
2228 switch (SWITCH_ENUM_CAST (code
))
2230 case Aadd
: accum
+= next
; break;
2232 accum
= argnum
? accum
- next
: nargs
== 1 ? - next
: next
;
2234 case Amult
: accum
*= next
; break;
2236 if (!argnum
) accum
= next
;
2240 Fsignal (Qarith_error
, Qnil
);
2244 case Alogand
: accum
&= next
; break;
2245 case Alogior
: accum
|= next
; break;
2246 case Alogxor
: accum
^= next
; break;
2247 case Amax
: if (!argnum
|| next
> accum
) accum
= next
; break;
2248 case Amin
: if (!argnum
|| next
< accum
) accum
= next
; break;
2252 XSETINT (val
, accum
);
2257 #define isnan(x) ((x) != (x))
2259 #ifdef LISP_FLOAT_TYPE
2262 float_arith_driver (accum
, argnum
, code
, nargs
, args
)
2264 register int argnum
;
2267 register Lisp_Object
*args
;
2269 register Lisp_Object val
;
2272 for (; argnum
< nargs
; argnum
++)
2274 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
2275 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
2279 next
= XFLOAT_DATA (val
);
2283 args
[argnum
] = val
; /* runs into a compiler bug. */
2284 next
= XINT (args
[argnum
]);
2286 switch (SWITCH_ENUM_CAST (code
))
2292 accum
= argnum
? accum
- next
: nargs
== 1 ? - next
: next
;
2302 if (! IEEE_FLOATING_POINT
&& next
== 0)
2303 Fsignal (Qarith_error
, Qnil
);
2310 return wrong_type_argument (Qinteger_or_marker_p
, val
);
2312 if (!argnum
|| isnan (next
) || next
> accum
)
2316 if (!argnum
|| isnan (next
) || next
< accum
)
2322 return make_float (accum
);
2324 #endif /* LISP_FLOAT_TYPE */
2326 DEFUN ("+", Fplus
, Splus
, 0, MANY
, 0,
2327 "Return sum of any number of arguments, which are numbers or markers.")
2332 return arith_driver (Aadd
, nargs
, args
);
2335 DEFUN ("-", Fminus
, Sminus
, 0, MANY
, 0,
2336 "Negate number or subtract numbers or markers.\n\
2337 With one arg, negates it. With more than one arg,\n\
2338 subtracts all but the first from the first.")
2343 return arith_driver (Asub
, nargs
, args
);
2346 DEFUN ("*", Ftimes
, Stimes
, 0, MANY
, 0,
2347 "Returns product of any number of arguments, which are numbers or markers.")
2352 return arith_driver (Amult
, nargs
, args
);
2355 DEFUN ("/", Fquo
, Squo
, 2, MANY
, 0,
2356 "Returns first argument divided by all the remaining arguments.\n\
2357 The arguments must be numbers or markers.")
2362 return arith_driver (Adiv
, nargs
, args
);
2365 DEFUN ("%", Frem
, Srem
, 2, 2, 0,
2366 "Returns remainder of X divided by Y.\n\
2367 Both must be integers or markers.")
2369 register Lisp_Object x
, y
;
2373 CHECK_NUMBER_COERCE_MARKER (x
, 0);
2374 CHECK_NUMBER_COERCE_MARKER (y
, 1);
2376 if (XFASTINT (y
) == 0)
2377 Fsignal (Qarith_error
, Qnil
);
2379 XSETINT (val
, XINT (x
) % XINT (y
));
2393 /* If the magnitude of the result exceeds that of the divisor, or
2394 the sign of the result does not agree with that of the dividend,
2395 iterate with the reduced value. This does not yield a
2396 particularly accurate result, but at least it will be in the
2397 range promised by fmod. */
2399 r
-= f2
* floor (r
/ f2
);
2400 while (f2
<= (r
< 0 ? -r
: r
) || ((r
< 0) != (f1
< 0) && ! isnan (r
)));
2404 #endif /* ! HAVE_FMOD */
2406 DEFUN ("mod", Fmod
, Smod
, 2, 2, 0,
2407 "Returns X modulo Y.\n\
2408 The result falls between zero (inclusive) and Y (exclusive).\n\
2409 Both X and Y must be numbers or markers.")
2411 register Lisp_Object x
, y
;
2416 #ifdef LISP_FLOAT_TYPE
2417 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (x
, 0);
2418 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (y
, 1);
2420 if (FLOATP (x
) || FLOATP (y
))
2421 return fmod_float (x
, y
);
2423 #else /* not LISP_FLOAT_TYPE */
2424 CHECK_NUMBER_COERCE_MARKER (x
, 0);
2425 CHECK_NUMBER_COERCE_MARKER (y
, 1);
2426 #endif /* not LISP_FLOAT_TYPE */
2432 Fsignal (Qarith_error
, Qnil
);
2436 /* If the "remainder" comes out with the wrong sign, fix it. */
2437 if (i2
< 0 ? i1
> 0 : i1
< 0)
2444 DEFUN ("max", Fmax
, Smax
, 1, MANY
, 0,
2445 "Return largest of all the arguments (which must be numbers or markers).\n\
2446 The value is always a number; markers are converted to numbers.")
2451 return arith_driver (Amax
, nargs
, args
);
2454 DEFUN ("min", Fmin
, Smin
, 1, MANY
, 0,
2455 "Return smallest of all the arguments (which must be numbers or markers).\n\
2456 The value is always a number; markers are converted to numbers.")
2461 return arith_driver (Amin
, nargs
, args
);
2464 DEFUN ("logand", Flogand
, Slogand
, 0, MANY
, 0,
2465 "Return bitwise-and of all the arguments.\n\
2466 Arguments may be integers, or markers converted to integers.")
2471 return arith_driver (Alogand
, nargs
, args
);
2474 DEFUN ("logior", Flogior
, Slogior
, 0, MANY
, 0,
2475 "Return bitwise-or of all the arguments.\n\
2476 Arguments may be integers, or markers converted to integers.")
2481 return arith_driver (Alogior
, nargs
, args
);
2484 DEFUN ("logxor", Flogxor
, Slogxor
, 0, MANY
, 0,
2485 "Return bitwise-exclusive-or of all the arguments.\n\
2486 Arguments may be integers, or markers converted to integers.")
2491 return arith_driver (Alogxor
, nargs
, args
);
2494 DEFUN ("ash", Fash
, Sash
, 2, 2, 0,
2495 "Return VALUE with its bits shifted left by COUNT.\n\
2496 If COUNT is negative, shifting is actually to the right.\n\
2497 In this case, the sign bit is duplicated.")
2499 register Lisp_Object value
, count
;
2501 register Lisp_Object val
;
2503 CHECK_NUMBER (value
, 0);
2504 CHECK_NUMBER (count
, 1);
2506 if (XINT (count
) >= BITS_PER_EMACS_INT
)
2508 else if (XINT (count
) > 0)
2509 XSETINT (val
, XINT (value
) << XFASTINT (count
));
2510 else if (XINT (count
) <= -BITS_PER_EMACS_INT
)
2511 XSETINT (val
, XINT (value
) < 0 ? -1 : 0);
2513 XSETINT (val
, XINT (value
) >> -XINT (count
));
2517 DEFUN ("lsh", Flsh
, Slsh
, 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, zeros are shifted in on the left.")
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
, (EMACS_UINT
) XUINT (value
) << XFASTINT (count
));
2533 else if (XINT (count
) <= -BITS_PER_EMACS_INT
)
2536 XSETINT (val
, (EMACS_UINT
) XUINT (value
) >> -XINT (count
));
2540 DEFUN ("1+", Fadd1
, Sadd1
, 1, 1, 0,
2541 "Return NUMBER plus one. NUMBER may be a number or a marker.\n\
2542 Markers are converted to integers.")
2544 register Lisp_Object number
;
2546 #ifdef LISP_FLOAT_TYPE
2547 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number
, 0);
2549 if (FLOATP (number
))
2550 return (make_float (1.0 + XFLOAT_DATA (number
)));
2552 CHECK_NUMBER_COERCE_MARKER (number
, 0);
2553 #endif /* LISP_FLOAT_TYPE */
2555 XSETINT (number
, XINT (number
) + 1);
2559 DEFUN ("1-", Fsub1
, Ssub1
, 1, 1, 0,
2560 "Return NUMBER minus one. NUMBER may be a number or a marker.\n\
2561 Markers are converted to integers.")
2563 register Lisp_Object number
;
2565 #ifdef LISP_FLOAT_TYPE
2566 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number
, 0);
2568 if (FLOATP (number
))
2569 return (make_float (-1.0 + XFLOAT_DATA (number
)));
2571 CHECK_NUMBER_COERCE_MARKER (number
, 0);
2572 #endif /* LISP_FLOAT_TYPE */
2574 XSETINT (number
, XINT (number
) - 1);
2578 DEFUN ("lognot", Flognot
, Slognot
, 1, 1, 0,
2579 "Return the bitwise complement of NUMBER. NUMBER must be an integer.")
2581 register Lisp_Object number
;
2583 CHECK_NUMBER (number
, 0);
2584 XSETINT (number
, ~XINT (number
));
2591 Lisp_Object error_tail
, arith_tail
;
2593 Qquote
= intern ("quote");
2594 Qlambda
= intern ("lambda");
2595 Qsubr
= intern ("subr");
2596 Qerror_conditions
= intern ("error-conditions");
2597 Qerror_message
= intern ("error-message");
2598 Qtop_level
= intern ("top-level");
2600 Qerror
= intern ("error");
2601 Qquit
= intern ("quit");
2602 Qwrong_type_argument
= intern ("wrong-type-argument");
2603 Qargs_out_of_range
= intern ("args-out-of-range");
2604 Qvoid_function
= intern ("void-function");
2605 Qcyclic_function_indirection
= intern ("cyclic-function-indirection");
2606 Qvoid_variable
= intern ("void-variable");
2607 Qsetting_constant
= intern ("setting-constant");
2608 Qinvalid_read_syntax
= intern ("invalid-read-syntax");
2610 Qinvalid_function
= intern ("invalid-function");
2611 Qwrong_number_of_arguments
= intern ("wrong-number-of-arguments");
2612 Qno_catch
= intern ("no-catch");
2613 Qend_of_file
= intern ("end-of-file");
2614 Qarith_error
= intern ("arith-error");
2615 Qbeginning_of_buffer
= intern ("beginning-of-buffer");
2616 Qend_of_buffer
= intern ("end-of-buffer");
2617 Qbuffer_read_only
= intern ("buffer-read-only");
2618 Qtext_read_only
= intern ("text-read-only");
2619 Qmark_inactive
= intern ("mark-inactive");
2621 Qlistp
= intern ("listp");
2622 Qconsp
= intern ("consp");
2623 Qsymbolp
= intern ("symbolp");
2624 Qkeywordp
= intern ("keywordp");
2625 Qintegerp
= intern ("integerp");
2626 Qnatnump
= intern ("natnump");
2627 Qwholenump
= intern ("wholenump");
2628 Qstringp
= intern ("stringp");
2629 Qarrayp
= intern ("arrayp");
2630 Qsequencep
= intern ("sequencep");
2631 Qbufferp
= intern ("bufferp");
2632 Qvectorp
= intern ("vectorp");
2633 Qchar_or_string_p
= intern ("char-or-string-p");
2634 Qmarkerp
= intern ("markerp");
2635 Qbuffer_or_string_p
= intern ("buffer-or-string-p");
2636 Qinteger_or_marker_p
= intern ("integer-or-marker-p");
2637 Qboundp
= intern ("boundp");
2638 Qfboundp
= intern ("fboundp");
2640 #ifdef LISP_FLOAT_TYPE
2641 Qfloatp
= intern ("floatp");
2642 Qnumberp
= intern ("numberp");
2643 Qnumber_or_marker_p
= intern ("number-or-marker-p");
2644 #endif /* LISP_FLOAT_TYPE */
2646 Qchar_table_p
= intern ("char-table-p");
2647 Qvector_or_char_table_p
= intern ("vector-or-char-table-p");
2649 Qcdr
= intern ("cdr");
2651 /* Handle automatic advice activation */
2652 Qad_advice_info
= intern ("ad-advice-info");
2653 Qad_activate_internal
= intern ("ad-activate-internal");
2655 error_tail
= Fcons (Qerror
, Qnil
);
2657 /* ERROR is used as a signaler for random errors for which nothing else is right */
2659 Fput (Qerror
, Qerror_conditions
,
2661 Fput (Qerror
, Qerror_message
,
2662 build_string ("error"));
2664 Fput (Qquit
, Qerror_conditions
,
2665 Fcons (Qquit
, Qnil
));
2666 Fput (Qquit
, Qerror_message
,
2667 build_string ("Quit"));
2669 Fput (Qwrong_type_argument
, Qerror_conditions
,
2670 Fcons (Qwrong_type_argument
, error_tail
));
2671 Fput (Qwrong_type_argument
, Qerror_message
,
2672 build_string ("Wrong type argument"));
2674 Fput (Qargs_out_of_range
, Qerror_conditions
,
2675 Fcons (Qargs_out_of_range
, error_tail
));
2676 Fput (Qargs_out_of_range
, Qerror_message
,
2677 build_string ("Args out of range"));
2679 Fput (Qvoid_function
, Qerror_conditions
,
2680 Fcons (Qvoid_function
, error_tail
));
2681 Fput (Qvoid_function
, Qerror_message
,
2682 build_string ("Symbol's function definition is void"));
2684 Fput (Qcyclic_function_indirection
, Qerror_conditions
,
2685 Fcons (Qcyclic_function_indirection
, error_tail
));
2686 Fput (Qcyclic_function_indirection
, Qerror_message
,
2687 build_string ("Symbol's chain of function indirections contains a loop"));
2689 Fput (Qvoid_variable
, Qerror_conditions
,
2690 Fcons (Qvoid_variable
, error_tail
));
2691 Fput (Qvoid_variable
, Qerror_message
,
2692 build_string ("Symbol's value as variable is void"));
2694 Fput (Qsetting_constant
, Qerror_conditions
,
2695 Fcons (Qsetting_constant
, error_tail
));
2696 Fput (Qsetting_constant
, Qerror_message
,
2697 build_string ("Attempt to set a constant symbol"));
2699 Fput (Qinvalid_read_syntax
, Qerror_conditions
,
2700 Fcons (Qinvalid_read_syntax
, error_tail
));
2701 Fput (Qinvalid_read_syntax
, Qerror_message
,
2702 build_string ("Invalid read syntax"));
2704 Fput (Qinvalid_function
, Qerror_conditions
,
2705 Fcons (Qinvalid_function
, error_tail
));
2706 Fput (Qinvalid_function
, Qerror_message
,
2707 build_string ("Invalid function"));
2709 Fput (Qwrong_number_of_arguments
, Qerror_conditions
,
2710 Fcons (Qwrong_number_of_arguments
, error_tail
));
2711 Fput (Qwrong_number_of_arguments
, Qerror_message
,
2712 build_string ("Wrong number of arguments"));
2714 Fput (Qno_catch
, Qerror_conditions
,
2715 Fcons (Qno_catch
, error_tail
));
2716 Fput (Qno_catch
, Qerror_message
,
2717 build_string ("No catch for tag"));
2719 Fput (Qend_of_file
, Qerror_conditions
,
2720 Fcons (Qend_of_file
, error_tail
));
2721 Fput (Qend_of_file
, Qerror_message
,
2722 build_string ("End of file during parsing"));
2724 arith_tail
= Fcons (Qarith_error
, error_tail
);
2725 Fput (Qarith_error
, Qerror_conditions
,
2727 Fput (Qarith_error
, Qerror_message
,
2728 build_string ("Arithmetic error"));
2730 Fput (Qbeginning_of_buffer
, Qerror_conditions
,
2731 Fcons (Qbeginning_of_buffer
, error_tail
));
2732 Fput (Qbeginning_of_buffer
, Qerror_message
,
2733 build_string ("Beginning of buffer"));
2735 Fput (Qend_of_buffer
, Qerror_conditions
,
2736 Fcons (Qend_of_buffer
, error_tail
));
2737 Fput (Qend_of_buffer
, Qerror_message
,
2738 build_string ("End of buffer"));
2740 Fput (Qbuffer_read_only
, Qerror_conditions
,
2741 Fcons (Qbuffer_read_only
, error_tail
));
2742 Fput (Qbuffer_read_only
, Qerror_message
,
2743 build_string ("Buffer is read-only"));
2745 Fput (Qtext_read_only
, Qerror_conditions
,
2746 Fcons (Qtext_read_only
, error_tail
));
2747 Fput (Qtext_read_only
, Qerror_message
,
2748 build_string ("Text is read-only"));
2750 #ifdef LISP_FLOAT_TYPE
2751 Qrange_error
= intern ("range-error");
2752 Qdomain_error
= intern ("domain-error");
2753 Qsingularity_error
= intern ("singularity-error");
2754 Qoverflow_error
= intern ("overflow-error");
2755 Qunderflow_error
= intern ("underflow-error");
2757 Fput (Qdomain_error
, Qerror_conditions
,
2758 Fcons (Qdomain_error
, arith_tail
));
2759 Fput (Qdomain_error
, Qerror_message
,
2760 build_string ("Arithmetic domain error"));
2762 Fput (Qrange_error
, Qerror_conditions
,
2763 Fcons (Qrange_error
, arith_tail
));
2764 Fput (Qrange_error
, Qerror_message
,
2765 build_string ("Arithmetic range error"));
2767 Fput (Qsingularity_error
, Qerror_conditions
,
2768 Fcons (Qsingularity_error
, Fcons (Qdomain_error
, arith_tail
)));
2769 Fput (Qsingularity_error
, Qerror_message
,
2770 build_string ("Arithmetic singularity error"));
2772 Fput (Qoverflow_error
, Qerror_conditions
,
2773 Fcons (Qoverflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2774 Fput (Qoverflow_error
, Qerror_message
,
2775 build_string ("Arithmetic overflow error"));
2777 Fput (Qunderflow_error
, Qerror_conditions
,
2778 Fcons (Qunderflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2779 Fput (Qunderflow_error
, Qerror_message
,
2780 build_string ("Arithmetic underflow error"));
2782 staticpro (&Qrange_error
);
2783 staticpro (&Qdomain_error
);
2784 staticpro (&Qsingularity_error
);
2785 staticpro (&Qoverflow_error
);
2786 staticpro (&Qunderflow_error
);
2787 #endif /* LISP_FLOAT_TYPE */
2791 staticpro (&Qquote
);
2792 staticpro (&Qlambda
);
2794 staticpro (&Qunbound
);
2795 staticpro (&Qerror_conditions
);
2796 staticpro (&Qerror_message
);
2797 staticpro (&Qtop_level
);
2799 staticpro (&Qerror
);
2801 staticpro (&Qwrong_type_argument
);
2802 staticpro (&Qargs_out_of_range
);
2803 staticpro (&Qvoid_function
);
2804 staticpro (&Qcyclic_function_indirection
);
2805 staticpro (&Qvoid_variable
);
2806 staticpro (&Qsetting_constant
);
2807 staticpro (&Qinvalid_read_syntax
);
2808 staticpro (&Qwrong_number_of_arguments
);
2809 staticpro (&Qinvalid_function
);
2810 staticpro (&Qno_catch
);
2811 staticpro (&Qend_of_file
);
2812 staticpro (&Qarith_error
);
2813 staticpro (&Qbeginning_of_buffer
);
2814 staticpro (&Qend_of_buffer
);
2815 staticpro (&Qbuffer_read_only
);
2816 staticpro (&Qtext_read_only
);
2817 staticpro (&Qmark_inactive
);
2819 staticpro (&Qlistp
);
2820 staticpro (&Qconsp
);
2821 staticpro (&Qsymbolp
);
2822 staticpro (&Qkeywordp
);
2823 staticpro (&Qintegerp
);
2824 staticpro (&Qnatnump
);
2825 staticpro (&Qwholenump
);
2826 staticpro (&Qstringp
);
2827 staticpro (&Qarrayp
);
2828 staticpro (&Qsequencep
);
2829 staticpro (&Qbufferp
);
2830 staticpro (&Qvectorp
);
2831 staticpro (&Qchar_or_string_p
);
2832 staticpro (&Qmarkerp
);
2833 staticpro (&Qbuffer_or_string_p
);
2834 staticpro (&Qinteger_or_marker_p
);
2835 #ifdef LISP_FLOAT_TYPE
2836 staticpro (&Qfloatp
);
2837 staticpro (&Qnumberp
);
2838 staticpro (&Qnumber_or_marker_p
);
2839 #endif /* LISP_FLOAT_TYPE */
2840 staticpro (&Qchar_table_p
);
2841 staticpro (&Qvector_or_char_table_p
);
2843 staticpro (&Qboundp
);
2844 staticpro (&Qfboundp
);
2846 staticpro (&Qad_advice_info
);
2847 staticpro (&Qad_activate_internal
);
2849 /* Types that type-of returns. */
2850 Qinteger
= intern ("integer");
2851 Qsymbol
= intern ("symbol");
2852 Qstring
= intern ("string");
2853 Qcons
= intern ("cons");
2854 Qmarker
= intern ("marker");
2855 Qoverlay
= intern ("overlay");
2856 Qfloat
= intern ("float");
2857 Qwindow_configuration
= intern ("window-configuration");
2858 Qprocess
= intern ("process");
2859 Qwindow
= intern ("window");
2860 /* Qsubr = intern ("subr"); */
2861 Qcompiled_function
= intern ("compiled-function");
2862 Qbuffer
= intern ("buffer");
2863 Qframe
= intern ("frame");
2864 Qvector
= intern ("vector");
2865 Qchar_table
= intern ("char-table");
2866 Qbool_vector
= intern ("bool-vector");
2867 Qhash_table
= intern ("hash-table");
2869 staticpro (&Qinteger
);
2870 staticpro (&Qsymbol
);
2871 staticpro (&Qstring
);
2873 staticpro (&Qmarker
);
2874 staticpro (&Qoverlay
);
2875 staticpro (&Qfloat
);
2876 staticpro (&Qwindow_configuration
);
2877 staticpro (&Qprocess
);
2878 staticpro (&Qwindow
);
2879 /* staticpro (&Qsubr); */
2880 staticpro (&Qcompiled_function
);
2881 staticpro (&Qbuffer
);
2882 staticpro (&Qframe
);
2883 staticpro (&Qvector
);
2884 staticpro (&Qchar_table
);
2885 staticpro (&Qbool_vector
);
2886 staticpro (&Qhash_table
);
2888 DEFVAR_BOOL ("keyword-symbols-constant-flag", &keyword_symbols_constant_flag
,
2889 "Non-nil means it is an error to set a keyword symbol.\n\
2890 A keyword symbol is a symbol whose name starts with a colon (`:').");
2891 keyword_symbols_constant_flag
= 1;
2895 defsubr (&Stype_of
);
2900 defsubr (&Sintegerp
);
2901 defsubr (&Sinteger_or_marker_p
);
2902 defsubr (&Snumberp
);
2903 defsubr (&Snumber_or_marker_p
);
2904 #ifdef LISP_FLOAT_TYPE
2906 #endif /* LISP_FLOAT_TYPE */
2907 defsubr (&Snatnump
);
2908 defsubr (&Ssymbolp
);
2909 defsubr (&Skeywordp
);
2910 defsubr (&Sstringp
);
2911 defsubr (&Smultibyte_string_p
);
2912 defsubr (&Svectorp
);
2913 defsubr (&Schar_table_p
);
2914 defsubr (&Svector_or_char_table_p
);
2915 defsubr (&Sbool_vector_p
);
2917 defsubr (&Ssequencep
);
2918 defsubr (&Sbufferp
);
2919 defsubr (&Smarkerp
);
2921 defsubr (&Sbyte_code_function_p
);
2922 defsubr (&Schar_or_string_p
);
2925 defsubr (&Scar_safe
);
2926 defsubr (&Scdr_safe
);
2929 defsubr (&Ssymbol_function
);
2930 defsubr (&Sindirect_function
);
2931 defsubr (&Ssymbol_plist
);
2932 defsubr (&Ssymbol_name
);
2933 defsubr (&Smakunbound
);
2934 defsubr (&Sfmakunbound
);
2936 defsubr (&Sfboundp
);
2938 defsubr (&Sdefalias
);
2939 defsubr (&Ssetplist
);
2940 defsubr (&Ssymbol_value
);
2942 defsubr (&Sdefault_boundp
);
2943 defsubr (&Sdefault_value
);
2944 defsubr (&Sset_default
);
2945 defsubr (&Ssetq_default
);
2946 defsubr (&Smake_variable_buffer_local
);
2947 defsubr (&Smake_local_variable
);
2948 defsubr (&Skill_local_variable
);
2949 defsubr (&Smake_variable_frame_local
);
2950 defsubr (&Slocal_variable_p
);
2951 defsubr (&Slocal_variable_if_set_p
);
2954 defsubr (&Snumber_to_string
);
2955 defsubr (&Sstring_to_number
);
2956 defsubr (&Seqlsign
);
2980 XSYMBOL (Qwholenump
)->function
= XSYMBOL (Qnatnump
)->function
;
2987 #if defined(USG) && !defined(POSIX_SIGNALS)
2988 /* USG systems forget handlers when they are used;
2989 must reestablish each time */
2990 signal (signo
, arith_error
);
2993 /* VMS systems are like USG. */
2994 signal (signo
, arith_error
);
2998 #else /* not BSD4_1 */
2999 sigsetmask (SIGEMPTYMASK
);
3000 #endif /* not BSD4_1 */
3002 Fsignal (Qarith_error
, Qnil
);
3008 /* Don't do this if just dumping out.
3009 We don't want to call `signal' in this case
3010 so that we don't have trouble with dumping
3011 signal-delivering routines in an inconsistent state. */
3015 #endif /* CANNOT_DUMP */
3016 signal (SIGFPE
, arith_error
);
3019 signal (SIGEMT
, arith_error
);