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
1654 float_arith_driver (accum
, argnum
, code
, nargs
, args
)
1656 register int argnum
;
1659 register Lisp_Object
*args
;
1661 register Lisp_Object val
;
1664 for (; argnum
< nargs
; argnum
++)
1666 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
1667 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
1669 if (XTYPE (val
) == Lisp_Float
)
1671 next
= XFLOAT (val
)->data
;
1675 args
[argnum
] = val
; /* runs into a compiler bug. */
1676 next
= XINT (args
[argnum
]);
1678 #ifdef SWITCH_ENUM_BUG
1688 if (!argnum
&& nargs
!= 1)
1701 Fsignal (Qarith_error
, Qnil
);
1708 return wrong_type_argument (Qinteger_or_marker_p
, val
);
1710 if (!argnum
|| next
> accum
)
1714 if (!argnum
|| next
< accum
)
1720 return make_float (accum
);
1722 #endif /* LISP_FLOAT_TYPE */
1724 DEFUN ("+", Fplus
, Splus
, 0, MANY
, 0,
1725 "Return sum of any number of arguments, which are numbers or markers.")
1730 return arith_driver (Aadd
, nargs
, args
);
1733 DEFUN ("-", Fminus
, Sminus
, 0, MANY
, 0,
1734 "Negate number or subtract numbers or markers.\n\
1735 With one arg, negates it. With more than one arg,\n\
1736 subtracts all but the first from the first.")
1741 return arith_driver (Asub
, nargs
, args
);
1744 DEFUN ("*", Ftimes
, Stimes
, 0, MANY
, 0,
1745 "Returns product of any number of arguments, which are numbers or markers.")
1750 return arith_driver (Amult
, nargs
, args
);
1753 DEFUN ("/", Fquo
, Squo
, 2, MANY
, 0,
1754 "Returns first argument divided by all the remaining arguments.\n\
1755 The arguments must be numbers or markers.")
1760 return arith_driver (Adiv
, nargs
, args
);
1763 DEFUN ("%", Frem
, Srem
, 2, 2, 0,
1764 "Returns remainder of first arg divided by second.\n\
1765 Both must be integers or markers.")
1767 register Lisp_Object num1
, num2
;
1771 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1772 CHECK_NUMBER_COERCE_MARKER (num2
, 1);
1774 if (XFASTINT (num2
) == 0)
1775 Fsignal (Qarith_error
, Qnil
);
1777 XSET (val
, Lisp_Int
, XINT (num1
) % XINT (num2
));
1781 DEFUN ("mod", Fmod
, Smod
, 2, 2, 0,
1782 "Returns X modulo Y.\n\
1783 The result falls between zero (inclusive) and Y (exclusive).\n\
1784 Both X and Y must be numbers or markers.")
1786 register Lisp_Object num1
, num2
;
1791 #ifdef LISP_FLOAT_TYPE
1792 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1
, 0);
1793 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2
, 1);
1795 if (XTYPE (num1
) == Lisp_Float
|| XTYPE (num2
) == Lisp_Float
)
1799 f1
= XTYPE (num1
) == Lisp_Float
? XFLOAT (num1
)->data
: XINT (num1
);
1800 f2
= XTYPE (num2
) == Lisp_Float
? XFLOAT (num2
)->data
: XINT (num2
);
1802 Fsignal (Qarith_error
, Qnil
);
1809 /* If the "remainder" comes out with the wrong sign, fix it. */
1810 if ((f1
< 0) != (f2
< 0))
1812 return (make_float (f1
));
1814 #else /* not LISP_FLOAT_TYPE */
1815 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1816 CHECK_NUMBER_COERCE_MARKER (num2
, 1);
1817 #endif /* not LISP_FLOAT_TYPE */
1823 Fsignal (Qarith_error
, Qnil
);
1827 /* If the "remainder" comes out with the wrong sign, fix it. */
1828 if ((i1
< 0) != (i2
< 0))
1831 XSET (val
, Lisp_Int
, i1
);
1835 DEFUN ("max", Fmax
, Smax
, 1, MANY
, 0,
1836 "Return largest 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 (Amax
, nargs
, args
);
1845 DEFUN ("min", Fmin
, Smin
, 1, MANY
, 0,
1846 "Return smallest of all the arguments (which must be numbers or markers).\n\
1847 The value is always a number; markers are converted to numbers.")
1852 return arith_driver (Amin
, nargs
, args
);
1855 DEFUN ("logand", Flogand
, Slogand
, 0, MANY
, 0,
1856 "Return bitwise-and of all the arguments.\n\
1857 Arguments may be integers, or markers converted to integers.")
1862 return arith_driver (Alogand
, nargs
, args
);
1865 DEFUN ("logior", Flogior
, Slogior
, 0, MANY
, 0,
1866 "Return bitwise-or of all the arguments.\n\
1867 Arguments may be integers, or markers converted to integers.")
1872 return arith_driver (Alogior
, nargs
, args
);
1875 DEFUN ("logxor", Flogxor
, Slogxor
, 0, MANY
, 0,
1876 "Return bitwise-exclusive-or of all the arguments.\n\
1877 Arguments may be integers, or markers converted to integers.")
1882 return arith_driver (Alogxor
, nargs
, args
);
1885 DEFUN ("ash", Fash
, Sash
, 2, 2, 0,
1886 "Return VALUE with its bits shifted left by COUNT.\n\
1887 If COUNT is negative, shifting is actually to the right.\n\
1888 In this case, the sign bit is duplicated.")
1890 register Lisp_Object num1
, num2
;
1892 register Lisp_Object val
;
1894 CHECK_NUMBER (num1
, 0);
1895 CHECK_NUMBER (num2
, 1);
1897 if (XINT (num2
) > 0)
1898 XSET (val
, Lisp_Int
, XINT (num1
) << XFASTINT (num2
));
1900 XSET (val
, Lisp_Int
, XINT (num1
) >> -XINT (num2
));
1904 DEFUN ("lsh", Flsh
, Slsh
, 2, 2, 0,
1905 "Return VALUE with its bits shifted left by COUNT.\n\
1906 If COUNT is negative, shifting is actually to the right.\n\
1907 In this case, zeros are shifted in on the left.")
1909 register Lisp_Object num1
, num2
;
1911 register Lisp_Object val
;
1913 CHECK_NUMBER (num1
, 0);
1914 CHECK_NUMBER (num2
, 1);
1916 if (XINT (num2
) > 0)
1917 XSET (val
, Lisp_Int
, (unsigned) XFASTINT (num1
) << XFASTINT (num2
));
1919 XSET (val
, Lisp_Int
, (unsigned) XFASTINT (num1
) >> -XINT (num2
));
1923 DEFUN ("1+", Fadd1
, Sadd1
, 1, 1, 0,
1924 "Return NUMBER plus one. NUMBER may be a number or a marker.\n\
1925 Markers are converted to integers.")
1927 register Lisp_Object num
;
1929 #ifdef LISP_FLOAT_TYPE
1930 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num
, 0);
1932 if (XTYPE (num
) == Lisp_Float
)
1933 return (make_float (1.0 + XFLOAT (num
)->data
));
1935 CHECK_NUMBER_COERCE_MARKER (num
, 0);
1936 #endif /* LISP_FLOAT_TYPE */
1938 XSETINT (num
, XFASTINT (num
) + 1);
1942 DEFUN ("1-", Fsub1
, Ssub1
, 1, 1, 0,
1943 "Return NUMBER minus one. NUMBER may be a number or a marker.\n\
1944 Markers are converted to integers.")
1946 register Lisp_Object num
;
1948 #ifdef LISP_FLOAT_TYPE
1949 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num
, 0);
1951 if (XTYPE (num
) == Lisp_Float
)
1952 return (make_float (-1.0 + XFLOAT (num
)->data
));
1954 CHECK_NUMBER_COERCE_MARKER (num
, 0);
1955 #endif /* LISP_FLOAT_TYPE */
1957 XSETINT (num
, XFASTINT (num
) - 1);
1961 DEFUN ("lognot", Flognot
, Slognot
, 1, 1, 0,
1962 "Return the bitwise complement of ARG. ARG must be an integer.")
1964 register Lisp_Object num
;
1966 CHECK_NUMBER (num
, 0);
1967 XSETINT (num
, ~XFASTINT (num
));
1974 Lisp_Object error_tail
, arith_tail
;
1976 Qquote
= intern ("quote");
1977 Qlambda
= intern ("lambda");
1978 Qsubr
= intern ("subr");
1979 Qerror_conditions
= intern ("error-conditions");
1980 Qerror_message
= intern ("error-message");
1981 Qtop_level
= intern ("top-level");
1983 Qerror
= intern ("error");
1984 Qquit
= intern ("quit");
1985 Qwrong_type_argument
= intern ("wrong-type-argument");
1986 Qargs_out_of_range
= intern ("args-out-of-range");
1987 Qvoid_function
= intern ("void-function");
1988 Qcyclic_function_indirection
= intern ("cyclic-function-indirection");
1989 Qvoid_variable
= intern ("void-variable");
1990 Qsetting_constant
= intern ("setting-constant");
1991 Qinvalid_read_syntax
= intern ("invalid-read-syntax");
1993 Qinvalid_function
= intern ("invalid-function");
1994 Qwrong_number_of_arguments
= intern ("wrong-number-of-arguments");
1995 Qno_catch
= intern ("no-catch");
1996 Qend_of_file
= intern ("end-of-file");
1997 Qarith_error
= intern ("arith-error");
1998 Qbeginning_of_buffer
= intern ("beginning-of-buffer");
1999 Qend_of_buffer
= intern ("end-of-buffer");
2000 Qbuffer_read_only
= intern ("buffer-read-only");
2001 Qmark_inactive
= intern ("mark-inactive");
2003 Qlistp
= intern ("listp");
2004 Qconsp
= intern ("consp");
2005 Qsymbolp
= intern ("symbolp");
2006 Qintegerp
= intern ("integerp");
2007 Qnatnump
= intern ("natnump");
2008 Qstringp
= intern ("stringp");
2009 Qarrayp
= intern ("arrayp");
2010 Qsequencep
= intern ("sequencep");
2011 Qbufferp
= intern ("bufferp");
2012 Qvectorp
= intern ("vectorp");
2013 Qchar_or_string_p
= intern ("char-or-string-p");
2014 Qmarkerp
= intern ("markerp");
2015 Qbuffer_or_string_p
= intern ("buffer-or-string-p");
2016 Qinteger_or_marker_p
= intern ("integer-or-marker-p");
2017 Qboundp
= intern ("boundp");
2018 Qfboundp
= intern ("fboundp");
2020 #ifdef LISP_FLOAT_TYPE
2021 Qfloatp
= intern ("floatp");
2022 Qnumberp
= intern ("numberp");
2023 Qnumber_or_marker_p
= intern ("number-or-marker-p");
2024 #endif /* LISP_FLOAT_TYPE */
2026 Qcdr
= intern ("cdr");
2028 error_tail
= Fcons (Qerror
, Qnil
);
2030 /* ERROR is used as a signaler for random errors for which nothing else is right */
2032 Fput (Qerror
, Qerror_conditions
,
2034 Fput (Qerror
, Qerror_message
,
2035 build_string ("error"));
2037 Fput (Qquit
, Qerror_conditions
,
2038 Fcons (Qquit
, Qnil
));
2039 Fput (Qquit
, Qerror_message
,
2040 build_string ("Quit"));
2042 Fput (Qwrong_type_argument
, Qerror_conditions
,
2043 Fcons (Qwrong_type_argument
, error_tail
));
2044 Fput (Qwrong_type_argument
, Qerror_message
,
2045 build_string ("Wrong type argument"));
2047 Fput (Qargs_out_of_range
, Qerror_conditions
,
2048 Fcons (Qargs_out_of_range
, error_tail
));
2049 Fput (Qargs_out_of_range
, Qerror_message
,
2050 build_string ("Args out of range"));
2052 Fput (Qvoid_function
, Qerror_conditions
,
2053 Fcons (Qvoid_function
, error_tail
));
2054 Fput (Qvoid_function
, Qerror_message
,
2055 build_string ("Symbol's function definition is void"));
2057 Fput (Qcyclic_function_indirection
, Qerror_conditions
,
2058 Fcons (Qcyclic_function_indirection
, error_tail
));
2059 Fput (Qcyclic_function_indirection
, Qerror_message
,
2060 build_string ("Symbol's chain of function indirections contains a loop"));
2062 Fput (Qvoid_variable
, Qerror_conditions
,
2063 Fcons (Qvoid_variable
, error_tail
));
2064 Fput (Qvoid_variable
, Qerror_message
,
2065 build_string ("Symbol's value as variable is void"));
2067 Fput (Qsetting_constant
, Qerror_conditions
,
2068 Fcons (Qsetting_constant
, error_tail
));
2069 Fput (Qsetting_constant
, Qerror_message
,
2070 build_string ("Attempt to set a constant symbol"));
2072 Fput (Qinvalid_read_syntax
, Qerror_conditions
,
2073 Fcons (Qinvalid_read_syntax
, error_tail
));
2074 Fput (Qinvalid_read_syntax
, Qerror_message
,
2075 build_string ("Invalid read syntax"));
2077 Fput (Qinvalid_function
, Qerror_conditions
,
2078 Fcons (Qinvalid_function
, error_tail
));
2079 Fput (Qinvalid_function
, Qerror_message
,
2080 build_string ("Invalid function"));
2082 Fput (Qwrong_number_of_arguments
, Qerror_conditions
,
2083 Fcons (Qwrong_number_of_arguments
, error_tail
));
2084 Fput (Qwrong_number_of_arguments
, Qerror_message
,
2085 build_string ("Wrong number of arguments"));
2087 Fput (Qno_catch
, Qerror_conditions
,
2088 Fcons (Qno_catch
, error_tail
));
2089 Fput (Qno_catch
, Qerror_message
,
2090 build_string ("No catch for tag"));
2092 Fput (Qend_of_file
, Qerror_conditions
,
2093 Fcons (Qend_of_file
, error_tail
));
2094 Fput (Qend_of_file
, Qerror_message
,
2095 build_string ("End of file during parsing"));
2097 arith_tail
= Fcons (Qarith_error
, error_tail
);
2098 Fput (Qarith_error
, Qerror_conditions
,
2100 Fput (Qarith_error
, Qerror_message
,
2101 build_string ("Arithmetic error"));
2103 Fput (Qbeginning_of_buffer
, Qerror_conditions
,
2104 Fcons (Qbeginning_of_buffer
, error_tail
));
2105 Fput (Qbeginning_of_buffer
, Qerror_message
,
2106 build_string ("Beginning of buffer"));
2108 Fput (Qend_of_buffer
, Qerror_conditions
,
2109 Fcons (Qend_of_buffer
, error_tail
));
2110 Fput (Qend_of_buffer
, Qerror_message
,
2111 build_string ("End of buffer"));
2113 Fput (Qbuffer_read_only
, Qerror_conditions
,
2114 Fcons (Qbuffer_read_only
, error_tail
));
2115 Fput (Qbuffer_read_only
, Qerror_message
,
2116 build_string ("Buffer is read-only"));
2118 #ifdef LISP_FLOAT_TYPE
2119 Qrange_error
= intern ("range-error");
2120 Qdomain_error
= intern ("domain-error");
2121 Qsingularity_error
= intern ("singularity-error");
2122 Qoverflow_error
= intern ("overflow-error");
2123 Qunderflow_error
= intern ("underflow-error");
2125 Fput (Qdomain_error
, Qerror_conditions
,
2126 Fcons (Qdomain_error
, arith_tail
));
2127 Fput (Qdomain_error
, Qerror_message
,
2128 build_string ("Arithmetic domain error"));
2130 Fput (Qrange_error
, Qerror_conditions
,
2131 Fcons (Qrange_error
, arith_tail
));
2132 Fput (Qrange_error
, Qerror_message
,
2133 build_string ("Arithmetic range error"));
2135 Fput (Qsingularity_error
, Qerror_conditions
,
2136 Fcons (Qsingularity_error
, Fcons (Qdomain_error
, arith_tail
)));
2137 Fput (Qsingularity_error
, Qerror_message
,
2138 build_string ("Arithmetic singularity error"));
2140 Fput (Qoverflow_error
, Qerror_conditions
,
2141 Fcons (Qoverflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2142 Fput (Qoverflow_error
, Qerror_message
,
2143 build_string ("Arithmetic overflow error"));
2145 Fput (Qunderflow_error
, Qerror_conditions
,
2146 Fcons (Qunderflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2147 Fput (Qunderflow_error
, Qerror_message
,
2148 build_string ("Arithmetic underflow error"));
2150 staticpro (&Qrange_error
);
2151 staticpro (&Qdomain_error
);
2152 staticpro (&Qsingularity_error
);
2153 staticpro (&Qoverflow_error
);
2154 staticpro (&Qunderflow_error
);
2155 #endif /* LISP_FLOAT_TYPE */
2159 staticpro (&Qquote
);
2160 staticpro (&Qlambda
);
2162 staticpro (&Qunbound
);
2163 staticpro (&Qerror_conditions
);
2164 staticpro (&Qerror_message
);
2165 staticpro (&Qtop_level
);
2167 staticpro (&Qerror
);
2169 staticpro (&Qwrong_type_argument
);
2170 staticpro (&Qargs_out_of_range
);
2171 staticpro (&Qvoid_function
);
2172 staticpro (&Qcyclic_function_indirection
);
2173 staticpro (&Qvoid_variable
);
2174 staticpro (&Qsetting_constant
);
2175 staticpro (&Qinvalid_read_syntax
);
2176 staticpro (&Qwrong_number_of_arguments
);
2177 staticpro (&Qinvalid_function
);
2178 staticpro (&Qno_catch
);
2179 staticpro (&Qend_of_file
);
2180 staticpro (&Qarith_error
);
2181 staticpro (&Qbeginning_of_buffer
);
2182 staticpro (&Qend_of_buffer
);
2183 staticpro (&Qbuffer_read_only
);
2184 staticpro (&Qmark_inactive
);
2186 staticpro (&Qlistp
);
2187 staticpro (&Qconsp
);
2188 staticpro (&Qsymbolp
);
2189 staticpro (&Qintegerp
);
2190 staticpro (&Qnatnump
);
2191 staticpro (&Qstringp
);
2192 staticpro (&Qarrayp
);
2193 staticpro (&Qsequencep
);
2194 staticpro (&Qbufferp
);
2195 staticpro (&Qvectorp
);
2196 staticpro (&Qchar_or_string_p
);
2197 staticpro (&Qmarkerp
);
2198 staticpro (&Qbuffer_or_string_p
);
2199 staticpro (&Qinteger_or_marker_p
);
2200 #ifdef LISP_FLOAT_TYPE
2201 staticpro (&Qfloatp
);
2202 staticpro (&Qnumberp
);
2203 staticpro (&Qnumber_or_marker_p
);
2204 #endif /* LISP_FLOAT_TYPE */
2206 staticpro (&Qboundp
);
2207 staticpro (&Qfboundp
);
2216 defsubr (&Sintegerp
);
2217 defsubr (&Sinteger_or_marker_p
);
2218 defsubr (&Snumberp
);
2219 defsubr (&Snumber_or_marker_p
);
2220 #ifdef LISP_FLOAT_TYPE
2222 #endif /* LISP_FLOAT_TYPE */
2223 defsubr (&Snatnump
);
2224 defsubr (&Ssymbolp
);
2225 defsubr (&Sstringp
);
2226 defsubr (&Svectorp
);
2228 defsubr (&Ssequencep
);
2229 defsubr (&Sbufferp
);
2230 defsubr (&Smarkerp
);
2232 defsubr (&Sbyte_code_function_p
);
2233 defsubr (&Schar_or_string_p
);
2236 defsubr (&Scar_safe
);
2237 defsubr (&Scdr_safe
);
2240 defsubr (&Ssymbol_function
);
2241 defsubr (&Sindirect_function
);
2242 defsubr (&Ssymbol_plist
);
2243 defsubr (&Ssymbol_name
);
2244 defsubr (&Smakunbound
);
2245 defsubr (&Sfmakunbound
);
2247 defsubr (&Sfboundp
);
2249 defsubr (&Sdefalias
);
2250 defsubr (&Sdefine_function
);
2251 defsubr (&Ssetplist
);
2252 defsubr (&Ssymbol_value
);
2254 defsubr (&Sdefault_boundp
);
2255 defsubr (&Sdefault_value
);
2256 defsubr (&Sset_default
);
2257 defsubr (&Ssetq_default
);
2258 defsubr (&Smake_variable_buffer_local
);
2259 defsubr (&Smake_local_variable
);
2260 defsubr (&Skill_local_variable
);
2263 defsubr (&Snumber_to_string
);
2264 defsubr (&Sstring_to_number
);
2265 defsubr (&Seqlsign
);
2295 /* USG systems forget handlers when they are used;
2296 must reestablish each time */
2297 signal (signo
, arith_error
);
2300 /* VMS systems are like USG. */
2301 signal (signo
, arith_error
);
2305 #else /* not BSD4_1 */
2306 sigsetmask (SIGEMPTYMASK
);
2307 #endif /* not BSD4_1 */
2309 Fsignal (Qarith_error
, Qnil
);
2314 /* Don't do this if just dumping out.
2315 We don't want to call `signal' in this case
2316 so that we don't have trouble with dumping
2317 signal-delivering routines in an inconsistent state. */
2321 #endif /* CANNOT_DUMP */
2322 signal (SIGFPE
, arith_error
);
2325 signal (SIGEMT
, arith_error
);