1 /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985, 1986, 1988, 1993, 1994 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"
34 /* These are redefined (correctly, but differently) in values.h. */
40 #ifdef LISP_FLOAT_TYPE
46 /* Work around a problem that happens because math.h on hpux 7
47 defines two static variables--which, in Emacs, are not really static,
48 because `static' is defined as nothing. The problem is that they are
49 here, in floatfns.c, and in lread.c.
50 These macros prevent the name conflict. */
51 #if defined (HPUX) && !defined (HPUX8)
52 #define _MAXLDBL data_c_maxldbl
53 #define _NMAXLDBL data_c_nmaxldbl
57 #endif /* LISP_FLOAT_TYPE */
60 extern double atof ();
63 Lisp_Object Qnil
, Qt
, Qquote
, Qlambda
, Qsubr
, Qunbound
;
64 Lisp_Object Qerror_conditions
, Qerror_message
, Qtop_level
;
65 Lisp_Object Qerror
, Qquit
, Qwrong_type_argument
, Qargs_out_of_range
;
66 Lisp_Object Qvoid_variable
, Qvoid_function
, Qcyclic_function_indirection
;
67 Lisp_Object Qsetting_constant
, Qinvalid_read_syntax
;
68 Lisp_Object Qinvalid_function
, Qwrong_number_of_arguments
, Qno_catch
;
69 Lisp_Object Qend_of_file
, Qarith_error
, Qmark_inactive
;
70 Lisp_Object Qbeginning_of_buffer
, Qend_of_buffer
, Qbuffer_read_only
;
71 Lisp_Object Qintegerp
, Qnatnump
, Qwholenump
, Qsymbolp
, Qlistp
, Qconsp
;
72 Lisp_Object Qstringp
, Qarrayp
, Qsequencep
, Qbufferp
;
73 Lisp_Object Qchar_or_string_p
, Qmarkerp
, Qinteger_or_marker_p
, Qvectorp
;
74 Lisp_Object Qbuffer_or_string_p
;
75 Lisp_Object Qboundp
, Qfboundp
;
77 Lisp_Object Qad_advice_info
, Qad_activate
;
79 Lisp_Object Qrange_error
, Qdomain_error
, Qsingularity_error
;
80 Lisp_Object Qoverflow_error
, Qunderflow_error
;
82 #ifdef LISP_FLOAT_TYPE
84 Lisp_Object Qnumberp
, Qnumber_or_marker_p
;
87 static Lisp_Object
swap_in_symval_forwarding ();
90 wrong_type_argument (predicate
, value
)
91 register Lisp_Object predicate
, value
;
93 register Lisp_Object tem
;
96 if (!EQ (Vmocklisp_arguments
, Qt
))
98 if (STRINGP (value
) &&
99 (EQ (predicate
, Qintegerp
) || EQ (predicate
, Qinteger_or_marker_p
)))
100 return Fstring_to_number (value
);
101 if (INTEGERP (value
) && EQ (predicate
, Qstringp
))
102 return Fnumber_to_string (value
);
104 value
= Fsignal (Qwrong_type_argument
, Fcons (predicate
, Fcons (value
, Qnil
)));
105 tem
= call1 (predicate
, value
);
113 error ("Attempt to modify read-only object");
117 args_out_of_range (a1
, a2
)
121 Fsignal (Qargs_out_of_range
, Fcons (a1
, Fcons (a2
, Qnil
)));
125 args_out_of_range_3 (a1
, a2
, a3
)
126 Lisp_Object a1
, a2
, a3
;
129 Fsignal (Qargs_out_of_range
, Fcons (a1
, Fcons (a2
, Fcons (a3
, Qnil
))));
136 register Lisp_Object val
;
141 /* On some machines, XINT needs a temporary location.
142 Here it is, in case it is needed. */
144 int sign_extend_temp
;
146 /* On a few machines, XINT can only be done by calling this. */
149 sign_extend_lisp_int (num
)
152 if (num
& (((EMACS_INT
) 1) << (VALBITS
- 1)))
153 return num
| (((EMACS_INT
) (-1)) << VALBITS
);
155 return num
& ((((EMACS_INT
) 1) << VALBITS
) - 1);
158 /* Data type predicates */
160 DEFUN ("eq", Feq
, Seq
, 2, 2, 0,
161 "T if the two args are the same Lisp object.")
163 Lisp_Object obj1
, obj2
;
170 DEFUN ("null", Fnull
, Snull
, 1, 1, 0, "T if OBJECT is nil.")
179 DEFUN ("consp", Fconsp
, Sconsp
, 1, 1, 0, "T if OBJECT is a cons cell.")
188 DEFUN ("atom", Fatom
, Satom
, 1, 1, 0, "T if OBJECT is not a cons cell. This includes nil.")
197 DEFUN ("listp", Flistp
, Slistp
, 1, 1, 0, "T if OBJECT is a list. This includes nil.")
201 if (CONSP (obj
) || NILP (obj
))
206 DEFUN ("nlistp", Fnlistp
, Snlistp
, 1, 1, 0, "T if OBJECT is not a list. Lists include nil.")
210 if (CONSP (obj
) || NILP (obj
))
215 DEFUN ("symbolp", Fsymbolp
, Ssymbolp
, 1, 1, 0, "T if OBJECT is a symbol.")
224 DEFUN ("vectorp", Fvectorp
, Svectorp
, 1, 1, 0, "T if OBJECT is a vector.")
233 DEFUN ("stringp", Fstringp
, Sstringp
, 1, 1, 0, "T if OBJECT is a string.")
242 DEFUN ("arrayp", Farrayp
, Sarrayp
, 1, 1, 0, "T if OBJECT is an array (string or vector).")
246 if (VECTORP (obj
) || STRINGP (obj
))
251 DEFUN ("sequencep", Fsequencep
, Ssequencep
, 1, 1, 0,
252 "T if OBJECT is a sequence (list or array).")
254 register Lisp_Object obj
;
256 if (CONSP (obj
) || NILP (obj
) || VECTORP (obj
) || STRINGP (obj
))
261 DEFUN ("bufferp", Fbufferp
, Sbufferp
, 1, 1, 0, "T if OBJECT is an editor buffer.")
270 DEFUN ("markerp", Fmarkerp
, Smarkerp
, 1, 1, 0, "T if OBJECT is a marker (editor pointer).")
279 DEFUN ("subrp", Fsubrp
, Ssubrp
, 1, 1, 0, "T if OBJECT is a built-in function.")
288 DEFUN ("byte-code-function-p", Fbyte_code_function_p
, Sbyte_code_function_p
,
289 1, 1, 0, "T if OBJECT is a byte-compiled function object.")
298 DEFUN ("char-or-string-p", Fchar_or_string_p
, Schar_or_string_p
, 1, 1, 0,
299 "T if OBJECT is a character (an integer) or a string.")
301 register Lisp_Object obj
;
303 if (INTEGERP (obj
) || STRINGP (obj
))
308 DEFUN ("integerp", Fintegerp
, Sintegerp
, 1, 1, 0, "T if OBJECT is an integer.")
317 DEFUN ("integer-or-marker-p", Finteger_or_marker_p
, Sinteger_or_marker_p
, 1, 1, 0,
318 "T if OBJECT is an integer or a marker (editor pointer).")
320 register Lisp_Object obj
;
322 if (MARKERP (obj
) || INTEGERP (obj
))
327 DEFUN ("natnump", Fnatnump
, Snatnump
, 1, 1, 0,
328 "T if OBJECT is a nonnegative integer.")
332 if (INTEGERP (obj
) && XINT (obj
) >= 0)
337 DEFUN ("numberp", Fnumberp
, Snumberp
, 1, 1, 0,
338 "T if OBJECT is a number (floating point or integer).")
348 DEFUN ("number-or-marker-p", Fnumber_or_marker_p
,
349 Snumber_or_marker_p
, 1, 1, 0,
350 "T if OBJECT is a number or a marker.")
354 if (NUMBERP (obj
) || MARKERP (obj
))
359 #ifdef LISP_FLOAT_TYPE
360 DEFUN ("floatp", Ffloatp
, Sfloatp
, 1, 1, 0,
361 "T if OBJECT is a floating point number.")
369 #endif /* LISP_FLOAT_TYPE */
371 /* Extract and set components of lists */
373 DEFUN ("car", Fcar
, Scar
, 1, 1, 0,
374 "Return the car of CONSCELL. If arg is nil, return nil.\n\
375 Error if arg is not nil and not a cons cell. See also `car-safe'.")
377 register Lisp_Object list
;
382 return XCONS (list
)->car
;
383 else if (EQ (list
, Qnil
))
386 list
= wrong_type_argument (Qlistp
, list
);
390 DEFUN ("car-safe", Fcar_safe
, Scar_safe
, 1, 1, 0,
391 "Return the car of OBJECT if it is a cons cell, or else nil.")
396 return XCONS (object
)->car
;
401 DEFUN ("cdr", Fcdr
, Scdr
, 1, 1, 0,
402 "Return the cdr of CONSCELL. If arg is nil, return nil.\n\
403 Error if arg is not nil and not a cons cell. See also `cdr-safe'.")
406 register Lisp_Object list
;
411 return XCONS (list
)->cdr
;
412 else if (EQ (list
, Qnil
))
415 list
= wrong_type_argument (Qlistp
, list
);
419 DEFUN ("cdr-safe", Fcdr_safe
, Scdr_safe
, 1, 1, 0,
420 "Return the cdr of OBJECT if it is a cons cell, or else nil.")
425 return XCONS (object
)->cdr
;
430 DEFUN ("setcar", Fsetcar
, Ssetcar
, 2, 2, 0,
431 "Set the car of CONSCELL to be NEWCAR. Returns NEWCAR.")
433 register Lisp_Object cell
, newcar
;
436 cell
= wrong_type_argument (Qconsp
, cell
);
439 XCONS (cell
)->car
= newcar
;
443 DEFUN ("setcdr", Fsetcdr
, Ssetcdr
, 2, 2, 0,
444 "Set the cdr of CONSCELL to be NEWCDR. Returns NEWCDR.")
446 register Lisp_Object cell
, newcdr
;
449 cell
= wrong_type_argument (Qconsp
, cell
);
452 XCONS (cell
)->cdr
= newcdr
;
456 /* Extract and set components of symbols */
458 DEFUN ("boundp", Fboundp
, Sboundp
, 1, 1, 0, "T if SYMBOL's value is not void.")
460 register Lisp_Object sym
;
462 Lisp_Object valcontents
;
463 CHECK_SYMBOL (sym
, 0);
465 valcontents
= XSYMBOL (sym
)->value
;
467 #ifdef SWITCH_ENUM_BUG
468 switch ((int) XTYPE (valcontents
))
470 switch (XTYPE (valcontents
))
473 case Lisp_Buffer_Local_Value
:
474 case Lisp_Some_Buffer_Local_Value
:
475 valcontents
= swap_in_symval_forwarding (sym
, valcontents
);
478 return (EQ (valcontents
, Qunbound
) ? Qnil
: Qt
);
481 DEFUN ("fboundp", Ffboundp
, Sfboundp
, 1, 1, 0, "T if SYMBOL's function definition is not void.")
483 register Lisp_Object sym
;
485 CHECK_SYMBOL (sym
, 0);
486 return (EQ (XSYMBOL (sym
)->function
, Qunbound
) ? Qnil
: Qt
);
489 DEFUN ("makunbound", Fmakunbound
, Smakunbound
, 1, 1, 0, "Make SYMBOL's value be void.")
491 register Lisp_Object sym
;
493 CHECK_SYMBOL (sym
, 0);
494 if (NILP (sym
) || EQ (sym
, Qt
))
495 return Fsignal (Qsetting_constant
, Fcons (sym
, Qnil
));
496 Fset (sym
, Qunbound
);
500 DEFUN ("fmakunbound", Ffmakunbound
, Sfmakunbound
, 1, 1, 0, "Make SYMBOL's function definition be void.")
502 register Lisp_Object sym
;
504 CHECK_SYMBOL (sym
, 0);
505 if (NILP (sym
) || EQ (sym
, Qt
))
506 return Fsignal (Qsetting_constant
, Fcons (sym
, Qnil
));
507 XSYMBOL (sym
)->function
= Qunbound
;
511 DEFUN ("symbol-function", Fsymbol_function
, Ssymbol_function
, 1, 1, 0,
512 "Return SYMBOL's function definition. Error if that is void.")
514 register Lisp_Object symbol
;
516 CHECK_SYMBOL (symbol
, 0);
517 if (EQ (XSYMBOL (symbol
)->function
, Qunbound
))
518 return Fsignal (Qvoid_function
, Fcons (symbol
, Qnil
));
519 return XSYMBOL (symbol
)->function
;
522 DEFUN ("symbol-plist", Fsymbol_plist
, Ssymbol_plist
, 1, 1, 0, "Return SYMBOL's property list.")
524 register Lisp_Object sym
;
526 CHECK_SYMBOL (sym
, 0);
527 return XSYMBOL (sym
)->plist
;
530 DEFUN ("symbol-name", Fsymbol_name
, Ssymbol_name
, 1, 1, 0, "Return SYMBOL's name, a string.")
532 register Lisp_Object sym
;
534 register Lisp_Object name
;
536 CHECK_SYMBOL (sym
, 0);
537 XSETSTRING (name
, XSYMBOL (sym
)->name
);
541 DEFUN ("fset", Ffset
, Sfset
, 2, 2, 0,
542 "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.")
544 register Lisp_Object sym
, newdef
;
546 CHECK_SYMBOL (sym
, 0);
547 if (NILP (sym
) || EQ (sym
, Qt
))
548 return Fsignal (Qsetting_constant
, Fcons (sym
, Qnil
));
549 if (!NILP (Vautoload_queue
) && !EQ (XSYMBOL (sym
)->function
, Qunbound
))
550 Vautoload_queue
= Fcons (Fcons (sym
, XSYMBOL (sym
)->function
),
552 XSYMBOL (sym
)->function
= newdef
;
553 /* Handle automatic advice activation */
554 if (CONSP (XSYMBOL (sym
)->plist
) && !NILP (Fget (sym
, Qad_advice_info
)))
556 call2 (Qad_activate
, sym
, Qnil
);
557 newdef
= XSYMBOL (sym
)->function
;
562 /* This name should be removed once it is eliminated from elsewhere. */
564 DEFUN ("defalias", Fdefalias
, Sdefalias
, 2, 2, 0,
565 "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\
566 Associates the function with the current load file, if any.")
568 register Lisp_Object sym
, newdef
;
570 CHECK_SYMBOL (sym
, 0);
571 if (!NILP (Vautoload_queue
) && !EQ (XSYMBOL (sym
)->function
, Qunbound
))
572 Vautoload_queue
= Fcons (Fcons (sym
, XSYMBOL (sym
)->function
),
574 XSYMBOL (sym
)->function
= newdef
;
575 /* Handle automatic advice activation */
576 if (CONSP (XSYMBOL (sym
)->plist
) && !NILP (Fget (sym
, Qad_advice_info
)))
578 call2 (Qad_activate
, sym
, Qnil
);
579 newdef
= XSYMBOL (sym
)->function
;
581 LOADHIST_ATTACH (sym
);
585 DEFUN ("define-function", Fdefine_function
, Sdefine_function
, 2, 2, 0,
586 "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\
587 Associates the function with the current load file, if any.")
589 register Lisp_Object sym
, newdef
;
591 CHECK_SYMBOL (sym
, 0);
592 if (!NILP (Vautoload_queue
) && !EQ (XSYMBOL (sym
)->function
, Qunbound
))
593 Vautoload_queue
= Fcons (Fcons (sym
, XSYMBOL (sym
)->function
),
595 XSYMBOL (sym
)->function
= newdef
;
596 /* Handle automatic advice activation */
597 if (CONSP (XSYMBOL (sym
)->plist
) && !NILP (Fget (sym
, Qad_advice_info
)))
599 call2 (Qad_activate
, sym
, Qnil
);
600 newdef
= XSYMBOL (sym
)->function
;
602 LOADHIST_ATTACH (sym
);
606 DEFUN ("setplist", Fsetplist
, Ssetplist
, 2, 2, 0,
607 "Set SYMBOL's property list to NEWVAL, and return NEWVAL.")
609 register Lisp_Object sym
, newplist
;
611 CHECK_SYMBOL (sym
, 0);
612 XSYMBOL (sym
)->plist
= newplist
;
617 /* Getting and setting values of symbols */
619 /* Given the raw contents of a symbol value cell,
620 return the Lisp value of the symbol.
621 This does not handle buffer-local variables; use
622 swap_in_symval_forwarding for that. */
625 do_symval_forwarding (valcontents
)
626 register Lisp_Object valcontents
;
628 register Lisp_Object val
;
630 if (MISCP (valcontents
))
631 switch (XMISC (valcontents
)->type
)
633 case Lisp_Misc_Intfwd
:
634 XSETINT (val
, *XINTFWD (valcontents
)->intvar
);
637 case Lisp_Misc_Boolfwd
:
638 return (*XBOOLFWD (valcontents
)->boolvar
? Qt
: Qnil
);
640 case Lisp_Misc_Objfwd
:
641 return *XOBJFWD (valcontents
)->objvar
;
643 case Lisp_Misc_Buffer_Objfwd
:
644 offset
= XBUFFER_OBJFWD (valcontents
)->offset
;
645 return *(Lisp_Object
*)(offset
+ (char *)current_buffer
);
650 /* Store NEWVAL into SYM, where VALCONTENTS is found in the value cell
651 of SYM. If SYM is buffer-local, VALCONTENTS should be the
652 buffer-independent contents of the value cell: forwarded just one
653 step past the buffer-localness. */
656 store_symval_forwarding (sym
, valcontents
, newval
)
658 register Lisp_Object valcontents
, newval
;
660 #ifdef SWITCH_ENUM_BUG
661 switch ((int) XTYPE (valcontents
))
663 switch (XTYPE (valcontents
))
667 switch (XMISC (valcontents
)->type
)
669 case Lisp_Misc_Intfwd
:
670 CHECK_NUMBER (newval
, 1);
671 *XINTFWD (valcontents
)->intvar
= XINT (newval
);
674 case Lisp_Misc_Boolfwd
:
675 *XBOOLFWD (valcontents
)->boolvar
= NILP (newval
) ? 0 : 1;
678 case Lisp_Misc_Objfwd
:
679 *XOBJFWD (valcontents
)->objvar
= newval
;
682 case Lisp_Misc_Buffer_Objfwd
:
684 int offset
= XBUFFER_OBJFWD (valcontents
)->offset
;
687 type
= *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
);
688 if (! NILP (type
) && ! NILP (newval
)
689 && XTYPE (newval
) != XINT (type
))
690 buffer_slot_type_mismatch (offset
);
692 *(Lisp_Object
*)(offset
+ (char *)current_buffer
) = newval
;
702 valcontents
= XSYMBOL (sym
)->value
;
703 if (BUFFER_LOCAL_VALUEP (valcontents
)
704 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
705 XCONS (XSYMBOL (sym
)->value
)->car
= newval
;
707 XSYMBOL (sym
)->value
= newval
;
711 /* Set up the buffer-local symbol SYM for validity in the current
712 buffer. VALCONTENTS is the contents of its value cell.
713 Return the value forwarded one step past the buffer-local indicator. */
716 swap_in_symval_forwarding (sym
, valcontents
)
717 Lisp_Object sym
, valcontents
;
719 /* valcontents is a list
720 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)).
722 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
723 local_var_alist, that being the element whose car is this
724 variable. Or it can be a pointer to the
725 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not have
726 an element in its alist for this variable.
728 If the current buffer is not BUFFER, we store the current
729 REALVALUE value into CURRENT-ALIST-ELEMENT, then find the
730 appropriate alist element for the buffer now current and set up
731 CURRENT-ALIST-ELEMENT. Then we set REALVALUE out of that
732 element, and store into BUFFER.
734 Note that REALVALUE can be a forwarding pointer. */
736 register Lisp_Object tem1
;
737 tem1
= XCONS (XCONS (valcontents
)->cdr
)->car
;
739 if (NILP (tem1
) || current_buffer
!= XBUFFER (tem1
))
741 tem1
= XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
;
742 Fsetcdr (tem1
, do_symval_forwarding (XCONS (valcontents
)->car
));
743 tem1
= assq_no_quit (sym
, current_buffer
->local_var_alist
);
745 tem1
= XCONS (XCONS (valcontents
)->cdr
)->cdr
;
746 XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
= tem1
;
747 XSETBUFFER (XCONS (XCONS (valcontents
)->cdr
)->car
, current_buffer
);
748 store_symval_forwarding (sym
, XCONS (valcontents
)->car
, Fcdr (tem1
));
750 return XCONS (valcontents
)->car
;
753 /* Find the value of a symbol, returning Qunbound if it's not bound.
754 This is helpful for code which just wants to get a variable's value
755 if it has one, without signalling an error.
756 Note that it must not be possible to quit
757 within this function. Great care is required for this. */
760 find_symbol_value (sym
)
763 register Lisp_Object valcontents
, tem1
;
764 register Lisp_Object val
;
765 CHECK_SYMBOL (sym
, 0);
766 valcontents
= XSYMBOL (sym
)->value
;
769 #ifdef SWITCH_ENUM_BUG
770 switch ((int) XTYPE (valcontents
))
772 switch (XTYPE (valcontents
))
775 case Lisp_Buffer_Local_Value
:
776 case Lisp_Some_Buffer_Local_Value
:
777 valcontents
= swap_in_symval_forwarding (sym
, valcontents
);
781 switch (XMISC (valcontents
)->type
)
783 case Lisp_Misc_Intfwd
:
784 XSETINT (val
, *XINTFWD (valcontents
)->intvar
);
787 case Lisp_Misc_Boolfwd
:
788 return (*XBOOLFWD (valcontents
)->boolvar
? Qt
: Qnil
);
790 case Lisp_Misc_Objfwd
:
791 return *XOBJFWD (valcontents
)->objvar
;
793 case Lisp_Misc_Buffer_Objfwd
:
794 return *(Lisp_Object
*)(XBUFFER_OBJFWD (valcontents
)->offset
795 + (char *)current_buffer
);
802 DEFUN ("symbol-value", Fsymbol_value
, Ssymbol_value
, 1, 1, 0,
803 "Return SYMBOL's value. Error if that is void.")
809 val
= find_symbol_value (sym
);
810 if (EQ (val
, Qunbound
))
811 return Fsignal (Qvoid_variable
, Fcons (sym
, Qnil
));
816 DEFUN ("set", Fset
, Sset
, 2, 2, 0,
817 "Set SYMBOL's value to NEWVAL, and return NEWVAL.")
819 register Lisp_Object sym
, newval
;
821 int voide
= EQ (newval
, Qunbound
);
823 register Lisp_Object valcontents
, tem1
, current_alist_element
;
825 CHECK_SYMBOL (sym
, 0);
826 if (NILP (sym
) || EQ (sym
, Qt
))
827 return Fsignal (Qsetting_constant
, Fcons (sym
, Qnil
));
828 valcontents
= XSYMBOL (sym
)->value
;
830 if (BUFFER_OBJFWDP (valcontents
))
832 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
833 register int mask
= XINT (*((Lisp_Object
*)
834 (idx
+ (char *)&buffer_local_flags
)));
836 current_buffer
->local_var_flags
|= mask
;
839 else if (BUFFER_LOCAL_VALUEP (valcontents
)
840 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
842 /* valcontents is actually a pointer to a cons heading something like:
843 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE).
845 BUFFER is the last buffer for which this symbol's value was
848 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
849 local_var_alist, that being the element whose car is this
850 variable. Or it can be a pointer to the
851 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not
852 have an element in its alist for this variable (that is, if
853 BUFFER sees the default value of this variable).
855 If we want to examine or set the value and BUFFER is current,
856 we just examine or set REALVALUE. If BUFFER is not current, we
857 store the current REALVALUE value into CURRENT-ALIST-ELEMENT,
858 then find the appropriate alist element for the buffer now
859 current and set up CURRENT-ALIST-ELEMENT. Then we set
860 REALVALUE out of that element, and store into BUFFER.
862 If we are setting the variable and the current buffer does
863 not have an alist entry for this variable, an alist entry is
866 Note that REALVALUE can be a forwarding pointer. Each time
867 it is examined or set, forwarding must be done. */
869 /* What value are we caching right now? */
870 current_alist_element
=
871 XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
;
873 /* If the current buffer is not the buffer whose binding is
874 currently cached, or if it's a Lisp_Buffer_Local_Value and
875 we're looking at the default value, the cache is invalid; we
876 need to write it out, and find the new CURRENT-ALIST-ELEMENT. */
878 != XBUFFER (XCONS (XCONS (valcontents
)->cdr
)->car
))
879 || (BUFFER_LOCAL_VALUEP (valcontents
)
880 && EQ (XCONS (current_alist_element
)->car
,
881 current_alist_element
)))
883 /* Write out the cached value for the old buffer; copy it
884 back to its alist element. This works if the current
885 buffer only sees the default value, too. */
886 Fsetcdr (current_alist_element
,
887 do_symval_forwarding (XCONS (valcontents
)->car
));
889 /* Find the new value for CURRENT-ALIST-ELEMENT. */
890 tem1
= Fassq (sym
, current_buffer
->local_var_alist
);
893 /* This buffer still sees the default value. */
895 /* If the variable is a Lisp_Some_Buffer_Local_Value,
896 make CURRENT-ALIST-ELEMENT point to itself,
897 indicating that we're seeing the default value. */
898 if (SOME_BUFFER_LOCAL_VALUEP (valcontents
))
899 tem1
= XCONS (XCONS (valcontents
)->cdr
)->cdr
;
901 /* If it's a Lisp_Buffer_Local_Value, give this buffer a
902 new assoc for a local value and set
903 CURRENT-ALIST-ELEMENT to point to that. */
906 tem1
= Fcons (sym
, Fcdr (current_alist_element
));
907 current_buffer
->local_var_alist
=
908 Fcons (tem1
, current_buffer
->local_var_alist
);
911 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
912 XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
= tem1
;
914 /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */
915 XSETBUFFER (XCONS (XCONS (valcontents
)->cdr
)->car
, current_buffer
);
917 valcontents
= XCONS (valcontents
)->car
;
920 /* If storing void (making the symbol void), forward only through
921 buffer-local indicator, not through Lisp_Objfwd, etc. */
923 store_symval_forwarding (sym
, Qnil
, newval
);
925 store_symval_forwarding (sym
, valcontents
, newval
);
930 /* Access or set a buffer-local symbol's default value. */
932 /* Return the default value of SYM, but don't check for voidness.
933 Return Qunbound if it is void. */
939 register Lisp_Object valcontents
;
941 CHECK_SYMBOL (sym
, 0);
942 valcontents
= XSYMBOL (sym
)->value
;
944 /* For a built-in buffer-local variable, get the default value
945 rather than letting do_symval_forwarding get the current value. */
946 if (BUFFER_OBJFWDP (valcontents
))
948 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
950 if (XINT (*(Lisp_Object
*) (idx
+ (char *) &buffer_local_flags
)) != 0)
951 return *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
954 /* Handle user-created local variables. */
955 if (BUFFER_LOCAL_VALUEP (valcontents
)
956 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
958 /* If var is set up for a buffer that lacks a local value for it,
959 the current value is nominally the default value.
960 But the current value slot may be more up to date, since
961 ordinary setq stores just that slot. So use that. */
962 Lisp_Object current_alist_element
, alist_element_car
;
963 current_alist_element
964 = XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
;
965 alist_element_car
= XCONS (current_alist_element
)->car
;
966 if (EQ (alist_element_car
, current_alist_element
))
967 return do_symval_forwarding (XCONS (valcontents
)->car
);
969 return XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->cdr
;
971 /* For other variables, get the current value. */
972 return do_symval_forwarding (valcontents
);
975 DEFUN ("default-boundp", Fdefault_boundp
, Sdefault_boundp
, 1, 1, 0,
976 "Return T if SYMBOL has a non-void default value.\n\
977 This is the value that is seen in buffers that do not have their own values\n\
982 register Lisp_Object value
;
984 value
= default_value (sym
);
985 return (EQ (value
, Qunbound
) ? Qnil
: Qt
);
988 DEFUN ("default-value", Fdefault_value
, Sdefault_value
, 1, 1, 0,
989 "Return SYMBOL's default value.\n\
990 This is the value that is seen in buffers that do not have their own values\n\
991 for this variable. The default value is meaningful for variables with\n\
992 local bindings in certain buffers.")
996 register Lisp_Object value
;
998 value
= default_value (sym
);
999 if (EQ (value
, Qunbound
))
1000 return Fsignal (Qvoid_variable
, Fcons (sym
, Qnil
));
1004 DEFUN ("set-default", Fset_default
, Sset_default
, 2, 2, 0,
1005 "Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.\n\
1006 The default value is seen in buffers that do not have their own values\n\
1007 for this variable.")
1009 Lisp_Object sym
, value
;
1011 register Lisp_Object valcontents
, current_alist_element
, alist_element_buffer
;
1013 CHECK_SYMBOL (sym
, 0);
1014 valcontents
= XSYMBOL (sym
)->value
;
1016 /* Handle variables like case-fold-search that have special slots
1017 in the buffer. Make them work apparently like Lisp_Buffer_Local_Value
1019 if (BUFFER_OBJFWDP (valcontents
))
1021 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1022 register struct buffer
*b
;
1023 register int mask
= XINT (*((Lisp_Object
*)
1024 (idx
+ (char *)&buffer_local_flags
)));
1028 *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
) = value
;
1029 for (b
= all_buffers
; b
; b
= b
->next
)
1030 if (!(b
->local_var_flags
& mask
))
1031 *(Lisp_Object
*)(idx
+ (char *) b
) = value
;
1036 if (!BUFFER_LOCAL_VALUEP (valcontents
)
1037 && !SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1038 return Fset (sym
, value
);
1040 /* Store new value into the DEFAULT-VALUE slot */
1041 XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->cdr
= value
;
1043 /* If that slot is current, we must set the REALVALUE slot too */
1044 current_alist_element
= XCONS (XCONS (XCONS (valcontents
)->cdr
)->cdr
)->car
;
1045 alist_element_buffer
= Fcar (current_alist_element
);
1046 if (EQ (alist_element_buffer
, current_alist_element
))
1047 store_symval_forwarding (sym
, XCONS (valcontents
)->car
, value
);
1052 DEFUN ("setq-default", Fsetq_default
, Ssetq_default
, 2, UNEVALLED
, 0,
1053 "Set the default value of variable VAR to VALUE.\n\
1054 VAR, the variable name, is literal (not evaluated);\n\
1055 VALUE is an expression and it is evaluated.\n\
1056 The default value of a variable is seen in buffers\n\
1057 that do not have their own values for the variable.\n\
1059 More generally, you can use multiple variables and values, as in\n\
1060 (setq-default SYM VALUE SYM VALUE...)\n\
1061 This sets each SYM's default value to the corresponding VALUE.\n\
1062 The VALUE for the Nth SYM can refer to the new default values\n\
1067 register Lisp_Object args_left
;
1068 register Lisp_Object val
, sym
;
1069 struct gcpro gcpro1
;
1079 val
= Feval (Fcar (Fcdr (args_left
)));
1080 sym
= Fcar (args_left
);
1081 Fset_default (sym
, val
);
1082 args_left
= Fcdr (Fcdr (args_left
));
1084 while (!NILP (args_left
));
1090 /* Lisp functions for creating and removing buffer-local variables. */
1092 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local
, Smake_variable_buffer_local
,
1093 1, 1, "vMake Variable Buffer Local: ",
1094 "Make VARIABLE have a separate value for each buffer.\n\
1095 At any time, the value for the current buffer is in effect.\n\
1096 There is also a default value which is seen in any buffer which has not yet\n\
1097 set its own value.\n\
1098 Using `set' or `setq' to set the variable causes it to have a separate value\n\
1099 for the current buffer if it was previously using the default value.\n\
1100 The function `default-value' gets the default value and `set-default' sets it.")
1102 register Lisp_Object sym
;
1104 register Lisp_Object tem
, valcontents
;
1106 CHECK_SYMBOL (sym
, 0);
1108 if (EQ (sym
, Qnil
) || EQ (sym
, Qt
))
1109 error ("Symbol %s may not be buffer-local", XSYMBOL (sym
)->name
->data
);
1111 valcontents
= XSYMBOL (sym
)->value
;
1112 if (BUFFER_LOCAL_VALUEP (valcontents
) || BUFFER_OBJFWDP (valcontents
))
1114 if (SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1116 XSETTYPE (XSYMBOL (sym
)->value
, Lisp_Buffer_Local_Value
);
1119 if (EQ (valcontents
, Qunbound
))
1120 XSYMBOL (sym
)->value
= Qnil
;
1121 tem
= Fcons (Qnil
, Fsymbol_value (sym
));
1122 XCONS (tem
)->car
= tem
;
1123 XSYMBOL (sym
)->value
= Fcons (XSYMBOL (sym
)->value
, Fcons (Fcurrent_buffer (), tem
));
1124 XSETTYPE (XSYMBOL (sym
)->value
, Lisp_Buffer_Local_Value
);
1128 DEFUN ("make-local-variable", Fmake_local_variable
, Smake_local_variable
,
1129 1, 1, "vMake Local Variable: ",
1130 "Make VARIABLE have a separate value in the current buffer.\n\
1131 Other buffers will continue to share a common default value.\n\
1132 \(The buffer-local value of VARIABLE starts out as the same value\n\
1133 VARIABLE previously had. If VARIABLE was void, it remains void.\)\n\
1134 See also `make-variable-buffer-local'.\n\n\
1135 If the variable is already arranged to become local when set,\n\
1136 this function causes a local value to exist for this buffer,\n\
1137 just as setting the variable would do.\n\
1139 Do not use `make-local-variable' to make a hook variable buffer-local.\n\
1140 Use `make-local-hook' instead.")
1142 register Lisp_Object sym
;
1144 register Lisp_Object tem
, valcontents
;
1146 CHECK_SYMBOL (sym
, 0);
1148 if (EQ (sym
, Qnil
) || EQ (sym
, Qt
))
1149 error ("Symbol %s may not be buffer-local", XSYMBOL (sym
)->name
->data
);
1151 valcontents
= XSYMBOL (sym
)->value
;
1152 if (BUFFER_LOCAL_VALUEP (valcontents
) || BUFFER_OBJFWDP (valcontents
))
1154 tem
= Fboundp (sym
);
1156 /* Make sure the symbol has a local value in this particular buffer,
1157 by setting it to the same value it already has. */
1158 Fset (sym
, (EQ (tem
, Qt
) ? Fsymbol_value (sym
) : Qunbound
));
1161 /* Make sure sym is set up to hold per-buffer values */
1162 if (!SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1164 tem
= Fcons (Qnil
, do_symval_forwarding (valcontents
));
1165 XCONS (tem
)->car
= tem
;
1166 XSYMBOL (sym
)->value
= Fcons (XSYMBOL (sym
)->value
, Fcons (Qnil
, tem
));
1167 XSETTYPE (XSYMBOL (sym
)->value
, Lisp_Some_Buffer_Local_Value
);
1169 /* Make sure this buffer has its own value of sym */
1170 tem
= Fassq (sym
, current_buffer
->local_var_alist
);
1173 current_buffer
->local_var_alist
1174 = Fcons (Fcons (sym
, XCONS (XCONS (XCONS (XSYMBOL (sym
)->value
)->cdr
)->cdr
)->cdr
),
1175 current_buffer
->local_var_alist
);
1177 /* Make sure symbol does not think it is set up for this buffer;
1178 force it to look once again for this buffer's value */
1180 /* This local variable avoids "expression too complex" on IBM RT. */
1183 xs
= XSYMBOL (sym
)->value
;
1184 if (current_buffer
== XBUFFER (XCONS (XCONS (xs
)->cdr
)->car
))
1185 XCONS (XCONS (XSYMBOL (sym
)->value
)->cdr
)->car
= Qnil
;
1189 /* If the symbol forwards into a C variable, then swap in the
1190 variable for this buffer immediately. If C code modifies the
1191 variable before we swap in, then that new value will clobber the
1192 default value the next time we swap. */
1193 valcontents
= XCONS (XSYMBOL (sym
)->value
)->car
;
1194 if (INTFWDP (valcontents
) || BOOLFWDP (valcontents
) || OBJFWDP (valcontents
))
1195 swap_in_symval_forwarding (sym
, XSYMBOL (sym
)->value
);
1200 DEFUN ("kill-local-variable", Fkill_local_variable
, Skill_local_variable
,
1201 1, 1, "vKill Local Variable: ",
1202 "Make VARIABLE no longer have a separate value in the current buffer.\n\
1203 From now on the default value will apply in this buffer.")
1205 register Lisp_Object sym
;
1207 register Lisp_Object tem
, valcontents
;
1209 CHECK_SYMBOL (sym
, 0);
1211 valcontents
= XSYMBOL (sym
)->value
;
1213 if (BUFFER_OBJFWDP (valcontents
))
1215 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1216 register int mask
= XINT (*((Lisp_Object
*)
1217 (idx
+ (char *)&buffer_local_flags
)));
1221 *(Lisp_Object
*)(idx
+ (char *) current_buffer
)
1222 = *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
1223 current_buffer
->local_var_flags
&= ~mask
;
1228 if (!BUFFER_LOCAL_VALUEP (valcontents
)
1229 && !SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1232 /* Get rid of this buffer's alist element, if any */
1234 tem
= Fassq (sym
, current_buffer
->local_var_alist
);
1236 current_buffer
->local_var_alist
= Fdelq (tem
, current_buffer
->local_var_alist
);
1238 /* Make sure symbol does not think it is set up for this buffer;
1239 force it to look once again for this buffer's value */
1242 sv
= XSYMBOL (sym
)->value
;
1243 if (current_buffer
== XBUFFER (XCONS (XCONS (sv
)->cdr
)->car
))
1244 XCONS (XCONS (sv
)->cdr
)->car
= Qnil
;
1250 DEFUN ("local-variable-p", Flocal_variable_p
, Slocal_variable_p
,
1252 "Non-nil if VARIABLE has a local binding in the current buffer.")
1254 register Lisp_Object sym
;
1256 Lisp_Object valcontents
;
1258 CHECK_SYMBOL (sym
, 0);
1260 valcontents
= XSYMBOL (sym
)->value
;
1261 return ((BUFFER_LOCAL_VALUEP (valcontents
)
1262 || SOME_BUFFER_LOCAL_VALUEP (valcontents
)
1263 || BUFFER_OBJFWDP (valcontents
))
1267 /* Find the function at the end of a chain of symbol function indirections. */
1269 /* If OBJECT is a symbol, find the end of its function chain and
1270 return the value found there. If OBJECT is not a symbol, just
1271 return it. If there is a cycle in the function chain, signal a
1272 cyclic-function-indirection error.
1274 This is like Findirect_function, except that it doesn't signal an
1275 error if the chain ends up unbound. */
1277 indirect_function (object
)
1278 register Lisp_Object object
;
1280 Lisp_Object tortoise
, hare
;
1282 hare
= tortoise
= object
;
1286 if (!SYMBOLP (hare
) || EQ (hare
, Qunbound
))
1288 hare
= XSYMBOL (hare
)->function
;
1289 if (!SYMBOLP (hare
) || EQ (hare
, Qunbound
))
1291 hare
= XSYMBOL (hare
)->function
;
1293 tortoise
= XSYMBOL (tortoise
)->function
;
1295 if (EQ (hare
, tortoise
))
1296 Fsignal (Qcyclic_function_indirection
, Fcons (object
, Qnil
));
1302 DEFUN ("indirect-function", Findirect_function
, Sindirect_function
, 1, 1, 0,
1303 "Return the function at the end of OBJECT's function chain.\n\
1304 If OBJECT is a symbol, follow all function indirections and return the final\n\
1305 function binding.\n\
1306 If OBJECT is not a symbol, just return it.\n\
1307 Signal a void-function error if the final symbol is unbound.\n\
1308 Signal a cyclic-function-indirection error if there is a loop in the\n\
1309 function chain of symbols.")
1311 register Lisp_Object object
;
1315 result
= indirect_function (object
);
1317 if (EQ (result
, Qunbound
))
1318 return Fsignal (Qvoid_function
, Fcons (object
, Qnil
));
1322 /* Extract and set vector and string elements */
1324 DEFUN ("aref", Faref
, Saref
, 2, 2, 0,
1325 "Return the element of ARRAY at index INDEX.\n\
1326 ARRAY may be a vector or a string, or a byte-code object. INDEX starts at 0.")
1328 register Lisp_Object array
;
1331 register int idxval
;
1333 CHECK_NUMBER (idx
, 1);
1334 idxval
= XINT (idx
);
1335 if (!VECTORP (array
) && !STRINGP (array
) && !COMPILEDP (array
))
1336 array
= wrong_type_argument (Qarrayp
, array
);
1337 if (idxval
< 0 || idxval
>= XVECTOR (array
)->size
)
1338 args_out_of_range (array
, idx
);
1339 if (STRINGP (array
))
1342 XSETFASTINT (val
, (unsigned char) XSTRING (array
)->data
[idxval
]);
1346 return XVECTOR (array
)->contents
[idxval
];
1349 DEFUN ("aset", Faset
, Saset
, 3, 3, 0,
1350 "Store into the element of ARRAY at index IDX the value NEWELT.\n\
1351 ARRAY may be a vector or a string. IDX starts at 0.")
1352 (array
, idx
, newelt
)
1353 register Lisp_Object array
;
1354 Lisp_Object idx
, newelt
;
1356 register int idxval
;
1358 CHECK_NUMBER (idx
, 1);
1359 idxval
= XINT (idx
);
1360 if (!VECTORP (array
) && !STRINGP (array
))
1361 array
= wrong_type_argument (Qarrayp
, array
);
1362 if (idxval
< 0 || idxval
>= XVECTOR (array
)->size
)
1363 args_out_of_range (array
, idx
);
1364 CHECK_IMPURE (array
);
1366 if (VECTORP (array
))
1367 XVECTOR (array
)->contents
[idxval
] = newelt
;
1370 CHECK_NUMBER (newelt
, 2);
1371 XSTRING (array
)->data
[idxval
] = XINT (newelt
);
1378 Farray_length (array
)
1379 register Lisp_Object array
;
1381 register Lisp_Object size
;
1382 if (!VECTORP (array
) && !STRINGP (array
) && !COMPILEDP (array
))
1383 array
= wrong_type_argument (Qarrayp
, array
);
1384 XSETFASTINT (size
, XVECTOR (array
)->size
);
1388 /* Arithmetic functions */
1390 enum comparison
{ equal
, notequal
, less
, grtr
, less_or_equal
, grtr_or_equal
};
1393 arithcompare (num1
, num2
, comparison
)
1394 Lisp_Object num1
, num2
;
1395 enum comparison comparison
;
1400 #ifdef LISP_FLOAT_TYPE
1401 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1
, 0);
1402 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2
, 0);
1404 if (FLOATP (num1
) || FLOATP (num2
))
1407 f1
= (FLOATP (num1
)) ? XFLOAT (num1
)->data
: XINT (num1
);
1408 f2
= (FLOATP (num2
)) ? XFLOAT (num2
)->data
: XINT (num2
);
1411 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1412 CHECK_NUMBER_COERCE_MARKER (num2
, 0);
1413 #endif /* LISP_FLOAT_TYPE */
1418 if (floatp
? f1
== f2
: XINT (num1
) == XINT (num2
))
1423 if (floatp
? f1
!= f2
: XINT (num1
) != XINT (num2
))
1428 if (floatp
? f1
< f2
: XINT (num1
) < XINT (num2
))
1433 if (floatp
? f1
<= f2
: XINT (num1
) <= XINT (num2
))
1438 if (floatp
? f1
> f2
: XINT (num1
) > XINT (num2
))
1443 if (floatp
? f1
>= f2
: XINT (num1
) >= XINT (num2
))
1452 DEFUN ("=", Feqlsign
, Seqlsign
, 2, 2, 0,
1453 "T if two args, both numbers or markers, are equal.")
1455 register Lisp_Object num1
, num2
;
1457 return arithcompare (num1
, num2
, equal
);
1460 DEFUN ("<", Flss
, Slss
, 2, 2, 0,
1461 "T if first arg is less than second arg. Both must be numbers or markers.")
1463 register Lisp_Object num1
, num2
;
1465 return arithcompare (num1
, num2
, less
);
1468 DEFUN (">", Fgtr
, Sgtr
, 2, 2, 0,
1469 "T if first arg is greater than second arg. Both must be numbers or markers.")
1471 register Lisp_Object num1
, num2
;
1473 return arithcompare (num1
, num2
, grtr
);
1476 DEFUN ("<=", Fleq
, Sleq
, 2, 2, 0,
1477 "T if first arg is less than or equal to second arg.\n\
1478 Both must be numbers or markers.")
1480 register Lisp_Object num1
, num2
;
1482 return arithcompare (num1
, num2
, less_or_equal
);
1485 DEFUN (">=", Fgeq
, Sgeq
, 2, 2, 0,
1486 "T if first arg is greater than or equal to second arg.\n\
1487 Both must be numbers or markers.")
1489 register Lisp_Object num1
, num2
;
1491 return arithcompare (num1
, num2
, grtr_or_equal
);
1494 DEFUN ("/=", Fneq
, Sneq
, 2, 2, 0,
1495 "T if first arg is not equal to second arg. Both must be numbers or markers.")
1497 register Lisp_Object num1
, num2
;
1499 return arithcompare (num1
, num2
, notequal
);
1502 DEFUN ("zerop", Fzerop
, Szerop
, 1, 1, 0, "T if NUMBER is zero.")
1504 register Lisp_Object num
;
1506 #ifdef LISP_FLOAT_TYPE
1507 CHECK_NUMBER_OR_FLOAT (num
, 0);
1511 if (XFLOAT(num
)->data
== 0.0)
1516 CHECK_NUMBER (num
, 0);
1517 #endif /* LISP_FLOAT_TYPE */
1524 /* Convert between 32-bit values and pairs of lispy 24-bit values. */
1530 unsigned int top
= i
>> 16;
1531 unsigned int bot
= i
& 0xFFFF;
1533 return make_number (bot
);
1535 return Fcons (make_number (-1), make_number (bot
));
1536 return Fcons (make_number (top
), make_number (bot
));
1543 Lisp_Object top
, bot
;
1546 top
= XCONS (c
)->car
;
1547 bot
= XCONS (c
)->cdr
;
1549 bot
= XCONS (bot
)->car
;
1550 return ((XINT (top
) << 16) | XINT (bot
));
1553 DEFUN ("number-to-string", Fnumber_to_string
, Snumber_to_string
, 1, 1, 0,
1554 "Convert NUM to a string by printing it in decimal.\n\
1555 Uses a minus sign if negative.\n\
1556 NUM may be an integer or a floating point number.")
1562 #ifndef LISP_FLOAT_TYPE
1563 CHECK_NUMBER (num
, 0);
1565 CHECK_NUMBER_OR_FLOAT (num
, 0);
1569 char pigbuf
[350]; /* see comments in float_to_string */
1571 float_to_string (pigbuf
, XFLOAT(num
)->data
);
1572 return build_string (pigbuf
);
1574 #endif /* LISP_FLOAT_TYPE */
1576 sprintf (buffer
, "%d", XINT (num
));
1577 return build_string (buffer
);
1580 DEFUN ("string-to-number", Fstring_to_number
, Sstring_to_number
, 1, 1, 0,
1581 "Convert STRING to a number by parsing it as a decimal number.\n\
1582 This parses both integers and floating point numbers.\n\
1583 It ignores leading spaces and tabs.")
1585 register Lisp_Object str
;
1589 CHECK_STRING (str
, 0);
1591 p
= XSTRING (str
)->data
;
1593 /* Skip any whitespace at the front of the number. Some versions of
1594 atoi do this anyway, so we might as well make Emacs lisp consistent. */
1595 while (*p
== ' ' || *p
== '\t')
1598 #ifdef LISP_FLOAT_TYPE
1599 if (isfloat_string (p
))
1600 return make_float (atof (p
));
1601 #endif /* LISP_FLOAT_TYPE */
1603 return make_number (atoi (p
));
1607 { Aadd
, Asub
, Amult
, Adiv
, Alogand
, Alogior
, Alogxor
, Amax
, Amin
};
1609 extern Lisp_Object
float_arith_driver ();
1612 arith_driver (code
, nargs
, args
)
1615 register Lisp_Object
*args
;
1617 register Lisp_Object val
;
1618 register int argnum
;
1622 #ifdef SWITCH_ENUM_BUG
1639 for (argnum
= 0; argnum
< nargs
; argnum
++)
1641 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
1642 #ifdef LISP_FLOAT_TYPE
1643 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
1645 if (FLOATP (val
)) /* time to do serious math */
1646 return (float_arith_driver ((double) accum
, argnum
, code
,
1649 CHECK_NUMBER_COERCE_MARKER (val
, argnum
);
1650 #endif /* LISP_FLOAT_TYPE */
1651 args
[argnum
] = val
; /* runs into a compiler bug. */
1652 next
= XINT (args
[argnum
]);
1653 #ifdef SWITCH_ENUM_BUG
1659 case Aadd
: accum
+= next
; break;
1661 if (!argnum
&& nargs
!= 1)
1665 case Amult
: accum
*= next
; break;
1667 if (!argnum
) accum
= next
;
1671 Fsignal (Qarith_error
, Qnil
);
1675 case Alogand
: accum
&= next
; break;
1676 case Alogior
: accum
|= next
; break;
1677 case Alogxor
: accum
^= next
; break;
1678 case Amax
: if (!argnum
|| next
> accum
) accum
= next
; break;
1679 case Amin
: if (!argnum
|| next
< accum
) accum
= next
; break;
1683 XSETINT (val
, accum
);
1687 #ifdef LISP_FLOAT_TYPE
1690 #define isnan(x) ((x) != (x))
1693 float_arith_driver (accum
, argnum
, code
, nargs
, args
)
1695 register int argnum
;
1698 register Lisp_Object
*args
;
1700 register Lisp_Object val
;
1703 for (; argnum
< nargs
; argnum
++)
1705 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
1706 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
1710 next
= XFLOAT (val
)->data
;
1714 args
[argnum
] = val
; /* runs into a compiler bug. */
1715 next
= XINT (args
[argnum
]);
1717 #ifdef SWITCH_ENUM_BUG
1727 if (!argnum
&& nargs
!= 1)
1740 Fsignal (Qarith_error
, Qnil
);
1747 return wrong_type_argument (Qinteger_or_marker_p
, val
);
1749 if (!argnum
|| isnan (next
) || next
> accum
)
1753 if (!argnum
|| isnan (next
) || next
< accum
)
1759 return make_float (accum
);
1761 #endif /* LISP_FLOAT_TYPE */
1763 DEFUN ("+", Fplus
, Splus
, 0, MANY
, 0,
1764 "Return sum of any number of arguments, which are numbers or markers.")
1769 return arith_driver (Aadd
, nargs
, args
);
1772 DEFUN ("-", Fminus
, Sminus
, 0, MANY
, 0,
1773 "Negate number or subtract numbers or markers.\n\
1774 With one arg, negates it. With more than one arg,\n\
1775 subtracts all but the first from the first.")
1780 return arith_driver (Asub
, nargs
, args
);
1783 DEFUN ("*", Ftimes
, Stimes
, 0, MANY
, 0,
1784 "Returns product of any number of arguments, which are numbers or markers.")
1789 return arith_driver (Amult
, nargs
, args
);
1792 DEFUN ("/", Fquo
, Squo
, 2, MANY
, 0,
1793 "Returns first argument divided by all the remaining arguments.\n\
1794 The arguments must be numbers or markers.")
1799 return arith_driver (Adiv
, nargs
, args
);
1802 DEFUN ("%", Frem
, Srem
, 2, 2, 0,
1803 "Returns remainder of first arg divided by second.\n\
1804 Both must be integers or markers.")
1806 register Lisp_Object num1
, num2
;
1810 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1811 CHECK_NUMBER_COERCE_MARKER (num2
, 1);
1813 if (XFASTINT (num2
) == 0)
1814 Fsignal (Qarith_error
, Qnil
);
1816 XSETINT (val
, XINT (num1
) % XINT (num2
));
1825 #ifdef HAVE_DREM /* Some systems use this non-standard name. */
1826 return (drem (f1
, f2
));
1827 #else /* Other systems don't seem to have it at all. */
1828 return (f1
- f2
* floor (f1
/f2
));
1831 #endif /* ! HAVE_FMOD */
1833 DEFUN ("mod", Fmod
, Smod
, 2, 2, 0,
1834 "Returns X modulo Y.\n\
1835 The result falls between zero (inclusive) and Y (exclusive).\n\
1836 Both X and Y must be numbers or markers.")
1838 register Lisp_Object num1
, num2
;
1843 #ifdef LISP_FLOAT_TYPE
1844 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1
, 0);
1845 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2
, 1);
1847 if (FLOATP (num1
) || FLOATP (num2
))
1851 f1
= FLOATP (num1
) ? XFLOAT (num1
)->data
: XINT (num1
);
1852 f2
= FLOATP (num2
) ? XFLOAT (num2
)->data
: XINT (num2
);
1854 Fsignal (Qarith_error
, Qnil
);
1857 /* If the "remainder" comes out with the wrong sign, fix it. */
1858 if ((f1
< 0) != (f2
< 0))
1860 return (make_float (f1
));
1862 #else /* not LISP_FLOAT_TYPE */
1863 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1864 CHECK_NUMBER_COERCE_MARKER (num2
, 1);
1865 #endif /* not LISP_FLOAT_TYPE */
1871 Fsignal (Qarith_error
, Qnil
);
1875 /* If the "remainder" comes out with the wrong sign, fix it. */
1876 if ((i1
< 0) != (i2
< 0))
1883 DEFUN ("max", Fmax
, Smax
, 1, MANY
, 0,
1884 "Return largest of all the arguments (which must be numbers or markers).\n\
1885 The value is always a number; markers are converted to numbers.")
1890 return arith_driver (Amax
, nargs
, args
);
1893 DEFUN ("min", Fmin
, Smin
, 1, MANY
, 0,
1894 "Return smallest of all the arguments (which must be numbers or markers).\n\
1895 The value is always a number; markers are converted to numbers.")
1900 return arith_driver (Amin
, nargs
, args
);
1903 DEFUN ("logand", Flogand
, Slogand
, 0, MANY
, 0,
1904 "Return bitwise-and of all the arguments.\n\
1905 Arguments may be integers, or markers converted to integers.")
1910 return arith_driver (Alogand
, nargs
, args
);
1913 DEFUN ("logior", Flogior
, Slogior
, 0, MANY
, 0,
1914 "Return bitwise-or of all the arguments.\n\
1915 Arguments may be integers, or markers converted to integers.")
1920 return arith_driver (Alogior
, nargs
, args
);
1923 DEFUN ("logxor", Flogxor
, Slogxor
, 0, MANY
, 0,
1924 "Return bitwise-exclusive-or of all the arguments.\n\
1925 Arguments may be integers, or markers converted to integers.")
1930 return arith_driver (Alogxor
, nargs
, args
);
1933 DEFUN ("ash", Fash
, Sash
, 2, 2, 0,
1934 "Return VALUE with its bits shifted left by COUNT.\n\
1935 If COUNT is negative, shifting is actually to the right.\n\
1936 In this case, the sign bit is duplicated.")
1938 register Lisp_Object num1
, num2
;
1940 register Lisp_Object val
;
1942 CHECK_NUMBER (num1
, 0);
1943 CHECK_NUMBER (num2
, 1);
1945 if (XINT (num2
) > 0)
1946 XSETINT (val
, XINT (num1
) << XFASTINT (num2
));
1948 XSETINT (val
, XINT (num1
) >> -XINT (num2
));
1952 DEFUN ("lsh", Flsh
, Slsh
, 2, 2, 0,
1953 "Return VALUE with its bits shifted left by COUNT.\n\
1954 If COUNT is negative, shifting is actually to the right.\n\
1955 In this case, zeros are shifted in on the left.")
1957 register Lisp_Object num1
, num2
;
1959 register Lisp_Object val
;
1961 CHECK_NUMBER (num1
, 0);
1962 CHECK_NUMBER (num2
, 1);
1964 if (XINT (num2
) > 0)
1965 XSETINT (val
, (EMACS_UINT
) XUINT (num1
) << XFASTINT (num2
));
1967 XSETINT (val
, (EMACS_UINT
) XUINT (num1
) >> -XINT (num2
));
1971 DEFUN ("1+", Fadd1
, Sadd1
, 1, 1, 0,
1972 "Return NUMBER plus one. NUMBER may be a number or a marker.\n\
1973 Markers are converted to integers.")
1975 register Lisp_Object num
;
1977 #ifdef LISP_FLOAT_TYPE
1978 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num
, 0);
1981 return (make_float (1.0 + XFLOAT (num
)->data
));
1983 CHECK_NUMBER_COERCE_MARKER (num
, 0);
1984 #endif /* LISP_FLOAT_TYPE */
1986 XSETINT (num
, XINT (num
) + 1);
1990 DEFUN ("1-", Fsub1
, Ssub1
, 1, 1, 0,
1991 "Return NUMBER minus one. NUMBER may be a number or a marker.\n\
1992 Markers are converted to integers.")
1994 register Lisp_Object num
;
1996 #ifdef LISP_FLOAT_TYPE
1997 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num
, 0);
2000 return (make_float (-1.0 + XFLOAT (num
)->data
));
2002 CHECK_NUMBER_COERCE_MARKER (num
, 0);
2003 #endif /* LISP_FLOAT_TYPE */
2005 XSETINT (num
, XINT (num
) - 1);
2009 DEFUN ("lognot", Flognot
, Slognot
, 1, 1, 0,
2010 "Return the bitwise complement of ARG. ARG must be an integer.")
2012 register Lisp_Object num
;
2014 CHECK_NUMBER (num
, 0);
2015 XSETINT (num
, ~XINT (num
));
2022 Lisp_Object error_tail
, arith_tail
;
2024 Qquote
= intern ("quote");
2025 Qlambda
= intern ("lambda");
2026 Qsubr
= intern ("subr");
2027 Qerror_conditions
= intern ("error-conditions");
2028 Qerror_message
= intern ("error-message");
2029 Qtop_level
= intern ("top-level");
2031 Qerror
= intern ("error");
2032 Qquit
= intern ("quit");
2033 Qwrong_type_argument
= intern ("wrong-type-argument");
2034 Qargs_out_of_range
= intern ("args-out-of-range");
2035 Qvoid_function
= intern ("void-function");
2036 Qcyclic_function_indirection
= intern ("cyclic-function-indirection");
2037 Qvoid_variable
= intern ("void-variable");
2038 Qsetting_constant
= intern ("setting-constant");
2039 Qinvalid_read_syntax
= intern ("invalid-read-syntax");
2041 Qinvalid_function
= intern ("invalid-function");
2042 Qwrong_number_of_arguments
= intern ("wrong-number-of-arguments");
2043 Qno_catch
= intern ("no-catch");
2044 Qend_of_file
= intern ("end-of-file");
2045 Qarith_error
= intern ("arith-error");
2046 Qbeginning_of_buffer
= intern ("beginning-of-buffer");
2047 Qend_of_buffer
= intern ("end-of-buffer");
2048 Qbuffer_read_only
= intern ("buffer-read-only");
2049 Qmark_inactive
= intern ("mark-inactive");
2051 Qlistp
= intern ("listp");
2052 Qconsp
= intern ("consp");
2053 Qsymbolp
= intern ("symbolp");
2054 Qintegerp
= intern ("integerp");
2055 Qnatnump
= intern ("natnump");
2056 Qwholenump
= intern ("wholenump");
2057 Qstringp
= intern ("stringp");
2058 Qarrayp
= intern ("arrayp");
2059 Qsequencep
= intern ("sequencep");
2060 Qbufferp
= intern ("bufferp");
2061 Qvectorp
= intern ("vectorp");
2062 Qchar_or_string_p
= intern ("char-or-string-p");
2063 Qmarkerp
= intern ("markerp");
2064 Qbuffer_or_string_p
= intern ("buffer-or-string-p");
2065 Qinteger_or_marker_p
= intern ("integer-or-marker-p");
2066 Qboundp
= intern ("boundp");
2067 Qfboundp
= intern ("fboundp");
2069 #ifdef LISP_FLOAT_TYPE
2070 Qfloatp
= intern ("floatp");
2071 Qnumberp
= intern ("numberp");
2072 Qnumber_or_marker_p
= intern ("number-or-marker-p");
2073 #endif /* LISP_FLOAT_TYPE */
2075 Qcdr
= intern ("cdr");
2077 /* Handle automatic advice activation */
2078 Qad_advice_info
= intern ("ad-advice-info");
2079 Qad_activate
= intern ("ad-activate");
2081 error_tail
= Fcons (Qerror
, Qnil
);
2083 /* ERROR is used as a signaler for random errors for which nothing else is right */
2085 Fput (Qerror
, Qerror_conditions
,
2087 Fput (Qerror
, Qerror_message
,
2088 build_string ("error"));
2090 Fput (Qquit
, Qerror_conditions
,
2091 Fcons (Qquit
, Qnil
));
2092 Fput (Qquit
, Qerror_message
,
2093 build_string ("Quit"));
2095 Fput (Qwrong_type_argument
, Qerror_conditions
,
2096 Fcons (Qwrong_type_argument
, error_tail
));
2097 Fput (Qwrong_type_argument
, Qerror_message
,
2098 build_string ("Wrong type argument"));
2100 Fput (Qargs_out_of_range
, Qerror_conditions
,
2101 Fcons (Qargs_out_of_range
, error_tail
));
2102 Fput (Qargs_out_of_range
, Qerror_message
,
2103 build_string ("Args out of range"));
2105 Fput (Qvoid_function
, Qerror_conditions
,
2106 Fcons (Qvoid_function
, error_tail
));
2107 Fput (Qvoid_function
, Qerror_message
,
2108 build_string ("Symbol's function definition is void"));
2110 Fput (Qcyclic_function_indirection
, Qerror_conditions
,
2111 Fcons (Qcyclic_function_indirection
, error_tail
));
2112 Fput (Qcyclic_function_indirection
, Qerror_message
,
2113 build_string ("Symbol's chain of function indirections contains a loop"));
2115 Fput (Qvoid_variable
, Qerror_conditions
,
2116 Fcons (Qvoid_variable
, error_tail
));
2117 Fput (Qvoid_variable
, Qerror_message
,
2118 build_string ("Symbol's value as variable is void"));
2120 Fput (Qsetting_constant
, Qerror_conditions
,
2121 Fcons (Qsetting_constant
, error_tail
));
2122 Fput (Qsetting_constant
, Qerror_message
,
2123 build_string ("Attempt to set a constant symbol"));
2125 Fput (Qinvalid_read_syntax
, Qerror_conditions
,
2126 Fcons (Qinvalid_read_syntax
, error_tail
));
2127 Fput (Qinvalid_read_syntax
, Qerror_message
,
2128 build_string ("Invalid read syntax"));
2130 Fput (Qinvalid_function
, Qerror_conditions
,
2131 Fcons (Qinvalid_function
, error_tail
));
2132 Fput (Qinvalid_function
, Qerror_message
,
2133 build_string ("Invalid function"));
2135 Fput (Qwrong_number_of_arguments
, Qerror_conditions
,
2136 Fcons (Qwrong_number_of_arguments
, error_tail
));
2137 Fput (Qwrong_number_of_arguments
, Qerror_message
,
2138 build_string ("Wrong number of arguments"));
2140 Fput (Qno_catch
, Qerror_conditions
,
2141 Fcons (Qno_catch
, error_tail
));
2142 Fput (Qno_catch
, Qerror_message
,
2143 build_string ("No catch for tag"));
2145 Fput (Qend_of_file
, Qerror_conditions
,
2146 Fcons (Qend_of_file
, error_tail
));
2147 Fput (Qend_of_file
, Qerror_message
,
2148 build_string ("End of file during parsing"));
2150 arith_tail
= Fcons (Qarith_error
, error_tail
);
2151 Fput (Qarith_error
, Qerror_conditions
,
2153 Fput (Qarith_error
, Qerror_message
,
2154 build_string ("Arithmetic error"));
2156 Fput (Qbeginning_of_buffer
, Qerror_conditions
,
2157 Fcons (Qbeginning_of_buffer
, error_tail
));
2158 Fput (Qbeginning_of_buffer
, Qerror_message
,
2159 build_string ("Beginning of buffer"));
2161 Fput (Qend_of_buffer
, Qerror_conditions
,
2162 Fcons (Qend_of_buffer
, error_tail
));
2163 Fput (Qend_of_buffer
, Qerror_message
,
2164 build_string ("End of buffer"));
2166 Fput (Qbuffer_read_only
, Qerror_conditions
,
2167 Fcons (Qbuffer_read_only
, error_tail
));
2168 Fput (Qbuffer_read_only
, Qerror_message
,
2169 build_string ("Buffer is read-only"));
2171 #ifdef LISP_FLOAT_TYPE
2172 Qrange_error
= intern ("range-error");
2173 Qdomain_error
= intern ("domain-error");
2174 Qsingularity_error
= intern ("singularity-error");
2175 Qoverflow_error
= intern ("overflow-error");
2176 Qunderflow_error
= intern ("underflow-error");
2178 Fput (Qdomain_error
, Qerror_conditions
,
2179 Fcons (Qdomain_error
, arith_tail
));
2180 Fput (Qdomain_error
, Qerror_message
,
2181 build_string ("Arithmetic domain error"));
2183 Fput (Qrange_error
, Qerror_conditions
,
2184 Fcons (Qrange_error
, arith_tail
));
2185 Fput (Qrange_error
, Qerror_message
,
2186 build_string ("Arithmetic range error"));
2188 Fput (Qsingularity_error
, Qerror_conditions
,
2189 Fcons (Qsingularity_error
, Fcons (Qdomain_error
, arith_tail
)));
2190 Fput (Qsingularity_error
, Qerror_message
,
2191 build_string ("Arithmetic singularity error"));
2193 Fput (Qoverflow_error
, Qerror_conditions
,
2194 Fcons (Qoverflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2195 Fput (Qoverflow_error
, Qerror_message
,
2196 build_string ("Arithmetic overflow error"));
2198 Fput (Qunderflow_error
, Qerror_conditions
,
2199 Fcons (Qunderflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2200 Fput (Qunderflow_error
, Qerror_message
,
2201 build_string ("Arithmetic underflow error"));
2203 staticpro (&Qrange_error
);
2204 staticpro (&Qdomain_error
);
2205 staticpro (&Qsingularity_error
);
2206 staticpro (&Qoverflow_error
);
2207 staticpro (&Qunderflow_error
);
2208 #endif /* LISP_FLOAT_TYPE */
2212 staticpro (&Qquote
);
2213 staticpro (&Qlambda
);
2215 staticpro (&Qunbound
);
2216 staticpro (&Qerror_conditions
);
2217 staticpro (&Qerror_message
);
2218 staticpro (&Qtop_level
);
2220 staticpro (&Qerror
);
2222 staticpro (&Qwrong_type_argument
);
2223 staticpro (&Qargs_out_of_range
);
2224 staticpro (&Qvoid_function
);
2225 staticpro (&Qcyclic_function_indirection
);
2226 staticpro (&Qvoid_variable
);
2227 staticpro (&Qsetting_constant
);
2228 staticpro (&Qinvalid_read_syntax
);
2229 staticpro (&Qwrong_number_of_arguments
);
2230 staticpro (&Qinvalid_function
);
2231 staticpro (&Qno_catch
);
2232 staticpro (&Qend_of_file
);
2233 staticpro (&Qarith_error
);
2234 staticpro (&Qbeginning_of_buffer
);
2235 staticpro (&Qend_of_buffer
);
2236 staticpro (&Qbuffer_read_only
);
2237 staticpro (&Qmark_inactive
);
2239 staticpro (&Qlistp
);
2240 staticpro (&Qconsp
);
2241 staticpro (&Qsymbolp
);
2242 staticpro (&Qintegerp
);
2243 staticpro (&Qnatnump
);
2244 staticpro (&Qwholenump
);
2245 staticpro (&Qstringp
);
2246 staticpro (&Qarrayp
);
2247 staticpro (&Qsequencep
);
2248 staticpro (&Qbufferp
);
2249 staticpro (&Qvectorp
);
2250 staticpro (&Qchar_or_string_p
);
2251 staticpro (&Qmarkerp
);
2252 staticpro (&Qbuffer_or_string_p
);
2253 staticpro (&Qinteger_or_marker_p
);
2254 #ifdef LISP_FLOAT_TYPE
2255 staticpro (&Qfloatp
);
2256 staticpro (&Qnumberp
);
2257 staticpro (&Qnumber_or_marker_p
);
2258 #endif /* LISP_FLOAT_TYPE */
2260 staticpro (&Qboundp
);
2261 staticpro (&Qfboundp
);
2263 staticpro (&Qad_advice_info
);
2264 staticpro (&Qad_activate
);
2272 defsubr (&Sintegerp
);
2273 defsubr (&Sinteger_or_marker_p
);
2274 defsubr (&Snumberp
);
2275 defsubr (&Snumber_or_marker_p
);
2276 #ifdef LISP_FLOAT_TYPE
2278 #endif /* LISP_FLOAT_TYPE */
2279 defsubr (&Snatnump
);
2280 defsubr (&Ssymbolp
);
2281 defsubr (&Sstringp
);
2282 defsubr (&Svectorp
);
2284 defsubr (&Ssequencep
);
2285 defsubr (&Sbufferp
);
2286 defsubr (&Smarkerp
);
2288 defsubr (&Sbyte_code_function_p
);
2289 defsubr (&Schar_or_string_p
);
2292 defsubr (&Scar_safe
);
2293 defsubr (&Scdr_safe
);
2296 defsubr (&Ssymbol_function
);
2297 defsubr (&Sindirect_function
);
2298 defsubr (&Ssymbol_plist
);
2299 defsubr (&Ssymbol_name
);
2300 defsubr (&Smakunbound
);
2301 defsubr (&Sfmakunbound
);
2303 defsubr (&Sfboundp
);
2305 defsubr (&Sdefalias
);
2306 defsubr (&Sdefine_function
);
2307 defsubr (&Ssetplist
);
2308 defsubr (&Ssymbol_value
);
2310 defsubr (&Sdefault_boundp
);
2311 defsubr (&Sdefault_value
);
2312 defsubr (&Sset_default
);
2313 defsubr (&Ssetq_default
);
2314 defsubr (&Smake_variable_buffer_local
);
2315 defsubr (&Smake_local_variable
);
2316 defsubr (&Skill_local_variable
);
2317 defsubr (&Slocal_variable_p
);
2320 defsubr (&Snumber_to_string
);
2321 defsubr (&Sstring_to_number
);
2322 defsubr (&Seqlsign
);
2346 Fset (Qwholenump
, Qnatnump
);
2354 /* USG systems forget handlers when they are used;
2355 must reestablish each time */
2356 signal (signo
, arith_error
);
2359 /* VMS systems are like USG. */
2360 signal (signo
, arith_error
);
2364 #else /* not BSD4_1 */
2365 sigsetmask (SIGEMPTYMASK
);
2366 #endif /* not BSD4_1 */
2368 Fsignal (Qarith_error
, Qnil
);
2373 /* Don't do this if just dumping out.
2374 We don't want to call `signal' in this case
2375 so that we don't have trouble with dumping
2376 signal-delivering routines in an inconsistent state. */
2380 #endif /* CANNOT_DUMP */
2381 signal (SIGFPE
, arith_error
);
2384 signal (SIGEMT
, arith_error
);