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 #if 0 /* That is untrue--XINT is used below, and it uses INTBITS.
34 What in the world is values.h, anyway? */
36 /* These are redefined in values.h and not used here */
43 #ifdef LISP_FLOAT_TYPE
49 /* Work around a problem that happens because math.h on hpux 7
50 defines two static variables--which, in Emacs, are not really static,
51 because `static' is defined as nothing. The problem is that they are
52 here, in floatfns.c, and in lread.c.
53 These macros prevent the name conflict. */
54 #if defined (HPUX) && !defined (HPUX8)
55 #define _MAXLDBL data_c_maxldbl
56 #define _NMAXLDBL data_c_nmaxldbl
60 #endif /* LISP_FLOAT_TYPE */
63 extern double atof ();
66 Lisp_Object Qnil
, Qt
, Qquote
, Qlambda
, Qsubr
, Qunbound
;
67 Lisp_Object Qerror_conditions
, Qerror_message
, Qtop_level
;
68 Lisp_Object Qerror
, Qquit
, Qwrong_type_argument
, Qargs_out_of_range
;
69 Lisp_Object Qvoid_variable
, Qvoid_function
, Qcyclic_function_indirection
;
70 Lisp_Object Qsetting_constant
, Qinvalid_read_syntax
;
71 Lisp_Object Qinvalid_function
, Qwrong_number_of_arguments
, Qno_catch
;
72 Lisp_Object Qend_of_file
, Qarith_error
, Qmark_inactive
;
73 Lisp_Object Qbeginning_of_buffer
, Qend_of_buffer
, Qbuffer_read_only
;
74 Lisp_Object Qintegerp
, Qnatnump
, Qsymbolp
, Qlistp
, Qconsp
;
75 Lisp_Object Qstringp
, Qarrayp
, Qsequencep
, Qbufferp
;
76 Lisp_Object Qchar_or_string_p
, Qmarkerp
, Qinteger_or_marker_p
, Qvectorp
;
77 Lisp_Object Qbuffer_or_string_p
;
78 Lisp_Object Qboundp
, Qfboundp
;
81 Lisp_Object Qrange_error
, Qdomain_error
, Qsingularity_error
;
82 Lisp_Object Qoverflow_error
, Qunderflow_error
;
84 #ifdef LISP_FLOAT_TYPE
86 Lisp_Object Qnumberp
, Qnumber_or_marker_p
;
89 static Lisp_Object
swap_in_symval_forwarding ();
92 wrong_type_argument (predicate
, value
)
93 register Lisp_Object predicate
, value
;
95 register Lisp_Object tem
;
98 if (!EQ (Vmocklisp_arguments
, Qt
))
100 if (XTYPE (value
) == Lisp_String
&&
101 (EQ (predicate
, Qintegerp
) || EQ (predicate
, Qinteger_or_marker_p
)))
102 return Fstring_to_number (value
);
103 if (XTYPE (value
) == Lisp_Int
&& EQ (predicate
, Qstringp
))
104 return Fnumber_to_string (value
);
106 value
= Fsignal (Qwrong_type_argument
, Fcons (predicate
, Fcons (value
, Qnil
)));
107 tem
= call1 (predicate
, value
);
115 error ("Attempt to modify read-only object");
119 args_out_of_range (a1
, a2
)
123 Fsignal (Qargs_out_of_range
, Fcons (a1
, Fcons (a2
, Qnil
)));
127 args_out_of_range_3 (a1
, a2
, a3
)
128 Lisp_Object a1
, a2
, a3
;
131 Fsignal (Qargs_out_of_range
, Fcons (a1
, Fcons (a2
, Fcons (a3
, Qnil
))));
138 register Lisp_Object val
;
139 XSET (val
, Lisp_Int
, num
);
143 /* On some machines, XINT needs a temporary location.
144 Here it is, in case it is needed. */
146 int sign_extend_temp
;
148 /* On a few machines, XINT can only be done by calling this. */
151 sign_extend_lisp_int (num
)
154 if (num
& (1 << (VALBITS
- 1)))
155 return num
| ((-1) << VALBITS
);
157 return num
& ((1 << VALBITS
) - 1);
160 /* Data type predicates */
162 DEFUN ("eq", Feq
, Seq
, 2, 2, 0,
163 "T if the two args are the same Lisp object.")
165 Lisp_Object obj1
, obj2
;
172 DEFUN ("null", Fnull
, Snull
, 1, 1, 0, "T if OBJECT is nil.")
181 DEFUN ("consp", Fconsp
, Sconsp
, 1, 1, 0, "T if OBJECT is a cons cell.")
185 if (XTYPE (obj
) == Lisp_Cons
)
190 DEFUN ("atom", Fatom
, Satom
, 1, 1, 0, "T if OBJECT is not a cons cell. This includes nil.")
194 if (XTYPE (obj
) == Lisp_Cons
)
199 DEFUN ("listp", Flistp
, Slistp
, 1, 1, 0, "T if OBJECT is a list. This includes nil.")
203 if (XTYPE (obj
) == Lisp_Cons
|| NILP (obj
))
208 DEFUN ("nlistp", Fnlistp
, Snlistp
, 1, 1, 0, "T if OBJECT is not a list. Lists include nil.")
212 if (XTYPE (obj
) == Lisp_Cons
|| NILP (obj
))
217 DEFUN ("symbolp", Fsymbolp
, Ssymbolp
, 1, 1, 0, "T if OBJECT is a symbol.")
221 if (XTYPE (obj
) == Lisp_Symbol
)
226 DEFUN ("vectorp", Fvectorp
, Svectorp
, 1, 1, 0, "T if OBJECT is a vector.")
230 if (XTYPE (obj
) == Lisp_Vector
)
235 DEFUN ("stringp", Fstringp
, Sstringp
, 1, 1, 0, "T if OBJECT is a string.")
239 if (XTYPE (obj
) == Lisp_String
)
244 DEFUN ("arrayp", Farrayp
, Sarrayp
, 1, 1, 0, "T if OBJECT is an array (string or vector).")
248 if (XTYPE (obj
) == Lisp_Vector
|| XTYPE (obj
) == Lisp_String
)
253 DEFUN ("sequencep", Fsequencep
, Ssequencep
, 1, 1, 0,
254 "T if OBJECT is a sequence (list or array).")
256 register Lisp_Object obj
;
258 if (CONSP (obj
) || NILP (obj
) ||
259 XTYPE (obj
) == Lisp_Vector
|| XTYPE (obj
) == Lisp_String
)
264 DEFUN ("bufferp", Fbufferp
, Sbufferp
, 1, 1, 0, "T if OBJECT is an editor buffer.")
268 if (XTYPE (obj
) == Lisp_Buffer
)
273 DEFUN ("markerp", Fmarkerp
, Smarkerp
, 1, 1, 0, "T if OBJECT is a marker (editor pointer).")
277 if (XTYPE (obj
) == Lisp_Marker
)
282 DEFUN ("subrp", Fsubrp
, Ssubrp
, 1, 1, 0, "T if OBJECT is a built-in function.")
286 if (XTYPE (obj
) == Lisp_Subr
)
291 DEFUN ("byte-code-function-p", Fbyte_code_function_p
, Sbyte_code_function_p
,
292 1, 1, 0, "T if OBJECT is a byte-compiled function object.")
296 if (XTYPE (obj
) == Lisp_Compiled
)
301 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.")
303 register Lisp_Object obj
;
305 if (XTYPE (obj
) == Lisp_Int
|| XTYPE (obj
) == Lisp_String
)
310 DEFUN ("integerp", Fintegerp
, Sintegerp
, 1, 1, 0, "T if OBJECT is a number.")
314 if (XTYPE (obj
) == Lisp_Int
)
319 DEFUN ("integer-or-marker-p", Finteger_or_marker_p
, Sinteger_or_marker_p
, 1, 1, 0,
320 "T if OBJECT is an integer or a marker (editor pointer).")
322 register Lisp_Object obj
;
324 if (XTYPE (obj
) == Lisp_Marker
|| XTYPE (obj
) == Lisp_Int
)
329 DEFUN ("natnump", Fnatnump
, Snatnump
, 1, 1, 0, "T if OBJECT is a nonnegative number.")
333 if (XTYPE (obj
) == Lisp_Int
&& XINT (obj
) >= 0)
338 DEFUN ("numberp", Fnumberp
, Snumberp
, 1, 1, 0,
339 "T if OBJECT is a number (floating point or integer).")
349 DEFUN ("number-or-marker-p", Fnumber_or_marker_p
,
350 Snumber_or_marker_p
, 1, 1, 0,
351 "T if OBJECT is a number or a marker.")
356 || XTYPE (obj
) == Lisp_Marker
)
361 #ifdef LISP_FLOAT_TYPE
362 DEFUN ("floatp", Ffloatp
, Sfloatp
, 1, 1, 0,
363 "T if OBJECT is a floating point number.")
367 if (XTYPE (obj
) == Lisp_Float
)
371 #endif /* LISP_FLOAT_TYPE */
373 /* Extract and set components of lists */
375 DEFUN ("car", Fcar
, Scar
, 1, 1, 0,
376 "Return the car of CONSCELL. If arg is nil, return nil.\n\
377 Error if arg is not nil and not a cons cell. See also `car-safe'.")
379 register Lisp_Object list
;
383 if (XTYPE (list
) == Lisp_Cons
)
384 return XCONS (list
)->car
;
385 else if (EQ (list
, Qnil
))
388 list
= wrong_type_argument (Qlistp
, list
);
392 DEFUN ("car-safe", Fcar_safe
, Scar_safe
, 1, 1, 0,
393 "Return the car of OBJECT if it is a cons cell, or else nil.")
397 if (XTYPE (object
) == Lisp_Cons
)
398 return XCONS (object
)->car
;
403 DEFUN ("cdr", Fcdr
, Scdr
, 1, 1, 0,
404 "Return the cdr of CONSCELL. If arg is nil, return nil.\n\
405 Error if arg is not nil and not a cons cell. See also `cdr-safe'.")
408 register Lisp_Object list
;
412 if (XTYPE (list
) == Lisp_Cons
)
413 return XCONS (list
)->cdr
;
414 else if (EQ (list
, Qnil
))
417 list
= wrong_type_argument (Qlistp
, list
);
421 DEFUN ("cdr-safe", Fcdr_safe
, Scdr_safe
, 1, 1, 0,
422 "Return the cdr of OBJECT if it is a cons cell, or else nil.")
426 if (XTYPE (object
) == Lisp_Cons
)
427 return XCONS (object
)->cdr
;
432 DEFUN ("setcar", Fsetcar
, Ssetcar
, 2, 2, 0,
433 "Set the car of CONSCELL to be NEWCAR. Returns NEWCAR.")
435 register Lisp_Object cell
, newcar
;
437 if (XTYPE (cell
) != Lisp_Cons
)
438 cell
= wrong_type_argument (Qconsp
, cell
);
441 XCONS (cell
)->car
= newcar
;
445 DEFUN ("setcdr", Fsetcdr
, Ssetcdr
, 2, 2, 0,
446 "Set the cdr of CONSCELL to be NEWCDR. Returns NEWCDR.")
448 register Lisp_Object cell
, newcdr
;
450 if (XTYPE (cell
) != Lisp_Cons
)
451 cell
= wrong_type_argument (Qconsp
, cell
);
454 XCONS (cell
)->cdr
= newcdr
;
458 /* Extract and set components of symbols */
460 DEFUN ("boundp", Fboundp
, Sboundp
, 1, 1, 0, "T if SYMBOL's value is not void.")
462 register Lisp_Object sym
;
464 Lisp_Object valcontents
;
465 CHECK_SYMBOL (sym
, 0);
467 valcontents
= XSYMBOL (sym
)->value
;
469 #ifdef SWITCH_ENUM_BUG
470 switch ((int) XTYPE (valcontents
))
472 switch (XTYPE (valcontents
))
475 case Lisp_Buffer_Local_Value
:
476 case Lisp_Some_Buffer_Local_Value
:
477 valcontents
= swap_in_symval_forwarding (sym
, valcontents
);
480 return (XTYPE (valcontents
) == Lisp_Void
|| EQ (valcontents
, Qunbound
)
484 DEFUN ("fboundp", Ffboundp
, Sfboundp
, 1, 1, 0, "T if SYMBOL's function definition is not void.")
486 register Lisp_Object sym
;
488 CHECK_SYMBOL (sym
, 0);
489 return (XTYPE (XSYMBOL (sym
)->function
) == Lisp_Void
490 || EQ (XSYMBOL (sym
)->function
, Qunbound
))
494 DEFUN ("makunbound", Fmakunbound
, Smakunbound
, 1, 1, 0, "Make SYMBOL's value be void.")
496 register Lisp_Object sym
;
498 CHECK_SYMBOL (sym
, 0);
499 if (NILP (sym
) || EQ (sym
, Qt
))
500 return Fsignal (Qsetting_constant
, Fcons (sym
, Qnil
));
501 Fset (sym
, Qunbound
);
505 DEFUN ("fmakunbound", Ffmakunbound
, Sfmakunbound
, 1, 1, 0, "Make SYMBOL's function definition be void.")
507 register Lisp_Object sym
;
509 CHECK_SYMBOL (sym
, 0);
510 XSYMBOL (sym
)->function
= Qunbound
;
514 DEFUN ("symbol-function", Fsymbol_function
, Ssymbol_function
, 1, 1, 0,
515 "Return SYMBOL's function definition. Error if that is void.")
517 register Lisp_Object symbol
;
519 CHECK_SYMBOL (symbol
, 0);
520 if (EQ (XSYMBOL (symbol
)->function
, Qunbound
))
521 return Fsignal (Qvoid_function
, Fcons (symbol
, Qnil
));
522 return XSYMBOL (symbol
)->function
;
525 DEFUN ("symbol-plist", Fsymbol_plist
, Ssymbol_plist
, 1, 1, 0, "Return SYMBOL's property list.")
527 register Lisp_Object sym
;
529 CHECK_SYMBOL (sym
, 0);
530 return XSYMBOL (sym
)->plist
;
533 DEFUN ("symbol-name", Fsymbol_name
, Ssymbol_name
, 1, 1, 0, "Return SYMBOL's name, a string.")
535 register Lisp_Object sym
;
537 register Lisp_Object name
;
539 CHECK_SYMBOL (sym
, 0);
540 XSET (name
, Lisp_String
, XSYMBOL (sym
)->name
);
544 DEFUN ("fset", Ffset
, Sfset
, 2, 2, 0,
545 "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.")
547 register Lisp_Object sym
, newdef
;
549 CHECK_SYMBOL (sym
, 0);
551 if (!NILP (Vautoload_queue
) && !EQ (XSYMBOL (sym
)->function
, Qunbound
))
552 Vautoload_queue
= Fcons (Fcons (sym
, XSYMBOL (sym
)->function
),
554 XSYMBOL (sym
)->function
= newdef
;
558 /* This name should be removed once it is eliminated from elsewhere. */
560 DEFUN ("defalias", Fdefalias
, Sdefalias
, 2, 2, 0,
561 "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\
562 Associates the function with the current load file, if any.")
564 register Lisp_Object sym
, newdef
;
566 CHECK_SYMBOL (sym
, 0);
567 if (!NILP (Vautoload_queue
) && !EQ (XSYMBOL (sym
)->function
, Qunbound
))
568 Vautoload_queue
= Fcons (Fcons (sym
, XSYMBOL (sym
)->function
),
570 XSYMBOL (sym
)->function
= newdef
;
571 LOADHIST_ATTACH (sym
);
575 DEFUN ("define-function", Fdefine_function
, Sdefine_function
, 2, 2, 0,
576 "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\
577 Associates the function with the current load file, if any.")
579 register Lisp_Object sym
, newdef
;
581 CHECK_SYMBOL (sym
, 0);
582 if (!NILP (Vautoload_queue
) && !EQ (XSYMBOL (sym
)->function
, Qunbound
))
583 Vautoload_queue
= Fcons (Fcons (sym
, XSYMBOL (sym
)->function
),
585 XSYMBOL (sym
)->function
= newdef
;
586 LOADHIST_ATTACH (sym
);
590 DEFUN ("setplist", Fsetplist
, Ssetplist
, 2, 2, 0,
591 "Set SYMBOL's property list to NEWVAL, and return NEWVAL.")
593 register Lisp_Object sym
, newplist
;
595 CHECK_SYMBOL (sym
, 0);
596 XSYMBOL (sym
)->plist
= newplist
;
601 /* Getting and setting values of symbols */
603 /* Given the raw contents of a symbol value cell,
604 return the Lisp value of the symbol.
605 This does not handle buffer-local variables; use
606 swap_in_symval_forwarding for that. */
609 do_symval_forwarding (valcontents
)
610 register Lisp_Object valcontents
;
612 register Lisp_Object val
;
613 #ifdef SWITCH_ENUM_BUG
614 switch ((int) XTYPE (valcontents
))
616 switch (XTYPE (valcontents
))
620 XSET (val
, Lisp_Int
, *XINTPTR (valcontents
));
624 if (*XINTPTR (valcontents
))
629 return *XOBJFWD (valcontents
);
631 case Lisp_Buffer_Objfwd
:
632 return *(Lisp_Object
*)(XUINT (valcontents
) + (char *)current_buffer
);
637 /* Store NEWVAL into SYM, where VALCONTENTS is found in the value cell
638 of SYM. If SYM is buffer-local, VALCONTENTS should be the
639 buffer-independent contents of the value cell: forwarded just one
640 step past the buffer-localness. */
643 store_symval_forwarding (sym
, valcontents
, newval
)
645 register Lisp_Object valcontents
, newval
;
647 #ifdef SWITCH_ENUM_BUG
648 switch ((int) XTYPE (valcontents
))
650 switch (XTYPE (valcontents
))
654 CHECK_NUMBER (newval
, 1);
655 *XINTPTR (valcontents
) = XINT (newval
);
659 *XINTPTR (valcontents
) = NILP(newval
) ? 0 : 1;
663 *XOBJFWD (valcontents
) = newval
;
666 case Lisp_Buffer_Objfwd
:
668 unsigned int offset
= XUINT (valcontents
);
670 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
);
672 if (! NILP (type
) && ! NILP (newval
)
673 && XTYPE (newval
) != XINT (type
))
674 buffer_slot_type_mismatch (valcontents
, newval
);
676 *(Lisp_Object
*)(XUINT (valcontents
) + (char *)current_buffer
)
682 valcontents
= XSYMBOL (sym
)->value
;
683 if (XTYPE (valcontents
) == Lisp_Buffer_Local_Value
684 || XTYPE (valcontents
) == Lisp_Some_Buffer_Local_Value
)
685 XCONS (XSYMBOL (sym
)->value
)->car
= newval
;
687 XSYMBOL (sym
)->value
= newval
;
691 /* Set up the buffer-local symbol SYM for validity in the current
692 buffer. VALCONTENTS is the contents of its value cell.
693 Return the value forwarded one step past the buffer-local indicator. */
696 swap_in_symval_forwarding (sym
, valcontents
)
697 Lisp_Object sym
, valcontents
;
699 /* valcontents is a list
700 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)).
702 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
703 local_var_alist, that being the element whose car is this
704 variable. Or it can be a pointer to the
705 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not have
706 an element in its alist for this variable.
708 If the current buffer is not BUFFER, we store the current
709 REALVALUE value into CURRENT-ALIST-ELEMENT, then find the
710 appropriate alist element for the buffer now current and set up
711 CURRENT-ALIST-ELEMENT. Then we set REALVALUE out of that
712 element, and store into BUFFER.
714 Note that REALVALUE can be a forwarding pointer. */
716 register Lisp_Object tem1
;
717 tem1
= XCONS (XCONS (valcontents
)->cdr
)->car
;
719 if (NILP (tem1
) || current_buffer
!= XBUFFER (tem1
))
721 tem1
= XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
;
722 Fsetcdr (tem1
, do_symval_forwarding (XCONS (valcontents
)->car
));
723 tem1
= assq_no_quit (sym
, current_buffer
->local_var_alist
);
725 tem1
= XCONS (XCONS (valcontents
)->cdr
)->cdr
;
726 XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
= tem1
;
727 XSET (XCONS (XCONS (valcontents
)->cdr
)->car
, Lisp_Buffer
, current_buffer
);
728 store_symval_forwarding (sym
, XCONS (valcontents
)->car
, Fcdr (tem1
));
730 return XCONS (valcontents
)->car
;
733 /* Find the value of a symbol, returning Qunbound if it's not bound.
734 This is helpful for code which just wants to get a variable's value
735 if it has one, without signalling an error.
736 Note that it must not be possible to quit
737 within this function. Great care is required for this. */
740 find_symbol_value (sym
)
743 register Lisp_Object valcontents
, tem1
;
744 register Lisp_Object val
;
745 CHECK_SYMBOL (sym
, 0);
746 valcontents
= XSYMBOL (sym
)->value
;
749 #ifdef SWITCH_ENUM_BUG
750 switch ((int) XTYPE (valcontents
))
752 switch (XTYPE (valcontents
))
755 case Lisp_Buffer_Local_Value
:
756 case Lisp_Some_Buffer_Local_Value
:
757 valcontents
= swap_in_symval_forwarding (sym
, valcontents
);
761 XSET (val
, Lisp_Int
, *XINTPTR (valcontents
));
765 if (*XINTPTR (valcontents
))
770 return *XOBJFWD (valcontents
);
772 case Lisp_Buffer_Objfwd
:
773 return *(Lisp_Object
*)(XUINT (valcontents
) + (char *)current_buffer
);
782 DEFUN ("symbol-value", Fsymbol_value
, Ssymbol_value
, 1, 1, 0,
783 "Return SYMBOL's value. Error if that is void.")
787 Lisp_Object val
= find_symbol_value (sym
);
789 if (EQ (val
, Qunbound
))
790 return Fsignal (Qvoid_variable
, Fcons (sym
, Qnil
));
795 DEFUN ("set", Fset
, Sset
, 2, 2, 0,
796 "Set SYMBOL's value to NEWVAL, and return NEWVAL.")
798 register Lisp_Object sym
, newval
;
800 int voide
= (XTYPE (newval
) == Lisp_Void
|| EQ (newval
, Qunbound
));
802 #ifndef RTPC_REGISTER_BUG
803 register Lisp_Object valcontents
, tem1
, current_alist_element
;
804 #else /* RTPC_REGISTER_BUG */
805 register Lisp_Object tem1
;
806 Lisp_Object valcontents
, current_alist_element
;
807 #endif /* RTPC_REGISTER_BUG */
809 CHECK_SYMBOL (sym
, 0);
810 if (NILP (sym
) || EQ (sym
, Qt
))
811 return Fsignal (Qsetting_constant
, Fcons (sym
, Qnil
));
812 valcontents
= XSYMBOL (sym
)->value
;
814 if (XTYPE (valcontents
) == Lisp_Buffer_Objfwd
)
816 register int idx
= XUINT (valcontents
);
817 register int mask
= *(int *)(idx
+ (char *) &buffer_local_flags
);
819 current_buffer
->local_var_flags
|= mask
;
822 else if (XTYPE (valcontents
) == Lisp_Buffer_Local_Value
823 || XTYPE (valcontents
) == Lisp_Some_Buffer_Local_Value
)
825 /* valcontents is actually a pointer to a cons heading something like:
826 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE).
828 BUFFER is the last buffer for which this symbol's value was
831 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
832 local_var_alist, that being the element whose car is this
833 variable. Or it can be a pointer to the
834 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not
835 have an element in its alist for this variable (that is, if
836 BUFFER sees the default value of this variable).
838 If we want to examine or set the value and BUFFER is current,
839 we just examine or set REALVALUE. If BUFFER is not current, we
840 store the current REALVALUE value into CURRENT-ALIST-ELEMENT,
841 then find the appropriate alist element for the buffer now
842 current and set up CURRENT-ALIST-ELEMENT. Then we set
843 REALVALUE out of that element, and store into BUFFER.
845 If we are setting the variable and the current buffer does
846 not have an alist entry for this variable, an alist entry is
849 Note that REALVALUE can be a forwarding pointer. Each time
850 it is examined or set, forwarding must be done. */
852 /* What value are we caching right now? */
853 current_alist_element
=
854 XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
;
856 /* If the current buffer is not the buffer whose binding is
857 currently cached, or if it's a Lisp_Buffer_Local_Value and
858 we're looking at the default value, the cache is invalid; we
859 need to write it out, and find the new CURRENT-ALIST-ELEMENT. */
861 != XBUFFER (XCONS (XCONS (valcontents
)->cdr
)->car
))
862 || (XTYPE (valcontents
) == Lisp_Buffer_Local_Value
863 && EQ (XCONS (current_alist_element
)->car
,
864 current_alist_element
)))
866 /* Write out the cached value for the old buffer; copy it
867 back to its alist element. This works if the current
868 buffer only sees the default value, too. */
869 Fsetcdr (current_alist_element
,
870 do_symval_forwarding (XCONS (valcontents
)->car
));
872 /* Find the new value for CURRENT-ALIST-ELEMENT. */
873 tem1
= Fassq (sym
, current_buffer
->local_var_alist
);
876 /* This buffer still sees the default value. */
878 /* If the variable is a Lisp_Some_Buffer_Local_Value,
879 make CURRENT-ALIST-ELEMENT point to itself,
880 indicating that we're seeing the default value. */
881 if (XTYPE (valcontents
) == Lisp_Some_Buffer_Local_Value
)
882 tem1
= XCONS (XCONS (valcontents
)->cdr
)->cdr
;
884 /* If it's a Lisp_Buffer_Local_Value, give this buffer a
885 new assoc for a local value and set
886 CURRENT-ALIST-ELEMENT to point to that. */
889 tem1
= Fcons (sym
, Fcdr (current_alist_element
));
890 current_buffer
->local_var_alist
=
891 Fcons (tem1
, current_buffer
->local_var_alist
);
894 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
895 XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
= tem1
;
897 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
898 XSET (XCONS (XCONS (valcontents
)->cdr
)->car
,
899 Lisp_Buffer
, current_buffer
);
901 valcontents
= XCONS (valcontents
)->car
;
904 /* If storing void (making the symbol void), forward only through
905 buffer-local indicator, not through Lisp_Objfwd, etc. */
907 store_symval_forwarding (sym
, Qnil
, newval
);
909 store_symval_forwarding (sym
, valcontents
, newval
);
914 /* Access or set a buffer-local symbol's default value. */
916 /* Return the default value of SYM, but don't check for voidness.
917 Return Qunbound or a Lisp_Void object if it is void. */
923 register Lisp_Object valcontents
;
925 CHECK_SYMBOL (sym
, 0);
926 valcontents
= XSYMBOL (sym
)->value
;
928 /* For a built-in buffer-local variable, get the default value
929 rather than letting do_symval_forwarding get the current value. */
930 if (XTYPE (valcontents
) == Lisp_Buffer_Objfwd
)
932 register int idx
= XUINT (valcontents
);
934 if (*(int *) (idx
+ (char *) &buffer_local_flags
) != 0)
935 return *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
938 /* Handle user-created local variables. */
939 if (XTYPE (valcontents
) == Lisp_Buffer_Local_Value
940 || XTYPE (valcontents
) == Lisp_Some_Buffer_Local_Value
)
942 /* If var is set up for a buffer that lacks a local value for it,
943 the current value is nominally the default value.
944 But the current value slot may be more up to date, since
945 ordinary setq stores just that slot. So use that. */
946 Lisp_Object current_alist_element
, alist_element_car
;
947 current_alist_element
948 = XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
;
949 alist_element_car
= XCONS (current_alist_element
)->car
;
950 if (EQ (alist_element_car
, current_alist_element
))
951 return do_symval_forwarding (XCONS (valcontents
)->car
);
953 return XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->cdr
;
955 /* For other variables, get the current value. */
956 return do_symval_forwarding (valcontents
);
959 DEFUN ("default-boundp", Fdefault_boundp
, Sdefault_boundp
, 1, 1, 0,
960 "Return T if SYMBOL has a non-void default value.\n\
961 This is the value that is seen in buffers that do not have their own values\n\
966 register Lisp_Object value
;
968 value
= default_value (sym
);
969 return (XTYPE (value
) == Lisp_Void
|| EQ (value
, Qunbound
)
973 DEFUN ("default-value", Fdefault_value
, Sdefault_value
, 1, 1, 0,
974 "Return SYMBOL's default value.\n\
975 This is the value that is seen in buffers that do not have their own values\n\
976 for this variable. The default value is meaningful for variables with\n\
977 local bindings in certain buffers.")
981 register Lisp_Object value
;
983 value
= default_value (sym
);
984 if (XTYPE (value
) == Lisp_Void
|| EQ (value
, Qunbound
))
985 return Fsignal (Qvoid_variable
, Fcons (sym
, Qnil
));
989 DEFUN ("set-default", Fset_default
, Sset_default
, 2, 2, 0,
990 "Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.\n\
991 The default value is seen in buffers that do not have their own values\n\
994 Lisp_Object sym
, value
;
996 register Lisp_Object valcontents
, current_alist_element
, alist_element_buffer
;
998 CHECK_SYMBOL (sym
, 0);
999 valcontents
= XSYMBOL (sym
)->value
;
1001 /* Handle variables like case-fold-search that have special slots
1002 in the buffer. Make them work apparently like Lisp_Buffer_Local_Value
1004 if (XTYPE (valcontents
) == Lisp_Buffer_Objfwd
)
1006 register int idx
= XUINT (valcontents
);
1007 #ifndef RTPC_REGISTER_BUG
1008 register struct buffer
*b
;
1012 register int mask
= *(int *) (idx
+ (char *) &buffer_local_flags
);
1016 *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
) = value
;
1017 for (b
= all_buffers
; b
; b
= b
->next
)
1018 if (!(b
->local_var_flags
& mask
))
1019 *(Lisp_Object
*)(idx
+ (char *) b
) = value
;
1024 if (XTYPE (valcontents
) != Lisp_Buffer_Local_Value
&&
1025 XTYPE (valcontents
) != Lisp_Some_Buffer_Local_Value
)
1026 return Fset (sym
, value
);
1028 /* Store new value into the DEFAULT-VALUE slot */
1029 XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->cdr
= value
;
1031 /* If that slot is current, we must set the REALVALUE slot too */
1032 current_alist_element
= XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
;
1033 alist_element_buffer
= Fcar (current_alist_element
);
1034 if (EQ (alist_element_buffer
, current_alist_element
))
1035 store_symval_forwarding (sym
, XCONS (valcontents
)->car
, value
);
1040 DEFUN ("setq-default", Fsetq_default
, Ssetq_default
, 2, UNEVALLED
, 0,
1042 (setq-default SYM VAL SYM VAL ...): set each SYM's default value to its VAL.\n\
1043 VAL is evaluated; SYM is not. The default value is seen in buffers that do\n\
1044 not have their own values for this variable.")
1048 register Lisp_Object args_left
;
1049 register Lisp_Object val
, sym
;
1050 struct gcpro gcpro1
;
1060 val
= Feval (Fcar (Fcdr (args_left
)));
1061 sym
= Fcar (args_left
);
1062 Fset_default (sym
, val
);
1063 args_left
= Fcdr (Fcdr (args_left
));
1065 while (!NILP (args_left
));
1071 /* Lisp functions for creating and removing buffer-local variables. */
1073 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local
, Smake_variable_buffer_local
,
1074 1, 1, "vMake Variable Buffer Local: ",
1075 "Make VARIABLE have a separate value for each buffer.\n\
1076 At any time, the value for the current buffer is in effect.\n\
1077 There is also a default value which is seen in any buffer which has not yet\n\
1078 set its own value.\n\
1079 Using `set' or `setq' to set the variable causes it to have a separate value\n\
1080 for the current buffer if it was previously using the default value.\n\
1081 The function `default-value' gets the default value and `set-default' sets it.")
1083 register Lisp_Object sym
;
1085 register Lisp_Object tem
, valcontents
;
1087 CHECK_SYMBOL (sym
, 0);
1089 if (EQ (sym
, Qnil
) || EQ (sym
, Qt
))
1090 error ("Symbol %s may not be buffer-local", XSYMBOL (sym
)->name
->data
);
1092 valcontents
= XSYMBOL (sym
)->value
;
1093 if ((XTYPE (valcontents
) == Lisp_Buffer_Local_Value
) ||
1094 (XTYPE (valcontents
) == Lisp_Buffer_Objfwd
))
1096 if (XTYPE (valcontents
) == Lisp_Some_Buffer_Local_Value
)
1098 XSETTYPE (XSYMBOL (sym
)->value
, Lisp_Buffer_Local_Value
);
1101 if (EQ (valcontents
, Qunbound
))
1102 XSYMBOL (sym
)->value
= Qnil
;
1103 tem
= Fcons (Qnil
, Fsymbol_value (sym
));
1104 XCONS (tem
)->car
= tem
;
1105 XSYMBOL (sym
)->value
= Fcons (XSYMBOL (sym
)->value
, Fcons (Fcurrent_buffer (), tem
));
1106 XSETTYPE (XSYMBOL (sym
)->value
, Lisp_Buffer_Local_Value
);
1110 DEFUN ("make-local-variable", Fmake_local_variable
, Smake_local_variable
,
1111 1, 1, "vMake Local Variable: ",
1112 "Make VARIABLE have a separate value in the current buffer.\n\
1113 Other buffers will continue to share a common default value.\n\
1114 See also `make-variable-buffer-local'.\n\n\
1115 If the variable is already arranged to become local when set,\n\
1116 this function causes a local value to exist for this buffer,\n\
1117 just as if the variable were set.")
1119 register Lisp_Object sym
;
1121 register Lisp_Object tem
, valcontents
;
1123 CHECK_SYMBOL (sym
, 0);
1125 if (EQ (sym
, Qnil
) || EQ (sym
, Qt
))
1126 error ("Symbol %s may not be buffer-local", XSYMBOL (sym
)->name
->data
);
1128 valcontents
= XSYMBOL (sym
)->value
;
1129 if (XTYPE (valcontents
) == Lisp_Buffer_Local_Value
1130 || XTYPE (valcontents
) == Lisp_Buffer_Objfwd
)
1132 tem
= Fboundp (sym
);
1134 /* Make sure the symbol has a local value in this particular buffer,
1135 by setting it to the same value it already has. */
1136 Fset (sym
, (EQ (tem
, Qt
) ? Fsymbol_value (sym
) : Qunbound
));
1139 /* Make sure sym is set up to hold per-buffer values */
1140 if (XTYPE (valcontents
) != Lisp_Some_Buffer_Local_Value
)
1142 if (EQ (valcontents
, Qunbound
))
1143 XSYMBOL (sym
)->value
= Qnil
;
1144 tem
= Fcons (Qnil
, do_symval_forwarding (valcontents
));
1145 XCONS (tem
)->car
= tem
;
1146 XSYMBOL (sym
)->value
= Fcons (XSYMBOL (sym
)->value
, Fcons (Qnil
, tem
));
1147 XSETTYPE (XSYMBOL (sym
)->value
, Lisp_Some_Buffer_Local_Value
);
1149 /* Make sure this buffer has its own value of sym */
1150 tem
= Fassq (sym
, current_buffer
->local_var_alist
);
1153 current_buffer
->local_var_alist
1154 = Fcons (Fcons (sym
, XCONS (XCONS (XCONS (XSYMBOL (sym
)->value
)->cdr
)->cdr
)->cdr
),
1155 current_buffer
->local_var_alist
);
1157 /* Make sure symbol does not think it is set up for this buffer;
1158 force it to look once again for this buffer's value */
1160 /* This local variable avoids "expression too complex" on IBM RT. */
1163 xs
= XSYMBOL (sym
)->value
;
1164 if (current_buffer
== XBUFFER (XCONS (XCONS (xs
)->cdr
)->car
))
1165 XCONS (XCONS (XSYMBOL (sym
)->value
)->cdr
)->car
= Qnil
;
1169 /* If the symbol forwards into a C variable, then swap in the
1170 variable for this buffer immediately. If C code modifies the
1171 variable before we swap in, then that new value will clobber the
1172 default value the next time we swap. */
1173 valcontents
= XCONS (XSYMBOL (sym
)->value
)->car
;
1174 if (XTYPE (valcontents
) == Lisp_Intfwd
1175 || XTYPE (valcontents
) == Lisp_Boolfwd
1176 || XTYPE (valcontents
) == Lisp_Objfwd
)
1177 swap_in_symval_forwarding (sym
, XSYMBOL (sym
)->value
);
1182 DEFUN ("kill-local-variable", Fkill_local_variable
, Skill_local_variable
,
1183 1, 1, "vKill Local Variable: ",
1184 "Make VARIABLE no longer have a separate value in the current buffer.\n\
1185 From now on the default value will apply in this buffer.")
1187 register Lisp_Object sym
;
1189 register Lisp_Object tem
, valcontents
;
1191 CHECK_SYMBOL (sym
, 0);
1193 valcontents
= XSYMBOL (sym
)->value
;
1195 if (XTYPE (valcontents
) == Lisp_Buffer_Objfwd
)
1197 register int idx
= XUINT (valcontents
);
1198 register int mask
= *(int *) (idx
+ (char *) &buffer_local_flags
);
1202 *(Lisp_Object
*)(idx
+ (char *) current_buffer
)
1203 = *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
1204 current_buffer
->local_var_flags
&= ~mask
;
1209 if (XTYPE (valcontents
) != Lisp_Buffer_Local_Value
&&
1210 XTYPE (valcontents
) != Lisp_Some_Buffer_Local_Value
)
1213 /* Get rid of this buffer's alist element, if any */
1215 tem
= Fassq (sym
, current_buffer
->local_var_alist
);
1217 current_buffer
->local_var_alist
= Fdelq (tem
, current_buffer
->local_var_alist
);
1219 /* Make sure symbol does not think it is set up for this buffer;
1220 force it to look once again for this buffer's value */
1223 sv
= XSYMBOL (sym
)->value
;
1224 if (current_buffer
== XBUFFER (XCONS (XCONS (sv
)->cdr
)->car
))
1225 XCONS (XCONS (sv
)->cdr
)->car
= Qnil
;
1231 /* Find the function at the end of a chain of symbol function indirections. */
1233 /* If OBJECT is a symbol, find the end of its function chain and
1234 return the value found there. If OBJECT is not a symbol, just
1235 return it. If there is a cycle in the function chain, signal a
1236 cyclic-function-indirection error.
1238 This is like Findirect_function, except that it doesn't signal an
1239 error if the chain ends up unbound. */
1241 indirect_function (object
)
1242 register Lisp_Object object
;
1244 Lisp_Object tortoise
, hare
;
1246 hare
= tortoise
= object
;
1250 if (XTYPE (hare
) != Lisp_Symbol
|| EQ (hare
, Qunbound
))
1252 hare
= XSYMBOL (hare
)->function
;
1253 if (XTYPE (hare
) != Lisp_Symbol
|| EQ (hare
, Qunbound
))
1255 hare
= XSYMBOL (hare
)->function
;
1257 tortoise
= XSYMBOL (tortoise
)->function
;
1259 if (EQ (hare
, tortoise
))
1260 Fsignal (Qcyclic_function_indirection
, Fcons (object
, Qnil
));
1266 DEFUN ("indirect-function", Findirect_function
, Sindirect_function
, 1, 1, 0,
1267 "Return the function at the end of OBJECT's function chain.\n\
1268 If OBJECT is a symbol, follow all function indirections and return the final\n\
1269 function binding.\n\
1270 If OBJECT is not a symbol, just return it.\n\
1271 Signal a void-function error if the final symbol is unbound.\n\
1272 Signal a cyclic-function-indirection error if there is a loop in the\n\
1273 function chain of symbols.")
1275 register Lisp_Object object
;
1279 result
= indirect_function (object
);
1281 if (EQ (result
, Qunbound
))
1282 return Fsignal (Qvoid_function
, Fcons (object
, Qnil
));
1286 /* Extract and set vector and string elements */
1288 DEFUN ("aref", Faref
, Saref
, 2, 2, 0,
1289 "Return the element of ARRAY at index INDEX.\n\
1290 ARRAY may be a vector or a string, or a byte-code object. INDEX starts at 0.")
1292 register Lisp_Object array
;
1295 register int idxval
;
1297 CHECK_NUMBER (idx
, 1);
1298 idxval
= XINT (idx
);
1299 if (XTYPE (array
) != Lisp_Vector
&& XTYPE (array
) != Lisp_String
1300 && XTYPE (array
) != Lisp_Compiled
)
1301 array
= wrong_type_argument (Qarrayp
, array
);
1302 if (idxval
< 0 || idxval
>= XVECTOR (array
)->size
)
1303 args_out_of_range (array
, idx
);
1304 if (XTYPE (array
) == Lisp_String
)
1307 XFASTINT (val
) = (unsigned char) XSTRING (array
)->data
[idxval
];
1311 return XVECTOR (array
)->contents
[idxval
];
1314 DEFUN ("aset", Faset
, Saset
, 3, 3, 0,
1315 "Store into the element of ARRAY at index IDX the value NEWELT.\n\
1316 ARRAY may be a vector or a string. IDX starts at 0.")
1317 (array
, idx
, newelt
)
1318 register Lisp_Object array
;
1319 Lisp_Object idx
, newelt
;
1321 register int idxval
;
1323 CHECK_NUMBER (idx
, 1);
1324 idxval
= XINT (idx
);
1325 if (XTYPE (array
) != Lisp_Vector
&& XTYPE (array
) != Lisp_String
)
1326 array
= wrong_type_argument (Qarrayp
, array
);
1327 if (idxval
< 0 || idxval
>= XVECTOR (array
)->size
)
1328 args_out_of_range (array
, idx
);
1329 CHECK_IMPURE (array
);
1331 if (XTYPE (array
) == Lisp_Vector
)
1332 XVECTOR (array
)->contents
[idxval
] = newelt
;
1335 CHECK_NUMBER (newelt
, 2);
1336 XSTRING (array
)->data
[idxval
] = XINT (newelt
);
1343 Farray_length (array
)
1344 register Lisp_Object array
;
1346 register Lisp_Object size
;
1347 if (XTYPE (array
) != Lisp_Vector
&& XTYPE (array
) != Lisp_String
1348 && XTYPE (array
) != Lisp_Compiled
)
1349 array
= wrong_type_argument (Qarrayp
, array
);
1350 XFASTINT (size
) = XVECTOR (array
)->size
;
1354 /* Arithmetic functions */
1356 enum comparison
{ equal
, notequal
, less
, grtr
, less_or_equal
, grtr_or_equal
};
1359 arithcompare (num1
, num2
, comparison
)
1360 Lisp_Object num1
, num2
;
1361 enum comparison comparison
;
1366 #ifdef LISP_FLOAT_TYPE
1367 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1
, 0);
1368 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2
, 0);
1370 if (XTYPE (num1
) == Lisp_Float
|| XTYPE (num2
) == Lisp_Float
)
1373 f1
= (XTYPE (num1
) == Lisp_Float
) ? XFLOAT (num1
)->data
: XINT (num1
);
1374 f2
= (XTYPE (num2
) == Lisp_Float
) ? XFLOAT (num2
)->data
: XINT (num2
);
1377 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1378 CHECK_NUMBER_COERCE_MARKER (num2
, 0);
1379 #endif /* LISP_FLOAT_TYPE */
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
))
1404 if (floatp
? f1
> f2
: XINT (num1
) > XINT (num2
))
1409 if (floatp
? f1
>= f2
: XINT (num1
) >= XINT (num2
))
1418 DEFUN ("=", Feqlsign
, Seqlsign
, 2, 2, 0,
1419 "T if two args, both numbers or markers, are equal.")
1421 register Lisp_Object num1
, num2
;
1423 return arithcompare (num1
, num2
, equal
);
1426 DEFUN ("<", Flss
, Slss
, 2, 2, 0,
1427 "T if first arg is less than second arg. Both must be numbers or markers.")
1429 register Lisp_Object num1
, num2
;
1431 return arithcompare (num1
, num2
, less
);
1434 DEFUN (">", Fgtr
, Sgtr
, 2, 2, 0,
1435 "T if first arg is greater than second arg. Both must be numbers or markers.")
1437 register Lisp_Object num1
, num2
;
1439 return arithcompare (num1
, num2
, grtr
);
1442 DEFUN ("<=", Fleq
, Sleq
, 2, 2, 0,
1443 "T if first arg is less than or equal to second arg.\n\
1444 Both must be numbers or markers.")
1446 register Lisp_Object num1
, num2
;
1448 return arithcompare (num1
, num2
, less_or_equal
);
1451 DEFUN (">=", Fgeq
, Sgeq
, 2, 2, 0,
1452 "T if first arg is greater than or equal to second arg.\n\
1453 Both must be numbers or markers.")
1455 register Lisp_Object num1
, num2
;
1457 return arithcompare (num1
, num2
, grtr_or_equal
);
1460 DEFUN ("/=", Fneq
, Sneq
, 2, 2, 0,
1461 "T if first arg is not equal to second arg. Both must be numbers or markers.")
1463 register Lisp_Object num1
, num2
;
1465 return arithcompare (num1
, num2
, notequal
);
1468 DEFUN ("zerop", Fzerop
, Szerop
, 1, 1, 0, "T if NUMBER is zero.")
1470 register Lisp_Object num
;
1472 #ifdef LISP_FLOAT_TYPE
1473 CHECK_NUMBER_OR_FLOAT (num
, 0);
1475 if (XTYPE(num
) == Lisp_Float
)
1477 if (XFLOAT(num
)->data
== 0.0)
1482 CHECK_NUMBER (num
, 0);
1483 #endif /* LISP_FLOAT_TYPE */
1490 /* Convert between 32-bit values and pairs of lispy 24-bit values. */
1496 unsigned int top
= i
>> 16;
1497 unsigned int bot
= i
& 0xFFFF;
1499 return make_number (bot
);
1501 return Fcons (make_number (-1), make_number (bot
));
1502 return Fcons (make_number (top
), make_number (bot
));
1509 Lisp_Object top
, bot
;
1512 top
= XCONS (c
)->car
;
1513 bot
= XCONS (c
)->cdr
;
1515 bot
= XCONS (bot
)->car
;
1516 return ((XINT (top
) << 16) | XINT (bot
));
1519 DEFUN ("number-to-string", Fnumber_to_string
, Snumber_to_string
, 1, 1, 0,
1520 "Convert NUM to a string by printing it in decimal.\n\
1521 Uses a minus sign if negative.\n\
1522 NUM may be an integer or a floating point number.")
1528 #ifndef LISP_FLOAT_TYPE
1529 CHECK_NUMBER (num
, 0);
1531 CHECK_NUMBER_OR_FLOAT (num
, 0);
1533 if (XTYPE(num
) == Lisp_Float
)
1535 char pigbuf
[350]; /* see comments in float_to_string */
1537 float_to_string (pigbuf
, XFLOAT(num
)->data
);
1538 return build_string (pigbuf
);
1540 #endif /* LISP_FLOAT_TYPE */
1542 sprintf (buffer
, "%d", XINT (num
));
1543 return build_string (buffer
);
1546 DEFUN ("string-to-number", Fstring_to_number
, Sstring_to_number
, 1, 1, 0,
1547 "Convert STRING to a number by parsing it as a decimal number.\n\
1548 This parses both integers and floating point numbers.")
1550 register Lisp_Object str
;
1554 CHECK_STRING (str
, 0);
1556 p
= XSTRING (str
)->data
;
1558 /* Skip any whitespace at the front of the number. Some versions of
1559 atoi do this anyway, so we might as well make Emacs lisp consistent. */
1560 while (*p
== ' ' || *p
== '\t')
1563 #ifdef LISP_FLOAT_TYPE
1564 if (isfloat_string (p
))
1565 return make_float (atof (p
));
1566 #endif /* LISP_FLOAT_TYPE */
1568 return make_number (atoi (p
));
1572 { Aadd
, Asub
, Amult
, Adiv
, Alogand
, Alogior
, Alogxor
, Amax
, Amin
};
1574 extern Lisp_Object
float_arith_driver ();
1577 arith_driver (code
, nargs
, args
)
1580 register Lisp_Object
*args
;
1582 register Lisp_Object val
;
1583 register int argnum
;
1587 #ifdef SWITCH_ENUM_BUG
1604 for (argnum
= 0; argnum
< nargs
; argnum
++)
1606 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
1607 #ifdef LISP_FLOAT_TYPE
1608 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
1610 if (XTYPE (val
) == Lisp_Float
) /* time to do serious math */
1611 return (float_arith_driver ((double) accum
, argnum
, code
,
1614 CHECK_NUMBER_COERCE_MARKER (val
, argnum
);
1615 #endif /* LISP_FLOAT_TYPE */
1616 args
[argnum
] = val
; /* runs into a compiler bug. */
1617 next
= XINT (args
[argnum
]);
1618 #ifdef SWITCH_ENUM_BUG
1624 case Aadd
: accum
+= next
; break;
1626 if (!argnum
&& nargs
!= 1)
1630 case Amult
: accum
*= next
; break;
1632 if (!argnum
) accum
= next
;
1636 Fsignal (Qarith_error
, Qnil
);
1640 case Alogand
: accum
&= next
; break;
1641 case Alogior
: accum
|= next
; break;
1642 case Alogxor
: accum
^= next
; break;
1643 case Amax
: if (!argnum
|| next
> accum
) accum
= next
; break;
1644 case Amin
: if (!argnum
|| next
< accum
) accum
= next
; break;
1648 XSET (val
, Lisp_Int
, accum
);
1652 #ifdef LISP_FLOAT_TYPE
1655 #define isnan(x) ((x) != (x))
1658 float_arith_driver (accum
, argnum
, code
, nargs
, args
)
1660 register int argnum
;
1663 register Lisp_Object
*args
;
1665 register Lisp_Object val
;
1668 for (; argnum
< nargs
; argnum
++)
1670 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
1671 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
1673 if (XTYPE (val
) == Lisp_Float
)
1675 next
= XFLOAT (val
)->data
;
1679 args
[argnum
] = val
; /* runs into a compiler bug. */
1680 next
= XINT (args
[argnum
]);
1682 #ifdef SWITCH_ENUM_BUG
1692 if (!argnum
&& nargs
!= 1)
1705 Fsignal (Qarith_error
, Qnil
);
1712 return wrong_type_argument (Qinteger_or_marker_p
, val
);
1714 if (!argnum
|| isnan (next
) || next
> accum
)
1718 if (!argnum
|| isnan (next
) || next
< accum
)
1724 return make_float (accum
);
1726 #endif /* LISP_FLOAT_TYPE */
1728 DEFUN ("+", Fplus
, Splus
, 0, MANY
, 0,
1729 "Return sum of any number of arguments, which are numbers or markers.")
1734 return arith_driver (Aadd
, nargs
, args
);
1737 DEFUN ("-", Fminus
, Sminus
, 0, MANY
, 0,
1738 "Negate number or subtract numbers or markers.\n\
1739 With one arg, negates it. With more than one arg,\n\
1740 subtracts all but the first from the first.")
1745 return arith_driver (Asub
, nargs
, args
);
1748 DEFUN ("*", Ftimes
, Stimes
, 0, MANY
, 0,
1749 "Returns product of any number of arguments, which are numbers or markers.")
1754 return arith_driver (Amult
, nargs
, args
);
1757 DEFUN ("/", Fquo
, Squo
, 2, MANY
, 0,
1758 "Returns first argument divided by all the remaining arguments.\n\
1759 The arguments must be numbers or markers.")
1764 return arith_driver (Adiv
, nargs
, args
);
1767 DEFUN ("%", Frem
, Srem
, 2, 2, 0,
1768 "Returns remainder of first arg divided by second.\n\
1769 Both must be integers or markers.")
1771 register Lisp_Object num1
, num2
;
1775 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1776 CHECK_NUMBER_COERCE_MARKER (num2
, 1);
1778 if (XFASTINT (num2
) == 0)
1779 Fsignal (Qarith_error
, Qnil
);
1781 XSET (val
, Lisp_Int
, XINT (num1
) % XINT (num2
));
1790 #ifdef HAVE_DREM /* Some systems use this non-standard name. */
1791 return (drem (f1
, f2
));
1792 #else /* Other systems don't seem to have it at all. */
1793 return (f1
- f2
* floor (f1
/f2
));
1796 #endif /* ! HAVE_FMOD */
1798 DEFUN ("mod", Fmod
, Smod
, 2, 2, 0,
1799 "Returns X modulo Y.\n\
1800 The result falls between zero (inclusive) and Y (exclusive).\n\
1801 Both X and Y must be numbers or markers.")
1803 register Lisp_Object num1
, num2
;
1808 #ifdef LISP_FLOAT_TYPE
1809 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1
, 0);
1810 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2
, 1);
1812 if (XTYPE (num1
) == Lisp_Float
|| XTYPE (num2
) == Lisp_Float
)
1816 f1
= XTYPE (num1
) == Lisp_Float
? XFLOAT (num1
)->data
: XINT (num1
);
1817 f2
= XTYPE (num2
) == Lisp_Float
? XFLOAT (num2
)->data
: XINT (num2
);
1819 Fsignal (Qarith_error
, Qnil
);
1822 /* If the "remainder" comes out with the wrong sign, fix it. */
1823 if ((f1
< 0) != (f2
< 0))
1825 return (make_float (f1
));
1827 #else /* not LISP_FLOAT_TYPE */
1828 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1829 CHECK_NUMBER_COERCE_MARKER (num2
, 1);
1830 #endif /* not LISP_FLOAT_TYPE */
1836 Fsignal (Qarith_error
, Qnil
);
1840 /* If the "remainder" comes out with the wrong sign, fix it. */
1841 if ((i1
< 0) != (i2
< 0))
1844 XSET (val
, Lisp_Int
, i1
);
1848 DEFUN ("max", Fmax
, Smax
, 1, MANY
, 0,
1849 "Return largest of all the arguments (which must be numbers or markers).\n\
1850 The value is always a number; markers are converted to numbers.")
1855 return arith_driver (Amax
, nargs
, args
);
1858 DEFUN ("min", Fmin
, Smin
, 1, MANY
, 0,
1859 "Return smallest of all the arguments (which must be numbers or markers).\n\
1860 The value is always a number; markers are converted to numbers.")
1865 return arith_driver (Amin
, nargs
, args
);
1868 DEFUN ("logand", Flogand
, Slogand
, 0, MANY
, 0,
1869 "Return bitwise-and of all the arguments.\n\
1870 Arguments may be integers, or markers converted to integers.")
1875 return arith_driver (Alogand
, nargs
, args
);
1878 DEFUN ("logior", Flogior
, Slogior
, 0, MANY
, 0,
1879 "Return bitwise-or of all the arguments.\n\
1880 Arguments may be integers, or markers converted to integers.")
1885 return arith_driver (Alogior
, nargs
, args
);
1888 DEFUN ("logxor", Flogxor
, Slogxor
, 0, MANY
, 0,
1889 "Return bitwise-exclusive-or of all the arguments.\n\
1890 Arguments may be integers, or markers converted to integers.")
1895 return arith_driver (Alogxor
, nargs
, args
);
1898 DEFUN ("ash", Fash
, Sash
, 2, 2, 0,
1899 "Return VALUE with its bits shifted left by COUNT.\n\
1900 If COUNT is negative, shifting is actually to the right.\n\
1901 In this case, the sign bit is duplicated.")
1903 register Lisp_Object num1
, num2
;
1905 register Lisp_Object val
;
1907 CHECK_NUMBER (num1
, 0);
1908 CHECK_NUMBER (num2
, 1);
1910 if (XINT (num2
) > 0)
1911 XSET (val
, Lisp_Int
, XINT (num1
) << XFASTINT (num2
));
1913 XSET (val
, Lisp_Int
, XINT (num1
) >> -XINT (num2
));
1917 DEFUN ("lsh", Flsh
, Slsh
, 2, 2, 0,
1918 "Return VALUE with its bits shifted left by COUNT.\n\
1919 If COUNT is negative, shifting is actually to the right.\n\
1920 In this case, zeros are shifted in on the left.")
1922 register Lisp_Object num1
, num2
;
1924 register Lisp_Object val
;
1926 CHECK_NUMBER (num1
, 0);
1927 CHECK_NUMBER (num2
, 1);
1929 if (XINT (num2
) > 0)
1930 XSET (val
, Lisp_Int
, (unsigned) XFASTINT (num1
) << XFASTINT (num2
));
1932 XSET (val
, Lisp_Int
, (unsigned) XFASTINT (num1
) >> -XINT (num2
));
1936 DEFUN ("1+", Fadd1
, Sadd1
, 1, 1, 0,
1937 "Return NUMBER plus one. NUMBER may be a number or a marker.\n\
1938 Markers are converted to integers.")
1940 register Lisp_Object num
;
1942 #ifdef LISP_FLOAT_TYPE
1943 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num
, 0);
1945 if (XTYPE (num
) == Lisp_Float
)
1946 return (make_float (1.0 + XFLOAT (num
)->data
));
1948 CHECK_NUMBER_COERCE_MARKER (num
, 0);
1949 #endif /* LISP_FLOAT_TYPE */
1951 XSETINT (num
, XFASTINT (num
) + 1);
1955 DEFUN ("1-", Fsub1
, Ssub1
, 1, 1, 0,
1956 "Return NUMBER minus one. NUMBER may be a number or a marker.\n\
1957 Markers are converted to integers.")
1959 register Lisp_Object num
;
1961 #ifdef LISP_FLOAT_TYPE
1962 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num
, 0);
1964 if (XTYPE (num
) == Lisp_Float
)
1965 return (make_float (-1.0 + XFLOAT (num
)->data
));
1967 CHECK_NUMBER_COERCE_MARKER (num
, 0);
1968 #endif /* LISP_FLOAT_TYPE */
1970 XSETINT (num
, XFASTINT (num
) - 1);
1974 DEFUN ("lognot", Flognot
, Slognot
, 1, 1, 0,
1975 "Return the bitwise complement of ARG. ARG must be an integer.")
1977 register Lisp_Object num
;
1979 CHECK_NUMBER (num
, 0);
1980 XSETINT (num
, ~XFASTINT (num
));
1987 Lisp_Object error_tail
, arith_tail
;
1989 Qquote
= intern ("quote");
1990 Qlambda
= intern ("lambda");
1991 Qsubr
= intern ("subr");
1992 Qerror_conditions
= intern ("error-conditions");
1993 Qerror_message
= intern ("error-message");
1994 Qtop_level
= intern ("top-level");
1996 Qerror
= intern ("error");
1997 Qquit
= intern ("quit");
1998 Qwrong_type_argument
= intern ("wrong-type-argument");
1999 Qargs_out_of_range
= intern ("args-out-of-range");
2000 Qvoid_function
= intern ("void-function");
2001 Qcyclic_function_indirection
= intern ("cyclic-function-indirection");
2002 Qvoid_variable
= intern ("void-variable");
2003 Qsetting_constant
= intern ("setting-constant");
2004 Qinvalid_read_syntax
= intern ("invalid-read-syntax");
2006 Qinvalid_function
= intern ("invalid-function");
2007 Qwrong_number_of_arguments
= intern ("wrong-number-of-arguments");
2008 Qno_catch
= intern ("no-catch");
2009 Qend_of_file
= intern ("end-of-file");
2010 Qarith_error
= intern ("arith-error");
2011 Qbeginning_of_buffer
= intern ("beginning-of-buffer");
2012 Qend_of_buffer
= intern ("end-of-buffer");
2013 Qbuffer_read_only
= intern ("buffer-read-only");
2014 Qmark_inactive
= intern ("mark-inactive");
2016 Qlistp
= intern ("listp");
2017 Qconsp
= intern ("consp");
2018 Qsymbolp
= intern ("symbolp");
2019 Qintegerp
= intern ("integerp");
2020 Qnatnump
= intern ("natnump");
2021 Qstringp
= intern ("stringp");
2022 Qarrayp
= intern ("arrayp");
2023 Qsequencep
= intern ("sequencep");
2024 Qbufferp
= intern ("bufferp");
2025 Qvectorp
= intern ("vectorp");
2026 Qchar_or_string_p
= intern ("char-or-string-p");
2027 Qmarkerp
= intern ("markerp");
2028 Qbuffer_or_string_p
= intern ("buffer-or-string-p");
2029 Qinteger_or_marker_p
= intern ("integer-or-marker-p");
2030 Qboundp
= intern ("boundp");
2031 Qfboundp
= intern ("fboundp");
2033 #ifdef LISP_FLOAT_TYPE
2034 Qfloatp
= intern ("floatp");
2035 Qnumberp
= intern ("numberp");
2036 Qnumber_or_marker_p
= intern ("number-or-marker-p");
2037 #endif /* LISP_FLOAT_TYPE */
2039 Qcdr
= intern ("cdr");
2041 error_tail
= Fcons (Qerror
, Qnil
);
2043 /* ERROR is used as a signaler for random errors for which nothing else is right */
2045 Fput (Qerror
, Qerror_conditions
,
2047 Fput (Qerror
, Qerror_message
,
2048 build_string ("error"));
2050 Fput (Qquit
, Qerror_conditions
,
2051 Fcons (Qquit
, Qnil
));
2052 Fput (Qquit
, Qerror_message
,
2053 build_string ("Quit"));
2055 Fput (Qwrong_type_argument
, Qerror_conditions
,
2056 Fcons (Qwrong_type_argument
, error_tail
));
2057 Fput (Qwrong_type_argument
, Qerror_message
,
2058 build_string ("Wrong type argument"));
2060 Fput (Qargs_out_of_range
, Qerror_conditions
,
2061 Fcons (Qargs_out_of_range
, error_tail
));
2062 Fput (Qargs_out_of_range
, Qerror_message
,
2063 build_string ("Args out of range"));
2065 Fput (Qvoid_function
, Qerror_conditions
,
2066 Fcons (Qvoid_function
, error_tail
));
2067 Fput (Qvoid_function
, Qerror_message
,
2068 build_string ("Symbol's function definition is void"));
2070 Fput (Qcyclic_function_indirection
, Qerror_conditions
,
2071 Fcons (Qcyclic_function_indirection
, error_tail
));
2072 Fput (Qcyclic_function_indirection
, Qerror_message
,
2073 build_string ("Symbol's chain of function indirections contains a loop"));
2075 Fput (Qvoid_variable
, Qerror_conditions
,
2076 Fcons (Qvoid_variable
, error_tail
));
2077 Fput (Qvoid_variable
, Qerror_message
,
2078 build_string ("Symbol's value as variable is void"));
2080 Fput (Qsetting_constant
, Qerror_conditions
,
2081 Fcons (Qsetting_constant
, error_tail
));
2082 Fput (Qsetting_constant
, Qerror_message
,
2083 build_string ("Attempt to set a constant symbol"));
2085 Fput (Qinvalid_read_syntax
, Qerror_conditions
,
2086 Fcons (Qinvalid_read_syntax
, error_tail
));
2087 Fput (Qinvalid_read_syntax
, Qerror_message
,
2088 build_string ("Invalid read syntax"));
2090 Fput (Qinvalid_function
, Qerror_conditions
,
2091 Fcons (Qinvalid_function
, error_tail
));
2092 Fput (Qinvalid_function
, Qerror_message
,
2093 build_string ("Invalid function"));
2095 Fput (Qwrong_number_of_arguments
, Qerror_conditions
,
2096 Fcons (Qwrong_number_of_arguments
, error_tail
));
2097 Fput (Qwrong_number_of_arguments
, Qerror_message
,
2098 build_string ("Wrong number of arguments"));
2100 Fput (Qno_catch
, Qerror_conditions
,
2101 Fcons (Qno_catch
, error_tail
));
2102 Fput (Qno_catch
, Qerror_message
,
2103 build_string ("No catch for tag"));
2105 Fput (Qend_of_file
, Qerror_conditions
,
2106 Fcons (Qend_of_file
, error_tail
));
2107 Fput (Qend_of_file
, Qerror_message
,
2108 build_string ("End of file during parsing"));
2110 arith_tail
= Fcons (Qarith_error
, error_tail
);
2111 Fput (Qarith_error
, Qerror_conditions
,
2113 Fput (Qarith_error
, Qerror_message
,
2114 build_string ("Arithmetic error"));
2116 Fput (Qbeginning_of_buffer
, Qerror_conditions
,
2117 Fcons (Qbeginning_of_buffer
, error_tail
));
2118 Fput (Qbeginning_of_buffer
, Qerror_message
,
2119 build_string ("Beginning of buffer"));
2121 Fput (Qend_of_buffer
, Qerror_conditions
,
2122 Fcons (Qend_of_buffer
, error_tail
));
2123 Fput (Qend_of_buffer
, Qerror_message
,
2124 build_string ("End of buffer"));
2126 Fput (Qbuffer_read_only
, Qerror_conditions
,
2127 Fcons (Qbuffer_read_only
, error_tail
));
2128 Fput (Qbuffer_read_only
, Qerror_message
,
2129 build_string ("Buffer is read-only"));
2131 #ifdef LISP_FLOAT_TYPE
2132 Qrange_error
= intern ("range-error");
2133 Qdomain_error
= intern ("domain-error");
2134 Qsingularity_error
= intern ("singularity-error");
2135 Qoverflow_error
= intern ("overflow-error");
2136 Qunderflow_error
= intern ("underflow-error");
2138 Fput (Qdomain_error
, Qerror_conditions
,
2139 Fcons (Qdomain_error
, arith_tail
));
2140 Fput (Qdomain_error
, Qerror_message
,
2141 build_string ("Arithmetic domain error"));
2143 Fput (Qrange_error
, Qerror_conditions
,
2144 Fcons (Qrange_error
, arith_tail
));
2145 Fput (Qrange_error
, Qerror_message
,
2146 build_string ("Arithmetic range error"));
2148 Fput (Qsingularity_error
, Qerror_conditions
,
2149 Fcons (Qsingularity_error
, Fcons (Qdomain_error
, arith_tail
)));
2150 Fput (Qsingularity_error
, Qerror_message
,
2151 build_string ("Arithmetic singularity error"));
2153 Fput (Qoverflow_error
, Qerror_conditions
,
2154 Fcons (Qoverflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2155 Fput (Qoverflow_error
, Qerror_message
,
2156 build_string ("Arithmetic overflow error"));
2158 Fput (Qunderflow_error
, Qerror_conditions
,
2159 Fcons (Qunderflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2160 Fput (Qunderflow_error
, Qerror_message
,
2161 build_string ("Arithmetic underflow error"));
2163 staticpro (&Qrange_error
);
2164 staticpro (&Qdomain_error
);
2165 staticpro (&Qsingularity_error
);
2166 staticpro (&Qoverflow_error
);
2167 staticpro (&Qunderflow_error
);
2168 #endif /* LISP_FLOAT_TYPE */
2172 staticpro (&Qquote
);
2173 staticpro (&Qlambda
);
2175 staticpro (&Qunbound
);
2176 staticpro (&Qerror_conditions
);
2177 staticpro (&Qerror_message
);
2178 staticpro (&Qtop_level
);
2180 staticpro (&Qerror
);
2182 staticpro (&Qwrong_type_argument
);
2183 staticpro (&Qargs_out_of_range
);
2184 staticpro (&Qvoid_function
);
2185 staticpro (&Qcyclic_function_indirection
);
2186 staticpro (&Qvoid_variable
);
2187 staticpro (&Qsetting_constant
);
2188 staticpro (&Qinvalid_read_syntax
);
2189 staticpro (&Qwrong_number_of_arguments
);
2190 staticpro (&Qinvalid_function
);
2191 staticpro (&Qno_catch
);
2192 staticpro (&Qend_of_file
);
2193 staticpro (&Qarith_error
);
2194 staticpro (&Qbeginning_of_buffer
);
2195 staticpro (&Qend_of_buffer
);
2196 staticpro (&Qbuffer_read_only
);
2197 staticpro (&Qmark_inactive
);
2199 staticpro (&Qlistp
);
2200 staticpro (&Qconsp
);
2201 staticpro (&Qsymbolp
);
2202 staticpro (&Qintegerp
);
2203 staticpro (&Qnatnump
);
2204 staticpro (&Qstringp
);
2205 staticpro (&Qarrayp
);
2206 staticpro (&Qsequencep
);
2207 staticpro (&Qbufferp
);
2208 staticpro (&Qvectorp
);
2209 staticpro (&Qchar_or_string_p
);
2210 staticpro (&Qmarkerp
);
2211 staticpro (&Qbuffer_or_string_p
);
2212 staticpro (&Qinteger_or_marker_p
);
2213 #ifdef LISP_FLOAT_TYPE
2214 staticpro (&Qfloatp
);
2215 staticpro (&Qnumberp
);
2216 staticpro (&Qnumber_or_marker_p
);
2217 #endif /* LISP_FLOAT_TYPE */
2219 staticpro (&Qboundp
);
2220 staticpro (&Qfboundp
);
2229 defsubr (&Sintegerp
);
2230 defsubr (&Sinteger_or_marker_p
);
2231 defsubr (&Snumberp
);
2232 defsubr (&Snumber_or_marker_p
);
2233 #ifdef LISP_FLOAT_TYPE
2235 #endif /* LISP_FLOAT_TYPE */
2236 defsubr (&Snatnump
);
2237 defsubr (&Ssymbolp
);
2238 defsubr (&Sstringp
);
2239 defsubr (&Svectorp
);
2241 defsubr (&Ssequencep
);
2242 defsubr (&Sbufferp
);
2243 defsubr (&Smarkerp
);
2245 defsubr (&Sbyte_code_function_p
);
2246 defsubr (&Schar_or_string_p
);
2249 defsubr (&Scar_safe
);
2250 defsubr (&Scdr_safe
);
2253 defsubr (&Ssymbol_function
);
2254 defsubr (&Sindirect_function
);
2255 defsubr (&Ssymbol_plist
);
2256 defsubr (&Ssymbol_name
);
2257 defsubr (&Smakunbound
);
2258 defsubr (&Sfmakunbound
);
2260 defsubr (&Sfboundp
);
2262 defsubr (&Sdefalias
);
2263 defsubr (&Sdefine_function
);
2264 defsubr (&Ssetplist
);
2265 defsubr (&Ssymbol_value
);
2267 defsubr (&Sdefault_boundp
);
2268 defsubr (&Sdefault_value
);
2269 defsubr (&Sset_default
);
2270 defsubr (&Ssetq_default
);
2271 defsubr (&Smake_variable_buffer_local
);
2272 defsubr (&Smake_local_variable
);
2273 defsubr (&Skill_local_variable
);
2276 defsubr (&Snumber_to_string
);
2277 defsubr (&Sstring_to_number
);
2278 defsubr (&Seqlsign
);
2308 /* USG systems forget handlers when they are used;
2309 must reestablish each time */
2310 signal (signo
, arith_error
);
2313 /* VMS systems are like USG. */
2314 signal (signo
, arith_error
);
2318 #else /* not BSD4_1 */
2319 sigsetmask (SIGEMPTYMASK
);
2320 #endif /* not BSD4_1 */
2322 Fsignal (Qarith_error
, Qnil
);
2327 /* Don't do this if just dumping out.
2328 We don't want to call `signal' in this case
2329 so that we don't have trouble with dumping
2330 signal-delivering routines in an inconsistent state. */
2334 #endif /* CANNOT_DUMP */
2335 signal (SIGFPE
, arith_error
);
2338 signal (SIGEMT
, arith_error
);