1 /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 1986, 1988, 1993 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 1, 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, 675 Mass Ave, Cambridge, MA 02139, USA. */
31 #include "syssignal.h"
33 #ifdef LISP_FLOAT_TYPE
39 /* Work around a problem that happens because math.h on hpux 7
40 defines two static variables--which, in Emacs, are not really static,
41 because `static' is defined as nothing. The problem is that they are
42 here, in floatfns.c, and in lread.c.
43 These macros prevent the name conflict. */
44 #if defined (HPUX) && !defined (HPUX8)
45 #define _MAXLDBL data_c_maxldbl
46 #define _NMAXLDBL data_c_nmaxldbl
50 #endif /* LISP_FLOAT_TYPE */
53 extern double atof ();
56 Lisp_Object Qnil
, Qt
, Qquote
, Qlambda
, Qsubr
, Qunbound
;
57 Lisp_Object Qerror_conditions
, Qerror_message
, Qtop_level
;
58 Lisp_Object Qerror
, Qquit
, Qwrong_type_argument
, Qargs_out_of_range
;
59 Lisp_Object Qvoid_variable
, Qvoid_function
, Qcyclic_function_indirection
;
60 Lisp_Object Qsetting_constant
, Qinvalid_read_syntax
;
61 Lisp_Object Qinvalid_function
, Qwrong_number_of_arguments
, Qno_catch
;
62 Lisp_Object Qend_of_file
, Qarith_error
, Qmark_inactive
;
63 Lisp_Object Qbeginning_of_buffer
, Qend_of_buffer
, Qbuffer_read_only
;
64 Lisp_Object Qintegerp
, Qnatnump
, Qsymbolp
, Qlistp
, Qconsp
;
65 Lisp_Object Qstringp
, Qarrayp
, Qsequencep
, Qbufferp
;
66 Lisp_Object Qchar_or_string_p
, Qmarkerp
, Qinteger_or_marker_p
, Qvectorp
;
67 Lisp_Object Qbuffer_or_string_p
;
68 Lisp_Object Qboundp
, Qfboundp
;
71 Lisp_Object Qrange_error
, Qdomain_error
, Qsingularity_error
;
72 Lisp_Object Qoverflow_error
, Qunderflow_error
;
74 #ifdef LISP_FLOAT_TYPE
76 Lisp_Object Qnumberp
, Qnumber_or_marker_p
;
79 static Lisp_Object
swap_in_symval_forwarding ();
82 wrong_type_argument (predicate
, value
)
83 register Lisp_Object predicate
, value
;
85 register Lisp_Object tem
;
88 if (!EQ (Vmocklisp_arguments
, Qt
))
90 if (XTYPE (value
) == Lisp_String
&&
91 (EQ (predicate
, Qintegerp
) || EQ (predicate
, Qinteger_or_marker_p
)))
92 return Fstring_to_number (value
);
93 if (XTYPE (value
) == Lisp_Int
&& EQ (predicate
, Qstringp
))
94 return Fnumber_to_string (value
);
96 value
= Fsignal (Qwrong_type_argument
, Fcons (predicate
, Fcons (value
, Qnil
)));
97 tem
= call1 (predicate
, value
);
105 error ("Attempt to modify read-only object");
109 args_out_of_range (a1
, a2
)
113 Fsignal (Qargs_out_of_range
, Fcons (a1
, Fcons (a2
, Qnil
)));
117 args_out_of_range_3 (a1
, a2
, a3
)
118 Lisp_Object a1
, a2
, a3
;
121 Fsignal (Qargs_out_of_range
, Fcons (a1
, Fcons (a2
, Fcons (a3
, Qnil
))));
128 register Lisp_Object val
;
129 XSET (val
, Lisp_Int
, num
);
133 /* On some machines, XINT needs a temporary location.
134 Here it is, in case it is needed. */
136 int sign_extend_temp
;
138 /* On a few machines, XINT can only be done by calling this. */
141 sign_extend_lisp_int (num
)
144 if (num
& (1 << (VALBITS
- 1)))
145 return num
| ((-1) << VALBITS
);
147 return num
& ((1 << VALBITS
) - 1);
150 /* Data type predicates */
152 DEFUN ("eq", Feq
, Seq
, 2, 2, 0,
153 "T if the two args are the same Lisp object.")
155 Lisp_Object obj1
, obj2
;
162 DEFUN ("null", Fnull
, Snull
, 1, 1, 0, "T if OBJECT is nil.")
171 DEFUN ("consp", Fconsp
, Sconsp
, 1, 1, 0, "T if OBJECT is a cons cell.")
175 if (XTYPE (obj
) == Lisp_Cons
)
180 DEFUN ("atom", Fatom
, Satom
, 1, 1, 0, "T if OBJECT is not a cons cell. This includes nil.")
184 if (XTYPE (obj
) == Lisp_Cons
)
189 DEFUN ("listp", Flistp
, Slistp
, 1, 1, 0, "T if OBJECT is a list. This includes nil.")
193 if (XTYPE (obj
) == Lisp_Cons
|| NILP (obj
))
198 DEFUN ("nlistp", Fnlistp
, Snlistp
, 1, 1, 0, "T if OBJECT is not a list. Lists include nil.")
202 if (XTYPE (obj
) == Lisp_Cons
|| NILP (obj
))
207 DEFUN ("symbolp", Fsymbolp
, Ssymbolp
, 1, 1, 0, "T if OBJECT is a symbol.")
211 if (XTYPE (obj
) == Lisp_Symbol
)
216 DEFUN ("vectorp", Fvectorp
, Svectorp
, 1, 1, 0, "T if OBJECT is a vector.")
220 if (XTYPE (obj
) == Lisp_Vector
)
225 DEFUN ("stringp", Fstringp
, Sstringp
, 1, 1, 0, "T if OBJECT is a string.")
229 if (XTYPE (obj
) == Lisp_String
)
234 DEFUN ("arrayp", Farrayp
, Sarrayp
, 1, 1, 0, "T if OBJECT is an array (string or vector).")
238 if (XTYPE (obj
) == Lisp_Vector
|| XTYPE (obj
) == Lisp_String
)
243 DEFUN ("sequencep", Fsequencep
, Ssequencep
, 1, 1, 0,
244 "T if OBJECT is a sequence (list or array).")
246 register Lisp_Object obj
;
248 if (CONSP (obj
) || NILP (obj
) ||
249 XTYPE (obj
) == Lisp_Vector
|| XTYPE (obj
) == Lisp_String
)
254 DEFUN ("bufferp", Fbufferp
, Sbufferp
, 1, 1, 0, "T if OBJECT is an editor buffer.")
258 if (XTYPE (obj
) == Lisp_Buffer
)
263 DEFUN ("markerp", Fmarkerp
, Smarkerp
, 1, 1, 0, "T if OBJECT is a marker (editor pointer).")
267 if (XTYPE (obj
) == Lisp_Marker
)
272 DEFUN ("subrp", Fsubrp
, Ssubrp
, 1, 1, 0, "T if OBJECT is a built-in function.")
276 if (XTYPE (obj
) == Lisp_Subr
)
281 DEFUN ("byte-code-function-p", Fbyte_code_function_p
, Sbyte_code_function_p
,
282 1, 1, 0, "T if OBJECT is a byte-compiled function object.")
286 if (XTYPE (obj
) == Lisp_Compiled
)
291 DEFUN ("char-or-string-p", Fchar_or_string_p
, Schar_or_string_p
, 1, 1, 0, "T if OBJECT is a character (a number) or a string.")
293 register Lisp_Object obj
;
295 if (XTYPE (obj
) == Lisp_Int
|| XTYPE (obj
) == Lisp_String
)
300 DEFUN ("integerp", Fintegerp
, Sintegerp
, 1, 1, 0, "T if OBJECT is a number.")
304 if (XTYPE (obj
) == Lisp_Int
)
309 DEFUN ("integer-or-marker-p", Finteger_or_marker_p
, Sinteger_or_marker_p
, 1, 1, 0,
310 "T if OBJECT is an integer or a marker (editor pointer).")
312 register Lisp_Object obj
;
314 if (XTYPE (obj
) == Lisp_Marker
|| XTYPE (obj
) == Lisp_Int
)
319 DEFUN ("natnump", Fnatnump
, Snatnump
, 1, 1, 0, "T if OBJECT is a nonnegative number.")
323 if (XTYPE (obj
) == Lisp_Int
&& XINT (obj
) >= 0)
328 DEFUN ("numberp", Fnumberp
, Snumberp
, 1, 1, 0,
329 "T if OBJECT is a number (floating point or integer).")
339 DEFUN ("number-or-marker-p", Fnumber_or_marker_p
,
340 Snumber_or_marker_p
, 1, 1, 0,
341 "T if OBJECT is a number or a marker.")
346 || XTYPE (obj
) == Lisp_Marker
)
351 #ifdef LISP_FLOAT_TYPE
352 DEFUN ("floatp", Ffloatp
, Sfloatp
, 1, 1, 0,
353 "T if OBJECT is a floating point number.")
357 if (XTYPE (obj
) == Lisp_Float
)
361 #endif /* LISP_FLOAT_TYPE */
363 /* Extract and set components of lists */
365 DEFUN ("car", Fcar
, Scar
, 1, 1, 0,
366 "Return the car of CONSCELL. If arg is nil, return nil.\n\
367 Error if arg is not nil and not a cons cell. See also `car-safe'.")
369 register Lisp_Object list
;
373 if (XTYPE (list
) == Lisp_Cons
)
374 return XCONS (list
)->car
;
375 else if (EQ (list
, Qnil
))
378 list
= wrong_type_argument (Qlistp
, list
);
382 DEFUN ("car-safe", Fcar_safe
, Scar_safe
, 1, 1, 0,
383 "Return the car of OBJECT if it is a cons cell, or else nil.")
387 if (XTYPE (object
) == Lisp_Cons
)
388 return XCONS (object
)->car
;
393 DEFUN ("cdr", Fcdr
, Scdr
, 1, 1, 0,
394 "Return the cdr of CONSCELL. If arg is nil, return nil.\n\
395 Error if arg is not nil and not a cons cell. See also `cdr-safe'.")
398 register Lisp_Object list
;
402 if (XTYPE (list
) == Lisp_Cons
)
403 return XCONS (list
)->cdr
;
404 else if (EQ (list
, Qnil
))
407 list
= wrong_type_argument (Qlistp
, list
);
411 DEFUN ("cdr-safe", Fcdr_safe
, Scdr_safe
, 1, 1, 0,
412 "Return the cdr of OBJECT if it is a cons cell, or else nil.")
416 if (XTYPE (object
) == Lisp_Cons
)
417 return XCONS (object
)->cdr
;
422 DEFUN ("setcar", Fsetcar
, Ssetcar
, 2, 2, 0,
423 "Set the car of CONSCELL to be NEWCAR. Returns NEWCAR.")
425 register Lisp_Object cell
, newcar
;
427 if (XTYPE (cell
) != Lisp_Cons
)
428 cell
= wrong_type_argument (Qconsp
, cell
);
431 XCONS (cell
)->car
= newcar
;
435 DEFUN ("setcdr", Fsetcdr
, Ssetcdr
, 2, 2, 0,
436 "Set the cdr of CONSCELL to be NEWCDR. Returns NEWCDR.")
438 register Lisp_Object cell
, newcdr
;
440 if (XTYPE (cell
) != Lisp_Cons
)
441 cell
= wrong_type_argument (Qconsp
, cell
);
444 XCONS (cell
)->cdr
= newcdr
;
448 /* Extract and set components of symbols */
450 DEFUN ("boundp", Fboundp
, Sboundp
, 1, 1, 0, "T if SYMBOL's value is not void.")
452 register Lisp_Object sym
;
454 Lisp_Object valcontents
;
455 CHECK_SYMBOL (sym
, 0);
457 valcontents
= XSYMBOL (sym
)->value
;
459 #ifdef SWITCH_ENUM_BUG
460 switch ((int) XTYPE (valcontents
))
462 switch (XTYPE (valcontents
))
465 case Lisp_Buffer_Local_Value
:
466 case Lisp_Some_Buffer_Local_Value
:
467 valcontents
= swap_in_symval_forwarding (sym
, valcontents
);
470 return (XTYPE (valcontents
) == Lisp_Void
|| EQ (valcontents
, Qunbound
)
474 DEFUN ("fboundp", Ffboundp
, Sfboundp
, 1, 1, 0, "T if SYMBOL's function definition is not void.")
476 register Lisp_Object sym
;
478 CHECK_SYMBOL (sym
, 0);
479 return (XTYPE (XSYMBOL (sym
)->function
) == Lisp_Void
480 || EQ (XSYMBOL (sym
)->function
, Qunbound
))
484 DEFUN ("makunbound", Fmakunbound
, Smakunbound
, 1, 1, 0, "Make SYMBOL's value be void.")
486 register Lisp_Object sym
;
488 CHECK_SYMBOL (sym
, 0);
489 if (NILP (sym
) || EQ (sym
, Qt
))
490 return Fsignal (Qsetting_constant
, Fcons (sym
, Qnil
));
491 Fset (sym
, Qunbound
);
495 DEFUN ("fmakunbound", Ffmakunbound
, Sfmakunbound
, 1, 1, 0, "Make SYMBOL's function definition be void.")
497 register Lisp_Object sym
;
499 CHECK_SYMBOL (sym
, 0);
500 XSYMBOL (sym
)->function
= Qunbound
;
504 DEFUN ("symbol-function", Fsymbol_function
, Ssymbol_function
, 1, 1, 0,
505 "Return SYMBOL's function definition. Error if that is void.")
507 register Lisp_Object symbol
;
509 CHECK_SYMBOL (symbol
, 0);
510 if (EQ (XSYMBOL (symbol
)->function
, Qunbound
))
511 return Fsignal (Qvoid_function
, Fcons (symbol
, Qnil
));
512 return XSYMBOL (symbol
)->function
;
515 DEFUN ("symbol-plist", Fsymbol_plist
, Ssymbol_plist
, 1, 1, 0, "Return SYMBOL's property list.")
517 register Lisp_Object sym
;
519 CHECK_SYMBOL (sym
, 0);
520 return XSYMBOL (sym
)->plist
;
523 DEFUN ("symbol-name", Fsymbol_name
, Ssymbol_name
, 1, 1, 0, "Return SYMBOL's name, a string.")
525 register Lisp_Object sym
;
527 register Lisp_Object name
;
529 CHECK_SYMBOL (sym
, 0);
530 XSET (name
, Lisp_String
, XSYMBOL (sym
)->name
);
534 DEFUN ("fset", Ffset
, Sfset
, 2, 2, 0,
535 "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.")
537 register Lisp_Object sym
, newdef
;
539 CHECK_SYMBOL (sym
, 0);
541 if (!NILP (Vautoload_queue
) && !EQ (XSYMBOL (sym
)->function
, Qunbound
))
542 Vautoload_queue
= Fcons (Fcons (sym
, XSYMBOL (sym
)->function
),
544 XSYMBOL (sym
)->function
= newdef
;
548 /* This name should be removed once it is eliminated from elsewhere. */
550 DEFUN ("defalias", Fdefalias
, Sdefalias
, 2, 2, 0,
551 "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\
552 Associates the function with the current load file, if any.")
554 register Lisp_Object sym
, newdef
;
556 CHECK_SYMBOL (sym
, 0);
557 if (!NILP (Vautoload_queue
) && !EQ (XSYMBOL (sym
)->function
, Qunbound
))
558 Vautoload_queue
= Fcons (Fcons (sym
, XSYMBOL (sym
)->function
),
560 XSYMBOL (sym
)->function
= newdef
;
561 LOADHIST_ATTACH (sym
);
565 DEFUN ("define-function", Fdefine_function
, Sdefine_function
, 2, 2, 0,
566 "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\
567 Associates the function with the current load file, if any.")
569 register Lisp_Object sym
, newdef
;
571 CHECK_SYMBOL (sym
, 0);
572 if (!NILP (Vautoload_queue
) && !EQ (XSYMBOL (sym
)->function
, Qunbound
))
573 Vautoload_queue
= Fcons (Fcons (sym
, XSYMBOL (sym
)->function
),
575 XSYMBOL (sym
)->function
= newdef
;
576 LOADHIST_ATTACH (sym
);
580 DEFUN ("setplist", Fsetplist
, Ssetplist
, 2, 2, 0,
581 "Set SYMBOL's property list to NEWVAL, and return NEWVAL.")
583 register Lisp_Object sym
, newplist
;
585 CHECK_SYMBOL (sym
, 0);
586 XSYMBOL (sym
)->plist
= newplist
;
591 /* Getting and setting values of symbols */
593 /* Given the raw contents of a symbol value cell,
594 return the Lisp value of the symbol.
595 This does not handle buffer-local variables; use
596 swap_in_symval_forwarding for that. */
599 do_symval_forwarding (valcontents
)
600 register Lisp_Object valcontents
;
602 register Lisp_Object val
;
603 #ifdef SWITCH_ENUM_BUG
604 switch ((int) XTYPE (valcontents
))
606 switch (XTYPE (valcontents
))
610 XSET (val
, Lisp_Int
, *XINTPTR (valcontents
));
614 if (*XINTPTR (valcontents
))
619 return *XOBJFWD (valcontents
);
621 case Lisp_Buffer_Objfwd
:
622 return *(Lisp_Object
*)(XUINT (valcontents
) + (char *)current_buffer
);
627 /* Store NEWVAL into SYM, where VALCONTENTS is found in the value cell
628 of SYM. If SYM is buffer-local, VALCONTENTS should be the
629 buffer-independent contents of the value cell: forwarded just one
630 step past the buffer-localness. */
633 store_symval_forwarding (sym
, valcontents
, newval
)
635 register Lisp_Object valcontents
, newval
;
637 #ifdef SWITCH_ENUM_BUG
638 switch ((int) XTYPE (valcontents
))
640 switch (XTYPE (valcontents
))
644 CHECK_NUMBER (newval
, 1);
645 *XINTPTR (valcontents
) = XINT (newval
);
649 *XINTPTR (valcontents
) = NILP(newval
) ? 0 : 1;
653 *XOBJFWD (valcontents
) = newval
;
656 case Lisp_Buffer_Objfwd
:
658 unsigned int offset
= XUINT (valcontents
);
660 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
);
662 if (! NILP (type
) && ! NILP (newval
)
663 && XTYPE (newval
) != XINT (type
))
664 buffer_slot_type_mismatch (valcontents
, newval
);
666 *(Lisp_Object
*)(XUINT (valcontents
) + (char *)current_buffer
)
672 valcontents
= XSYMBOL (sym
)->value
;
673 if (XTYPE (valcontents
) == Lisp_Buffer_Local_Value
674 || XTYPE (valcontents
) == Lisp_Some_Buffer_Local_Value
)
675 XCONS (XSYMBOL (sym
)->value
)->car
= newval
;
677 XSYMBOL (sym
)->value
= newval
;
681 /* Set up the buffer-local symbol SYM for validity in the current
682 buffer. VALCONTENTS is the contents of its value cell.
683 Return the value forwarded one step past the buffer-local indicator. */
686 swap_in_symval_forwarding (sym
, valcontents
)
687 Lisp_Object sym
, valcontents
;
689 /* valcontents is a list
690 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)).
692 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
693 local_var_alist, that being the element whose car is this
694 variable. Or it can be a pointer to the
695 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not have
696 an element in its alist for this variable.
698 If the current buffer is not BUFFER, we store the current
699 REALVALUE value into CURRENT-ALIST-ELEMENT, then find the
700 appropriate alist element for the buffer now current and set up
701 CURRENT-ALIST-ELEMENT. Then we set REALVALUE out of that
702 element, and store into BUFFER.
704 Note that REALVALUE can be a forwarding pointer. */
706 register Lisp_Object tem1
;
707 tem1
= XCONS (XCONS (valcontents
)->cdr
)->car
;
709 if (NILP (tem1
) || current_buffer
!= XBUFFER (tem1
))
711 tem1
= XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
;
712 Fsetcdr (tem1
, do_symval_forwarding (XCONS (valcontents
)->car
));
713 tem1
= assq_no_quit (sym
, current_buffer
->local_var_alist
);
715 tem1
= XCONS (XCONS (valcontents
)->cdr
)->cdr
;
716 XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
= tem1
;
717 XSET (XCONS (XCONS (valcontents
)->cdr
)->car
, Lisp_Buffer
, current_buffer
);
718 store_symval_forwarding (sym
, XCONS (valcontents
)->car
, Fcdr (tem1
));
720 return XCONS (valcontents
)->car
;
723 /* Find the value of a symbol, returning Qunbound if it's not bound.
724 This is helpful for code which just wants to get a variable's value
725 if it has one, without signalling an error.
726 Note that it must not be possible to quit
727 within this function. Great care is required for this. */
730 find_symbol_value (sym
)
733 register Lisp_Object valcontents
, tem1
;
734 register Lisp_Object val
;
735 CHECK_SYMBOL (sym
, 0);
736 valcontents
= XSYMBOL (sym
)->value
;
739 #ifdef SWITCH_ENUM_BUG
740 switch ((int) XTYPE (valcontents
))
742 switch (XTYPE (valcontents
))
745 case Lisp_Buffer_Local_Value
:
746 case Lisp_Some_Buffer_Local_Value
:
747 valcontents
= swap_in_symval_forwarding (sym
, valcontents
);
751 XSET (val
, Lisp_Int
, *XINTPTR (valcontents
));
755 if (*XINTPTR (valcontents
))
760 return *XOBJFWD (valcontents
);
762 case Lisp_Buffer_Objfwd
:
763 return *(Lisp_Object
*)(XUINT (valcontents
) + (char *)current_buffer
);
772 DEFUN ("symbol-value", Fsymbol_value
, Ssymbol_value
, 1, 1, 0,
773 "Return SYMBOL's value. Error if that is void.")
777 Lisp_Object val
= find_symbol_value (sym
);
779 if (EQ (val
, Qunbound
))
780 return Fsignal (Qvoid_variable
, Fcons (sym
, Qnil
));
785 DEFUN ("set", Fset
, Sset
, 2, 2, 0,
786 "Set SYMBOL's value to NEWVAL, and return NEWVAL.")
788 register Lisp_Object sym
, newval
;
790 int voide
= (XTYPE (newval
) == Lisp_Void
|| EQ (newval
, Qunbound
));
792 #ifndef RTPC_REGISTER_BUG
793 register Lisp_Object valcontents
, tem1
, current_alist_element
;
794 #else /* RTPC_REGISTER_BUG */
795 register Lisp_Object tem1
;
796 Lisp_Object valcontents
, current_alist_element
;
797 #endif /* RTPC_REGISTER_BUG */
799 CHECK_SYMBOL (sym
, 0);
800 if (NILP (sym
) || EQ (sym
, Qt
))
801 return Fsignal (Qsetting_constant
, Fcons (sym
, Qnil
));
802 valcontents
= XSYMBOL (sym
)->value
;
804 if (XTYPE (valcontents
) == Lisp_Buffer_Objfwd
)
806 register int idx
= XUINT (valcontents
);
807 register int mask
= *(int *)(idx
+ (char *) &buffer_local_flags
);
809 current_buffer
->local_var_flags
|= mask
;
812 else if (XTYPE (valcontents
) == Lisp_Buffer_Local_Value
813 || XTYPE (valcontents
) == Lisp_Some_Buffer_Local_Value
)
815 /* valcontents is actually a pointer to a cons heading something like:
816 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE).
818 BUFFER is the last buffer for which this symbol's value was
821 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
822 local_var_alist, that being the element whose car is this
823 variable. Or it can be a pointer to the
824 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not
825 have an element in its alist for this variable (that is, if
826 BUFFER sees the default value of this variable).
828 If we want to examine or set the value and BUFFER is current,
829 we just examine or set REALVALUE. If BUFFER is not current, we
830 store the current REALVALUE value into CURRENT-ALIST-ELEMENT,
831 then find the appropriate alist element for the buffer now
832 current and set up CURRENT-ALIST-ELEMENT. Then we set
833 REALVALUE out of that element, and store into BUFFER.
835 If we are setting the variable and the current buffer does
836 not have an alist entry for this variable, an alist entry is
839 Note that REALVALUE can be a forwarding pointer. Each time
840 it is examined or set, forwarding must be done. */
842 /* What value are we caching right now? */
843 current_alist_element
=
844 XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
;
846 /* If the current buffer is not the buffer whose binding is
847 currently cached, or if it's a Lisp_Buffer_Local_Value and
848 we're looking at the default value, the cache is invalid; we
849 need to write it out, and find the new CURRENT-ALIST-ELEMENT. */
851 != XBUFFER (XCONS (XCONS (valcontents
)->cdr
)->car
))
852 || (XTYPE (valcontents
) == Lisp_Buffer_Local_Value
853 && EQ (XCONS (current_alist_element
)->car
,
854 current_alist_element
)))
856 /* Write out the cached value for the old buffer; copy it
857 back to its alist element. This works if the current
858 buffer only sees the default value, too. */
859 Fsetcdr (current_alist_element
,
860 do_symval_forwarding (XCONS (valcontents
)->car
));
862 /* Find the new value for CURRENT-ALIST-ELEMENT. */
863 tem1
= Fassq (sym
, current_buffer
->local_var_alist
);
866 /* This buffer still sees the default value. */
868 /* If the variable is a Lisp_Some_Buffer_Local_Value,
869 make CURRENT-ALIST-ELEMENT point to itself,
870 indicating that we're seeing the default value. */
871 if (XTYPE (valcontents
) == Lisp_Some_Buffer_Local_Value
)
872 tem1
= XCONS (XCONS (valcontents
)->cdr
)->cdr
;
874 /* If it's a Lisp_Buffer_Local_Value, give this buffer a
875 new assoc for a local value and set
876 CURRENT-ALIST-ELEMENT to point to that. */
879 tem1
= Fcons (sym
, Fcdr (current_alist_element
));
880 current_buffer
->local_var_alist
=
881 Fcons (tem1
, current_buffer
->local_var_alist
);
884 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
885 XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
= tem1
;
887 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
888 XSET (XCONS (XCONS (valcontents
)->cdr
)->car
,
889 Lisp_Buffer
, current_buffer
);
891 valcontents
= XCONS (valcontents
)->car
;
894 /* If storing void (making the symbol void), forward only through
895 buffer-local indicator, not through Lisp_Objfwd, etc. */
897 store_symval_forwarding (sym
, Qnil
, newval
);
899 store_symval_forwarding (sym
, valcontents
, newval
);
904 /* Access or set a buffer-local symbol's default value. */
906 /* Return the default value of SYM, but don't check for voidness.
907 Return Qunbound or a Lisp_Void object if it is void. */
913 register Lisp_Object valcontents
;
915 CHECK_SYMBOL (sym
, 0);
916 valcontents
= XSYMBOL (sym
)->value
;
918 /* For a built-in buffer-local variable, get the default value
919 rather than letting do_symval_forwarding get the current value. */
920 if (XTYPE (valcontents
) == Lisp_Buffer_Objfwd
)
922 register int idx
= XUINT (valcontents
);
924 if (*(int *) (idx
+ (char *) &buffer_local_flags
) != 0)
925 return *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
928 /* Handle user-created local variables. */
929 if (XTYPE (valcontents
) == Lisp_Buffer_Local_Value
930 || XTYPE (valcontents
) == Lisp_Some_Buffer_Local_Value
)
932 /* If var is set up for a buffer that lacks a local value for it,
933 the current value is nominally the default value.
934 But the current value slot may be more up to date, since
935 ordinary setq stores just that slot. So use that. */
936 Lisp_Object current_alist_element
, alist_element_car
;
937 current_alist_element
938 = XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
;
939 alist_element_car
= XCONS (current_alist_element
)->car
;
940 if (EQ (alist_element_car
, current_alist_element
))
941 return do_symval_forwarding (XCONS (valcontents
)->car
);
943 return XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->cdr
;
945 /* For other variables, get the current value. */
946 return do_symval_forwarding (valcontents
);
949 DEFUN ("default-boundp", Fdefault_boundp
, Sdefault_boundp
, 1, 1, 0,
950 "Return T if SYMBOL has a non-void default value.\n\
951 This is the value that is seen in buffers that do not have their own values\n\
956 register Lisp_Object value
;
958 value
= default_value (sym
);
959 return (XTYPE (value
) == Lisp_Void
|| EQ (value
, Qunbound
)
963 DEFUN ("default-value", Fdefault_value
, Sdefault_value
, 1, 1, 0,
964 "Return SYMBOL's default value.\n\
965 This is the value that is seen in buffers that do not have their own values\n\
966 for this variable. The default value is meaningful for variables with\n\
967 local bindings in certain buffers.")
971 register Lisp_Object value
;
973 value
= default_value (sym
);
974 if (XTYPE (value
) == Lisp_Void
|| EQ (value
, Qunbound
))
975 return Fsignal (Qvoid_variable
, Fcons (sym
, Qnil
));
979 DEFUN ("set-default", Fset_default
, Sset_default
, 2, 2, 0,
980 "Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.\n\
981 The default value is seen in buffers that do not have their own values\n\
984 Lisp_Object sym
, value
;
986 register Lisp_Object valcontents
, current_alist_element
, alist_element_buffer
;
988 CHECK_SYMBOL (sym
, 0);
989 valcontents
= XSYMBOL (sym
)->value
;
991 /* Handle variables like case-fold-search that have special slots
992 in the buffer. Make them work apparently like Lisp_Buffer_Local_Value
994 if (XTYPE (valcontents
) == Lisp_Buffer_Objfwd
)
996 register int idx
= XUINT (valcontents
);
997 #ifndef RTPC_REGISTER_BUG
998 register struct buffer
*b
;
1002 register int mask
= *(int *) (idx
+ (char *) &buffer_local_flags
);
1006 *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
) = value
;
1007 for (b
= all_buffers
; b
; b
= b
->next
)
1008 if (!(b
->local_var_flags
& mask
))
1009 *(Lisp_Object
*)(idx
+ (char *) b
) = value
;
1014 if (XTYPE (valcontents
) != Lisp_Buffer_Local_Value
&&
1015 XTYPE (valcontents
) != Lisp_Some_Buffer_Local_Value
)
1016 return Fset (sym
, value
);
1018 /* Store new value into the DEFAULT-VALUE slot */
1019 XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->cdr
= value
;
1021 /* If that slot is current, we must set the REALVALUE slot too */
1022 current_alist_element
= XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
;
1023 alist_element_buffer
= Fcar (current_alist_element
);
1024 if (EQ (alist_element_buffer
, current_alist_element
))
1025 store_symval_forwarding (sym
, XCONS (valcontents
)->car
, value
);
1030 DEFUN ("setq-default", Fsetq_default
, Ssetq_default
, 2, UNEVALLED
, 0,
1032 (setq-default SYM VAL SYM VAL ...): set each SYM's default value to its VAL.\n\
1033 VAL is evaluated; SYM is not. The default value is seen in buffers that do\n\
1034 not have their own values for this variable.")
1038 register Lisp_Object args_left
;
1039 register Lisp_Object val
, sym
;
1040 struct gcpro gcpro1
;
1050 val
= Feval (Fcar (Fcdr (args_left
)));
1051 sym
= Fcar (args_left
);
1052 Fset_default (sym
, val
);
1053 args_left
= Fcdr (Fcdr (args_left
));
1055 while (!NILP (args_left
));
1061 /* Lisp functions for creating and removing buffer-local variables. */
1063 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local
, Smake_variable_buffer_local
,
1064 1, 1, "vMake Variable Buffer Local: ",
1065 "Make VARIABLE have a separate value for each buffer.\n\
1066 At any time, the value for the current buffer is in effect.\n\
1067 There is also a default value which is seen in any buffer which has not yet\n\
1068 set its own value.\n\
1069 Using `set' or `setq' to set the variable causes it to have a separate value\n\
1070 for the current buffer if it was previously using the default value.\n\
1071 The function `default-value' gets the default value and `set-default' sets it.")
1073 register Lisp_Object sym
;
1075 register Lisp_Object tem
, valcontents
;
1077 CHECK_SYMBOL (sym
, 0);
1079 if (EQ (sym
, Qnil
) || EQ (sym
, Qt
))
1080 error ("Symbol %s may not be buffer-local", XSYMBOL (sym
)->name
->data
);
1082 valcontents
= XSYMBOL (sym
)->value
;
1083 if ((XTYPE (valcontents
) == Lisp_Buffer_Local_Value
) ||
1084 (XTYPE (valcontents
) == Lisp_Buffer_Objfwd
))
1086 if (XTYPE (valcontents
) == Lisp_Some_Buffer_Local_Value
)
1088 XSETTYPE (XSYMBOL (sym
)->value
, Lisp_Buffer_Local_Value
);
1091 if (EQ (valcontents
, Qunbound
))
1092 XSYMBOL (sym
)->value
= Qnil
;
1093 tem
= Fcons (Qnil
, Fsymbol_value (sym
));
1094 XCONS (tem
)->car
= tem
;
1095 XSYMBOL (sym
)->value
= Fcons (XSYMBOL (sym
)->value
, Fcons (Fcurrent_buffer (), tem
));
1096 XSETTYPE (XSYMBOL (sym
)->value
, Lisp_Buffer_Local_Value
);
1100 DEFUN ("make-local-variable", Fmake_local_variable
, Smake_local_variable
,
1101 1, 1, "vMake Local Variable: ",
1102 "Make VARIABLE have a separate value in the current buffer.\n\
1103 Other buffers will continue to share a common default value.\n\
1104 See also `make-variable-buffer-local'.\n\n\
1105 If the variable is already arranged to become local when set,\n\
1106 this function causes a local value to exist for this buffer,\n\
1107 just as if the variable were set.")
1109 register Lisp_Object sym
;
1111 register Lisp_Object tem
, valcontents
;
1113 CHECK_SYMBOL (sym
, 0);
1115 if (EQ (sym
, Qnil
) || EQ (sym
, Qt
))
1116 error ("Symbol %s may not be buffer-local", XSYMBOL (sym
)->name
->data
);
1118 valcontents
= XSYMBOL (sym
)->value
;
1119 if (XTYPE (valcontents
) == Lisp_Buffer_Local_Value
1120 || XTYPE (valcontents
) == Lisp_Buffer_Objfwd
)
1122 tem
= Fboundp (sym
);
1124 /* Make sure the symbol has a local value in this particular buffer,
1125 by setting it to the same value it already has. */
1126 Fset (sym
, (EQ (tem
, Qt
) ? Fsymbol_value (sym
) : Qunbound
));
1129 /* Make sure sym is set up to hold per-buffer values */
1130 if (XTYPE (valcontents
) != Lisp_Some_Buffer_Local_Value
)
1132 if (EQ (valcontents
, Qunbound
))
1133 XSYMBOL (sym
)->value
= Qnil
;
1134 tem
= Fcons (Qnil
, do_symval_forwarding (valcontents
));
1135 XCONS (tem
)->car
= tem
;
1136 XSYMBOL (sym
)->value
= Fcons (XSYMBOL (sym
)->value
, Fcons (Qnil
, tem
));
1137 XSETTYPE (XSYMBOL (sym
)->value
, Lisp_Some_Buffer_Local_Value
);
1139 /* Make sure this buffer has its own value of sym */
1140 tem
= Fassq (sym
, current_buffer
->local_var_alist
);
1143 current_buffer
->local_var_alist
1144 = Fcons (Fcons (sym
, XCONS (XCONS (XCONS (XSYMBOL (sym
)->value
)->cdr
)->cdr
)->cdr
),
1145 current_buffer
->local_var_alist
);
1147 /* Make sure symbol does not think it is set up for this buffer;
1148 force it to look once again for this buffer's value */
1150 /* This local variable avoids "expression too complex" on IBM RT. */
1153 xs
= XSYMBOL (sym
)->value
;
1154 if (current_buffer
== XBUFFER (XCONS (XCONS (xs
)->cdr
)->car
))
1155 XCONS (XCONS (XSYMBOL (sym
)->value
)->cdr
)->car
= Qnil
;
1159 /* If the symbol forwards into a C variable, then swap in the
1160 variable for this buffer immediately. If C code modifies the
1161 variable before we swap in, then that new value will clobber the
1162 default value the next time we swap. */
1163 valcontents
= XCONS (XSYMBOL (sym
)->value
)->car
;
1164 if (XTYPE (valcontents
) == Lisp_Intfwd
1165 || XTYPE (valcontents
) == Lisp_Boolfwd
1166 || XTYPE (valcontents
) == Lisp_Objfwd
)
1167 swap_in_symval_forwarding (sym
, XSYMBOL (sym
)->value
);
1172 DEFUN ("kill-local-variable", Fkill_local_variable
, Skill_local_variable
,
1173 1, 1, "vKill Local Variable: ",
1174 "Make VARIABLE no longer have a separate value in the current buffer.\n\
1175 From now on the default value will apply in this buffer.")
1177 register Lisp_Object sym
;
1179 register Lisp_Object tem
, valcontents
;
1181 CHECK_SYMBOL (sym
, 0);
1183 valcontents
= XSYMBOL (sym
)->value
;
1185 if (XTYPE (valcontents
) == Lisp_Buffer_Objfwd
)
1187 register int idx
= XUINT (valcontents
);
1188 register int mask
= *(int *) (idx
+ (char *) &buffer_local_flags
);
1192 *(Lisp_Object
*)(idx
+ (char *) current_buffer
)
1193 = *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
1194 current_buffer
->local_var_flags
&= ~mask
;
1199 if (XTYPE (valcontents
) != Lisp_Buffer_Local_Value
&&
1200 XTYPE (valcontents
) != Lisp_Some_Buffer_Local_Value
)
1203 /* Get rid of this buffer's alist element, if any */
1205 tem
= Fassq (sym
, current_buffer
->local_var_alist
);
1207 current_buffer
->local_var_alist
= Fdelq (tem
, current_buffer
->local_var_alist
);
1209 /* Make sure symbol does not think it is set up for this buffer;
1210 force it to look once again for this buffer's value */
1213 sv
= XSYMBOL (sym
)->value
;
1214 if (current_buffer
== XBUFFER (XCONS (XCONS (sv
)->cdr
)->car
))
1215 XCONS (XCONS (sv
)->cdr
)->car
= Qnil
;
1221 /* Find the function at the end of a chain of symbol function indirections. */
1223 /* If OBJECT is a symbol, find the end of its function chain and
1224 return the value found there. If OBJECT is not a symbol, just
1225 return it. If there is a cycle in the function chain, signal a
1226 cyclic-function-indirection error.
1228 This is like Findirect_function, except that it doesn't signal an
1229 error if the chain ends up unbound. */
1231 indirect_function (object
)
1232 register Lisp_Object object
;
1234 Lisp_Object tortoise
, hare
;
1236 hare
= tortoise
= object
;
1240 if (XTYPE (hare
) != Lisp_Symbol
|| EQ (hare
, Qunbound
))
1242 hare
= XSYMBOL (hare
)->function
;
1243 if (XTYPE (hare
) != Lisp_Symbol
|| EQ (hare
, Qunbound
))
1245 hare
= XSYMBOL (hare
)->function
;
1247 tortoise
= XSYMBOL (tortoise
)->function
;
1249 if (EQ (hare
, tortoise
))
1250 Fsignal (Qcyclic_function_indirection
, Fcons (object
, Qnil
));
1256 DEFUN ("indirect-function", Findirect_function
, Sindirect_function
, 1, 1, 0,
1257 "Return the function at the end of OBJECT's function chain.\n\
1258 If OBJECT is a symbol, follow all function indirections and return the final\n\
1259 function binding.\n\
1260 If OBJECT is not a symbol, just return it.\n\
1261 Signal a void-function error if the final symbol is unbound.\n\
1262 Signal a cyclic-function-indirection error if there is a loop in the\n\
1263 function chain of symbols.")
1265 register Lisp_Object object
;
1269 result
= indirect_function (object
);
1271 if (EQ (result
, Qunbound
))
1272 return Fsignal (Qvoid_function
, Fcons (object
, Qnil
));
1276 /* Extract and set vector and string elements */
1278 DEFUN ("aref", Faref
, Saref
, 2, 2, 0,
1279 "Return the element of ARRAY at index INDEX.\n\
1280 ARRAY may be a vector or a string, or a byte-code object. INDEX starts at 0.")
1282 register Lisp_Object array
;
1285 register int idxval
;
1287 CHECK_NUMBER (idx
, 1);
1288 idxval
= XINT (idx
);
1289 if (XTYPE (array
) != Lisp_Vector
&& XTYPE (array
) != Lisp_String
1290 && XTYPE (array
) != Lisp_Compiled
)
1291 array
= wrong_type_argument (Qarrayp
, array
);
1292 if (idxval
< 0 || idxval
>= XVECTOR (array
)->size
)
1293 args_out_of_range (array
, idx
);
1294 if (XTYPE (array
) == Lisp_String
)
1297 XFASTINT (val
) = (unsigned char) XSTRING (array
)->data
[idxval
];
1301 return XVECTOR (array
)->contents
[idxval
];
1304 DEFUN ("aset", Faset
, Saset
, 3, 3, 0,
1305 "Store into the element of ARRAY at index INDEX the value NEWVAL.\n\
1306 ARRAY may be a vector or a string. INDEX starts at 0.")
1307 (array
, idx
, newelt
)
1308 register Lisp_Object array
;
1309 Lisp_Object idx
, newelt
;
1311 register int idxval
;
1313 CHECK_NUMBER (idx
, 1);
1314 idxval
= XINT (idx
);
1315 if (XTYPE (array
) != Lisp_Vector
&& XTYPE (array
) != Lisp_String
)
1316 array
= wrong_type_argument (Qarrayp
, array
);
1317 if (idxval
< 0 || idxval
>= XVECTOR (array
)->size
)
1318 args_out_of_range (array
, idx
);
1319 CHECK_IMPURE (array
);
1321 if (XTYPE (array
) == Lisp_Vector
)
1322 XVECTOR (array
)->contents
[idxval
] = newelt
;
1325 CHECK_NUMBER (newelt
, 2);
1326 XSTRING (array
)->data
[idxval
] = XINT (newelt
);
1333 Farray_length (array
)
1334 register Lisp_Object array
;
1336 register Lisp_Object size
;
1337 if (XTYPE (array
) != Lisp_Vector
&& XTYPE (array
) != Lisp_String
1338 && XTYPE (array
) != Lisp_Compiled
)
1339 array
= wrong_type_argument (Qarrayp
, array
);
1340 XFASTINT (size
) = XVECTOR (array
)->size
;
1344 /* Arithmetic functions */
1346 enum comparison
{ equal
, notequal
, less
, grtr
, less_or_equal
, grtr_or_equal
};
1349 arithcompare (num1
, num2
, comparison
)
1350 Lisp_Object num1
, num2
;
1351 enum comparison comparison
;
1356 #ifdef LISP_FLOAT_TYPE
1357 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1
, 0);
1358 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2
, 0);
1360 if (XTYPE (num1
) == Lisp_Float
|| XTYPE (num2
) == Lisp_Float
)
1363 f1
= (XTYPE (num1
) == Lisp_Float
) ? XFLOAT (num1
)->data
: XINT (num1
);
1364 f2
= (XTYPE (num2
) == Lisp_Float
) ? XFLOAT (num2
)->data
: XINT (num2
);
1367 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1368 CHECK_NUMBER_COERCE_MARKER (num2
, 0);
1369 #endif /* LISP_FLOAT_TYPE */
1374 if (floatp
? f1
== f2
: XINT (num1
) == XINT (num2
))
1379 if (floatp
? f1
!= f2
: XINT (num1
) != XINT (num2
))
1384 if (floatp
? f1
< f2
: XINT (num1
) < XINT (num2
))
1389 if (floatp
? f1
<= f2
: XINT (num1
) <= XINT (num2
))
1394 if (floatp
? f1
> f2
: XINT (num1
) > XINT (num2
))
1399 if (floatp
? f1
>= f2
: XINT (num1
) >= XINT (num2
))
1408 DEFUN ("=", Feqlsign
, Seqlsign
, 2, 2, 0,
1409 "T if two args, both numbers or markers, are equal.")
1411 register Lisp_Object num1
, num2
;
1413 return arithcompare (num1
, num2
, equal
);
1416 DEFUN ("<", Flss
, Slss
, 2, 2, 0,
1417 "T if first arg is less than second arg. Both must be numbers or markers.")
1419 register Lisp_Object num1
, num2
;
1421 return arithcompare (num1
, num2
, less
);
1424 DEFUN (">", Fgtr
, Sgtr
, 2, 2, 0,
1425 "T if first arg is greater than second arg. Both must be numbers or markers.")
1427 register Lisp_Object num1
, num2
;
1429 return arithcompare (num1
, num2
, grtr
);
1432 DEFUN ("<=", Fleq
, Sleq
, 2, 2, 0,
1433 "T if first arg is less than or equal to second arg.\n\
1434 Both must be numbers or markers.")
1436 register Lisp_Object num1
, num2
;
1438 return arithcompare (num1
, num2
, less_or_equal
);
1441 DEFUN (">=", Fgeq
, Sgeq
, 2, 2, 0,
1442 "T if first arg is greater than or equal to second arg.\n\
1443 Both must be numbers or markers.")
1445 register Lisp_Object num1
, num2
;
1447 return arithcompare (num1
, num2
, grtr_or_equal
);
1450 DEFUN ("/=", Fneq
, Sneq
, 2, 2, 0,
1451 "T if first arg is not equal to second arg. Both must be numbers or markers.")
1453 register Lisp_Object num1
, num2
;
1455 return arithcompare (num1
, num2
, notequal
);
1458 DEFUN ("zerop", Fzerop
, Szerop
, 1, 1, 0, "T if NUMBER is zero.")
1460 register Lisp_Object num
;
1462 #ifdef LISP_FLOAT_TYPE
1463 CHECK_NUMBER_OR_FLOAT (num
, 0);
1465 if (XTYPE(num
) == Lisp_Float
)
1467 if (XFLOAT(num
)->data
== 0.0)
1472 CHECK_NUMBER (num
, 0);
1473 #endif /* LISP_FLOAT_TYPE */
1480 /* Convert between 32-bit values and pairs of lispy 24-bit values. */
1486 unsigned int top
= i
>> 16;
1487 unsigned int bot
= i
& 0xFFFF;
1489 return make_number (bot
);
1491 return Fcons (make_number (-1), make_number (bot
));
1492 return Fcons (make_number (top
), make_number (bot
));
1499 Lisp_Object top
, bot
;
1502 top
= XCONS (c
)->car
;
1503 bot
= XCONS (c
)->cdr
;
1505 bot
= XCONS (bot
)->car
;
1506 return ((XINT (top
) << 16) | XINT (bot
));
1509 DEFUN ("number-to-string", Fnumber_to_string
, Snumber_to_string
, 1, 1, 0,
1510 "Convert NUM to a string by printing it in decimal.\n\
1511 Uses a minus sign if negative.\n\
1512 NUM may be an integer or a floating point number.")
1518 #ifndef LISP_FLOAT_TYPE
1519 CHECK_NUMBER (num
, 0);
1521 CHECK_NUMBER_OR_FLOAT (num
, 0);
1523 if (XTYPE(num
) == Lisp_Float
)
1525 char pigbuf
[350]; /* see comments in float_to_string */
1527 float_to_string (pigbuf
, XFLOAT(num
)->data
);
1528 return build_string (pigbuf
);
1530 #endif /* LISP_FLOAT_TYPE */
1532 sprintf (buffer
, "%d", XINT (num
));
1533 return build_string (buffer
);
1536 DEFUN ("string-to-number", Fstring_to_number
, Sstring_to_number
, 1, 1, 0,
1537 "Convert STRING to a number by parsing it as a decimal number.\n\
1538 This parses both integers and floating point numbers.")
1540 register Lisp_Object str
;
1544 CHECK_STRING (str
, 0);
1546 p
= XSTRING (str
)->data
;
1548 /* Skip any whitespace at the front of the number. Some versions of
1549 atoi do this anyway, so we might as well make Emacs lisp consistent. */
1550 while (*p
== ' ' || *p
== '\t')
1553 #ifdef LISP_FLOAT_TYPE
1554 if (isfloat_string (p
))
1555 return make_float (atof (p
));
1556 #endif /* LISP_FLOAT_TYPE */
1558 return make_number (atoi (p
));
1562 { Aadd
, Asub
, Amult
, Adiv
, Alogand
, Alogior
, Alogxor
, Amax
, Amin
};
1564 extern Lisp_Object
float_arith_driver ();
1567 arith_driver (code
, nargs
, args
)
1570 register Lisp_Object
*args
;
1572 register Lisp_Object val
;
1573 register int argnum
;
1577 #ifdef SWITCH_ENUM_BUG
1594 for (argnum
= 0; argnum
< nargs
; argnum
++)
1596 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
1597 #ifdef LISP_FLOAT_TYPE
1598 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
1600 if (XTYPE (val
) == Lisp_Float
) /* time to do serious math */
1601 return (float_arith_driver ((double) accum
, argnum
, code
,
1604 CHECK_NUMBER_COERCE_MARKER (val
, argnum
);
1605 #endif /* LISP_FLOAT_TYPE */
1606 args
[argnum
] = val
; /* runs into a compiler bug. */
1607 next
= XINT (args
[argnum
]);
1608 #ifdef SWITCH_ENUM_BUG
1614 case Aadd
: accum
+= next
; break;
1616 if (!argnum
&& nargs
!= 1)
1620 case Amult
: accum
*= next
; break;
1622 if (!argnum
) accum
= next
;
1626 Fsignal (Qarith_error
, Qnil
);
1630 case Alogand
: accum
&= next
; break;
1631 case Alogior
: accum
|= next
; break;
1632 case Alogxor
: accum
^= next
; break;
1633 case Amax
: if (!argnum
|| next
> accum
) accum
= next
; break;
1634 case Amin
: if (!argnum
|| next
< accum
) accum
= next
; break;
1638 XSET (val
, Lisp_Int
, accum
);
1642 #ifdef LISP_FLOAT_TYPE
1644 float_arith_driver (accum
, argnum
, code
, nargs
, args
)
1646 register int argnum
;
1649 register Lisp_Object
*args
;
1651 register Lisp_Object val
;
1654 for (; argnum
< nargs
; argnum
++)
1656 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
1657 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
1659 if (XTYPE (val
) == Lisp_Float
)
1661 next
= XFLOAT (val
)->data
;
1665 args
[argnum
] = val
; /* runs into a compiler bug. */
1666 next
= XINT (args
[argnum
]);
1668 #ifdef SWITCH_ENUM_BUG
1678 if (!argnum
&& nargs
!= 1)
1691 Fsignal (Qarith_error
, Qnil
);
1698 return wrong_type_argument (Qinteger_or_marker_p
, val
);
1700 if (!argnum
|| next
> accum
)
1704 if (!argnum
|| next
< accum
)
1710 return make_float (accum
);
1712 #endif /* LISP_FLOAT_TYPE */
1714 DEFUN ("+", Fplus
, Splus
, 0, MANY
, 0,
1715 "Return sum of any number of arguments, which are numbers or markers.")
1720 return arith_driver (Aadd
, nargs
, args
);
1723 DEFUN ("-", Fminus
, Sminus
, 0, MANY
, 0,
1724 "Negate number or subtract numbers or markers.\n\
1725 With one arg, negates it. With more than one arg,\n\
1726 subtracts all but the first from the first.")
1731 return arith_driver (Asub
, nargs
, args
);
1734 DEFUN ("*", Ftimes
, Stimes
, 0, MANY
, 0,
1735 "Returns product of any number of arguments, which are numbers or markers.")
1740 return arith_driver (Amult
, nargs
, args
);
1743 DEFUN ("/", Fquo
, Squo
, 2, MANY
, 0,
1744 "Returns first argument divided by all the remaining arguments.\n\
1745 The arguments must be numbers or markers.")
1750 return arith_driver (Adiv
, nargs
, args
);
1753 DEFUN ("%", Frem
, Srem
, 2, 2, 0,
1754 "Returns remainder of first arg divided by second.\n\
1755 Both must be integers or markers.")
1757 register Lisp_Object num1
, num2
;
1761 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1762 CHECK_NUMBER_COERCE_MARKER (num2
, 1);
1764 if (XFASTINT (num2
) == 0)
1765 Fsignal (Qarith_error
, Qnil
);
1767 XSET (val
, Lisp_Int
, XINT (num1
) % XINT (num2
));
1771 DEFUN ("mod", Fmod
, Smod
, 2, 2, 0,
1772 "Returns X modulo Y.\n\
1773 The result falls between zero (inclusive) and Y (exclusive).\n\
1774 Both X and Y must be numbers or markers.")
1776 register Lisp_Object num1
, num2
;
1781 #ifdef LISP_FLOAT_TYPE
1782 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1
, 0);
1783 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2
, 1);
1785 if (XTYPE (num1
) == Lisp_Float
|| XTYPE (num2
) == Lisp_Float
)
1789 f1
= XTYPE (num1
) == Lisp_Float
? XFLOAT (num1
)->data
: XINT (num1
);
1790 f2
= XTYPE (num2
) == Lisp_Float
? XFLOAT (num2
)->data
: XINT (num2
);
1792 Fsignal (Qarith_error
, Qnil
);
1794 #if defined (USG) || defined (sun) || defined (ultrix) || defined (hpux)
1799 /* If the "remainder" comes out with the wrong sign, fix it. */
1800 if ((f1
< 0) != (f2
< 0))
1802 return (make_float (f1
));
1804 #else /* not LISP_FLOAT_TYPE */
1805 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1806 CHECK_NUMBER_COERCE_MARKER (num2
, 1);
1807 #endif /* not LISP_FLOAT_TYPE */
1813 Fsignal (Qarith_error
, Qnil
);
1817 /* If the "remainder" comes out with the wrong sign, fix it. */
1818 if ((i1
< 0) != (i2
< 0))
1821 XSET (val
, Lisp_Int
, i1
);
1825 DEFUN ("max", Fmax
, Smax
, 1, MANY
, 0,
1826 "Return largest of all the arguments (which must be numbers or markers).\n\
1827 The value is always a number; markers are converted to numbers.")
1832 return arith_driver (Amax
, nargs
, args
);
1835 DEFUN ("min", Fmin
, Smin
, 1, MANY
, 0,
1836 "Return smallest of all the arguments (which must be numbers or markers).\n\
1837 The value is always a number; markers are converted to numbers.")
1842 return arith_driver (Amin
, nargs
, args
);
1845 DEFUN ("logand", Flogand
, Slogand
, 0, MANY
, 0,
1846 "Return bitwise-and of all the arguments.\n\
1847 Arguments may be integers, or markers converted to integers.")
1852 return arith_driver (Alogand
, nargs
, args
);
1855 DEFUN ("logior", Flogior
, Slogior
, 0, MANY
, 0,
1856 "Return bitwise-or of all the arguments.\n\
1857 Arguments may be integers, or markers converted to integers.")
1862 return arith_driver (Alogior
, nargs
, args
);
1865 DEFUN ("logxor", Flogxor
, Slogxor
, 0, MANY
, 0,
1866 "Return bitwise-exclusive-or of all the arguments.\n\
1867 Arguments may be integers, or markers converted to integers.")
1872 return arith_driver (Alogxor
, nargs
, args
);
1875 DEFUN ("ash", Fash
, Sash
, 2, 2, 0,
1876 "Return VALUE with its bits shifted left by COUNT.\n\
1877 If COUNT is negative, shifting is actually to the right.\n\
1878 In this case, the sign bit is duplicated.")
1880 register Lisp_Object num1
, num2
;
1882 register Lisp_Object val
;
1884 CHECK_NUMBER (num1
, 0);
1885 CHECK_NUMBER (num2
, 1);
1887 if (XINT (num2
) > 0)
1888 XSET (val
, Lisp_Int
, XINT (num1
) << XFASTINT (num2
));
1890 XSET (val
, Lisp_Int
, XINT (num1
) >> -XINT (num2
));
1894 DEFUN ("lsh", Flsh
, Slsh
, 2, 2, 0,
1895 "Return VALUE with its bits shifted left by COUNT.\n\
1896 If COUNT is negative, shifting is actually to the right.\n\
1897 In this case, zeros are shifted in on the left.")
1899 register Lisp_Object num1
, num2
;
1901 register Lisp_Object val
;
1903 CHECK_NUMBER (num1
, 0);
1904 CHECK_NUMBER (num2
, 1);
1906 if (XINT (num2
) > 0)
1907 XSET (val
, Lisp_Int
, (unsigned) XFASTINT (num1
) << XFASTINT (num2
));
1909 XSET (val
, Lisp_Int
, (unsigned) XFASTINT (num1
) >> -XINT (num2
));
1913 DEFUN ("1+", Fadd1
, Sadd1
, 1, 1, 0,
1914 "Return NUMBER plus one. NUMBER may be a number or a marker.\n\
1915 Markers are converted to integers.")
1917 register Lisp_Object num
;
1919 #ifdef LISP_FLOAT_TYPE
1920 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num
, 0);
1922 if (XTYPE (num
) == Lisp_Float
)
1923 return (make_float (1.0 + XFLOAT (num
)->data
));
1925 CHECK_NUMBER_COERCE_MARKER (num
, 0);
1926 #endif /* LISP_FLOAT_TYPE */
1928 XSETINT (num
, XFASTINT (num
) + 1);
1932 DEFUN ("1-", Fsub1
, Ssub1
, 1, 1, 0,
1933 "Return NUMBER minus one. NUMBER may be a number or a marker.\n\
1934 Markers are converted to integers.")
1936 register Lisp_Object num
;
1938 #ifdef LISP_FLOAT_TYPE
1939 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num
, 0);
1941 if (XTYPE (num
) == Lisp_Float
)
1942 return (make_float (-1.0 + XFLOAT (num
)->data
));
1944 CHECK_NUMBER_COERCE_MARKER (num
, 0);
1945 #endif /* LISP_FLOAT_TYPE */
1947 XSETINT (num
, XFASTINT (num
) - 1);
1951 DEFUN ("lognot", Flognot
, Slognot
, 1, 1, 0,
1952 "Return the bitwise complement of ARG. ARG must be an integer.")
1954 register Lisp_Object num
;
1956 CHECK_NUMBER (num
, 0);
1957 XSETINT (num
, ~XFASTINT (num
));
1964 Lisp_Object error_tail
, arith_tail
;
1966 Qquote
= intern ("quote");
1967 Qlambda
= intern ("lambda");
1968 Qsubr
= intern ("subr");
1969 Qerror_conditions
= intern ("error-conditions");
1970 Qerror_message
= intern ("error-message");
1971 Qtop_level
= intern ("top-level");
1973 Qerror
= intern ("error");
1974 Qquit
= intern ("quit");
1975 Qwrong_type_argument
= intern ("wrong-type-argument");
1976 Qargs_out_of_range
= intern ("args-out-of-range");
1977 Qvoid_function
= intern ("void-function");
1978 Qcyclic_function_indirection
= intern ("cyclic-function-indirection");
1979 Qvoid_variable
= intern ("void-variable");
1980 Qsetting_constant
= intern ("setting-constant");
1981 Qinvalid_read_syntax
= intern ("invalid-read-syntax");
1983 Qinvalid_function
= intern ("invalid-function");
1984 Qwrong_number_of_arguments
= intern ("wrong-number-of-arguments");
1985 Qno_catch
= intern ("no-catch");
1986 Qend_of_file
= intern ("end-of-file");
1987 Qarith_error
= intern ("arith-error");
1988 Qbeginning_of_buffer
= intern ("beginning-of-buffer");
1989 Qend_of_buffer
= intern ("end-of-buffer");
1990 Qbuffer_read_only
= intern ("buffer-read-only");
1991 Qmark_inactive
= intern ("mark-inactive");
1993 Qlistp
= intern ("listp");
1994 Qconsp
= intern ("consp");
1995 Qsymbolp
= intern ("symbolp");
1996 Qintegerp
= intern ("integerp");
1997 Qnatnump
= intern ("natnump");
1998 Qstringp
= intern ("stringp");
1999 Qarrayp
= intern ("arrayp");
2000 Qsequencep
= intern ("sequencep");
2001 Qbufferp
= intern ("bufferp");
2002 Qvectorp
= intern ("vectorp");
2003 Qchar_or_string_p
= intern ("char-or-string-p");
2004 Qmarkerp
= intern ("markerp");
2005 Qbuffer_or_string_p
= intern ("buffer-or-string-p");
2006 Qinteger_or_marker_p
= intern ("integer-or-marker-p");
2007 Qboundp
= intern ("boundp");
2008 Qfboundp
= intern ("fboundp");
2010 #ifdef LISP_FLOAT_TYPE
2011 Qfloatp
= intern ("floatp");
2012 Qnumberp
= intern ("numberp");
2013 Qnumber_or_marker_p
= intern ("number-or-marker-p");
2014 #endif /* LISP_FLOAT_TYPE */
2016 Qcdr
= intern ("cdr");
2018 error_tail
= Fcons (Qerror
, Qnil
);
2020 /* ERROR is used as a signaler for random errors for which nothing else is right */
2022 Fput (Qerror
, Qerror_conditions
,
2024 Fput (Qerror
, Qerror_message
,
2025 build_string ("error"));
2027 Fput (Qquit
, Qerror_conditions
,
2028 Fcons (Qquit
, Qnil
));
2029 Fput (Qquit
, Qerror_message
,
2030 build_string ("Quit"));
2032 Fput (Qwrong_type_argument
, Qerror_conditions
,
2033 Fcons (Qwrong_type_argument
, error_tail
));
2034 Fput (Qwrong_type_argument
, Qerror_message
,
2035 build_string ("Wrong type argument"));
2037 Fput (Qargs_out_of_range
, Qerror_conditions
,
2038 Fcons (Qargs_out_of_range
, error_tail
));
2039 Fput (Qargs_out_of_range
, Qerror_message
,
2040 build_string ("Args out of range"));
2042 Fput (Qvoid_function
, Qerror_conditions
,
2043 Fcons (Qvoid_function
, error_tail
));
2044 Fput (Qvoid_function
, Qerror_message
,
2045 build_string ("Symbol's function definition is void"));
2047 Fput (Qcyclic_function_indirection
, Qerror_conditions
,
2048 Fcons (Qcyclic_function_indirection
, error_tail
));
2049 Fput (Qcyclic_function_indirection
, Qerror_message
,
2050 build_string ("Symbol's chain of function indirections contains a loop"));
2052 Fput (Qvoid_variable
, Qerror_conditions
,
2053 Fcons (Qvoid_variable
, error_tail
));
2054 Fput (Qvoid_variable
, Qerror_message
,
2055 build_string ("Symbol's value as variable is void"));
2057 Fput (Qsetting_constant
, Qerror_conditions
,
2058 Fcons (Qsetting_constant
, error_tail
));
2059 Fput (Qsetting_constant
, Qerror_message
,
2060 build_string ("Attempt to set a constant symbol"));
2062 Fput (Qinvalid_read_syntax
, Qerror_conditions
,
2063 Fcons (Qinvalid_read_syntax
, error_tail
));
2064 Fput (Qinvalid_read_syntax
, Qerror_message
,
2065 build_string ("Invalid read syntax"));
2067 Fput (Qinvalid_function
, Qerror_conditions
,
2068 Fcons (Qinvalid_function
, error_tail
));
2069 Fput (Qinvalid_function
, Qerror_message
,
2070 build_string ("Invalid function"));
2072 Fput (Qwrong_number_of_arguments
, Qerror_conditions
,
2073 Fcons (Qwrong_number_of_arguments
, error_tail
));
2074 Fput (Qwrong_number_of_arguments
, Qerror_message
,
2075 build_string ("Wrong number of arguments"));
2077 Fput (Qno_catch
, Qerror_conditions
,
2078 Fcons (Qno_catch
, error_tail
));
2079 Fput (Qno_catch
, Qerror_message
,
2080 build_string ("No catch for tag"));
2082 Fput (Qend_of_file
, Qerror_conditions
,
2083 Fcons (Qend_of_file
, error_tail
));
2084 Fput (Qend_of_file
, Qerror_message
,
2085 build_string ("End of file during parsing"));
2087 arith_tail
= Fcons (Qarith_error
, error_tail
);
2088 Fput (Qarith_error
, Qerror_conditions
,
2090 Fput (Qarith_error
, Qerror_message
,
2091 build_string ("Arithmetic error"));
2093 Fput (Qbeginning_of_buffer
, Qerror_conditions
,
2094 Fcons (Qbeginning_of_buffer
, error_tail
));
2095 Fput (Qbeginning_of_buffer
, Qerror_message
,
2096 build_string ("Beginning of buffer"));
2098 Fput (Qend_of_buffer
, Qerror_conditions
,
2099 Fcons (Qend_of_buffer
, error_tail
));
2100 Fput (Qend_of_buffer
, Qerror_message
,
2101 build_string ("End of buffer"));
2103 Fput (Qbuffer_read_only
, Qerror_conditions
,
2104 Fcons (Qbuffer_read_only
, error_tail
));
2105 Fput (Qbuffer_read_only
, Qerror_message
,
2106 build_string ("Buffer is read-only"));
2108 #ifdef LISP_FLOAT_TYPE
2109 Qrange_error
= intern ("range-error");
2110 Qdomain_error
= intern ("domain-error");
2111 Qsingularity_error
= intern ("singularity-error");
2112 Qoverflow_error
= intern ("overflow-error");
2113 Qunderflow_error
= intern ("underflow-error");
2115 Fput (Qdomain_error
, Qerror_conditions
,
2116 Fcons (Qdomain_error
, arith_tail
));
2117 Fput (Qdomain_error
, Qerror_message
,
2118 build_string ("Arithmetic domain error"));
2120 Fput (Qrange_error
, Qerror_conditions
,
2121 Fcons (Qrange_error
, arith_tail
));
2122 Fput (Qrange_error
, Qerror_message
,
2123 build_string ("Arithmetic range error"));
2125 Fput (Qsingularity_error
, Qerror_conditions
,
2126 Fcons (Qsingularity_error
, Fcons (Qdomain_error
, arith_tail
)));
2127 Fput (Qsingularity_error
, Qerror_message
,
2128 build_string ("Arithmetic singularity error"));
2130 Fput (Qoverflow_error
, Qerror_conditions
,
2131 Fcons (Qoverflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2132 Fput (Qoverflow_error
, Qerror_message
,
2133 build_string ("Arithmetic overflow error"));
2135 Fput (Qunderflow_error
, Qerror_conditions
,
2136 Fcons (Qunderflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2137 Fput (Qunderflow_error
, Qerror_message
,
2138 build_string ("Arithmetic underflow error"));
2140 staticpro (&Qrange_error
);
2141 staticpro (&Qdomain_error
);
2142 staticpro (&Qsingularity_error
);
2143 staticpro (&Qoverflow_error
);
2144 staticpro (&Qunderflow_error
);
2145 #endif /* LISP_FLOAT_TYPE */
2149 staticpro (&Qquote
);
2150 staticpro (&Qlambda
);
2152 staticpro (&Qunbound
);
2153 staticpro (&Qerror_conditions
);
2154 staticpro (&Qerror_message
);
2155 staticpro (&Qtop_level
);
2157 staticpro (&Qerror
);
2159 staticpro (&Qwrong_type_argument
);
2160 staticpro (&Qargs_out_of_range
);
2161 staticpro (&Qvoid_function
);
2162 staticpro (&Qcyclic_function_indirection
);
2163 staticpro (&Qvoid_variable
);
2164 staticpro (&Qsetting_constant
);
2165 staticpro (&Qinvalid_read_syntax
);
2166 staticpro (&Qwrong_number_of_arguments
);
2167 staticpro (&Qinvalid_function
);
2168 staticpro (&Qno_catch
);
2169 staticpro (&Qend_of_file
);
2170 staticpro (&Qarith_error
);
2171 staticpro (&Qbeginning_of_buffer
);
2172 staticpro (&Qend_of_buffer
);
2173 staticpro (&Qbuffer_read_only
);
2174 staticpro (&Qmark_inactive
);
2176 staticpro (&Qlistp
);
2177 staticpro (&Qconsp
);
2178 staticpro (&Qsymbolp
);
2179 staticpro (&Qintegerp
);
2180 staticpro (&Qnatnump
);
2181 staticpro (&Qstringp
);
2182 staticpro (&Qarrayp
);
2183 staticpro (&Qsequencep
);
2184 staticpro (&Qbufferp
);
2185 staticpro (&Qvectorp
);
2186 staticpro (&Qchar_or_string_p
);
2187 staticpro (&Qmarkerp
);
2188 staticpro (&Qbuffer_or_string_p
);
2189 staticpro (&Qinteger_or_marker_p
);
2190 #ifdef LISP_FLOAT_TYPE
2191 staticpro (&Qfloatp
);
2192 staticpro (&Qnumberp
);
2193 staticpro (&Qnumber_or_marker_p
);
2194 #endif /* LISP_FLOAT_TYPE */
2196 staticpro (&Qboundp
);
2197 staticpro (&Qfboundp
);
2206 defsubr (&Sintegerp
);
2207 defsubr (&Sinteger_or_marker_p
);
2208 defsubr (&Snumberp
);
2209 defsubr (&Snumber_or_marker_p
);
2210 #ifdef LISP_FLOAT_TYPE
2212 #endif /* LISP_FLOAT_TYPE */
2213 defsubr (&Snatnump
);
2214 defsubr (&Ssymbolp
);
2215 defsubr (&Sstringp
);
2216 defsubr (&Svectorp
);
2218 defsubr (&Ssequencep
);
2219 defsubr (&Sbufferp
);
2220 defsubr (&Smarkerp
);
2222 defsubr (&Sbyte_code_function_p
);
2223 defsubr (&Schar_or_string_p
);
2226 defsubr (&Scar_safe
);
2227 defsubr (&Scdr_safe
);
2230 defsubr (&Ssymbol_function
);
2231 defsubr (&Sindirect_function
);
2232 defsubr (&Ssymbol_plist
);
2233 defsubr (&Ssymbol_name
);
2234 defsubr (&Smakunbound
);
2235 defsubr (&Sfmakunbound
);
2237 defsubr (&Sfboundp
);
2239 defsubr (&Sdefalias
);
2240 defsubr (&Sdefine_function
);
2241 defsubr (&Ssetplist
);
2242 defsubr (&Ssymbol_value
);
2244 defsubr (&Sdefault_boundp
);
2245 defsubr (&Sdefault_value
);
2246 defsubr (&Sset_default
);
2247 defsubr (&Ssetq_default
);
2248 defsubr (&Smake_variable_buffer_local
);
2249 defsubr (&Smake_local_variable
);
2250 defsubr (&Skill_local_variable
);
2253 defsubr (&Snumber_to_string
);
2254 defsubr (&Sstring_to_number
);
2255 defsubr (&Seqlsign
);
2285 /* USG systems forget handlers when they are used;
2286 must reestablish each time */
2287 signal (signo
, arith_error
);
2290 /* VMS systems are like USG. */
2291 signal (signo
, arith_error
);
2295 #else /* not BSD4_1 */
2296 sigsetmask (SIGEMPTYMASK
);
2297 #endif /* not BSD4_1 */
2299 Fsignal (Qarith_error
, Qnil
);
2304 /* Don't do this if just dumping out.
2305 We don't want to call `signal' in this case
2306 so that we don't have trouble with dumping
2307 signal-delivering routines in an inconsistent state. */
2311 #endif /* CANNOT_DUMP */
2312 signal (SIGFPE
, arith_error
);
2315 signal (SIGEMT
, arith_error
);