1 /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
2 Copyright (C) 1985,86,88,93,94,95,97, 1998 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
35 #include "syssignal.h"
37 #ifdef LISP_FLOAT_TYPE
44 /* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */
45 #ifndef IEEE_FLOATING_POINT
46 #if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
47 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
48 #define IEEE_FLOATING_POINT 1
50 #define IEEE_FLOATING_POINT 0
54 /* Work around a problem that happens because math.h on hpux 7
55 defines two static variables--which, in Emacs, are not really static,
56 because `static' is defined as nothing. The problem is that they are
57 here, in floatfns.c, and in lread.c.
58 These macros prevent the name conflict. */
59 #if defined (HPUX) && !defined (HPUX8)
60 #define _MAXLDBL data_c_maxldbl
61 #define _NMAXLDBL data_c_nmaxldbl
65 #endif /* LISP_FLOAT_TYPE */
68 extern double atof ();
71 /* Nonzero means it is an error to set a symbol whose name starts with
73 int keyword_symbols_constant_flag
;
75 Lisp_Object Qnil
, Qt
, Qquote
, Qlambda
, Qsubr
, Qunbound
;
76 Lisp_Object Qerror_conditions
, Qerror_message
, Qtop_level
;
77 Lisp_Object Qerror
, Qquit
, Qwrong_type_argument
, Qargs_out_of_range
;
78 Lisp_Object Qvoid_variable
, Qvoid_function
, Qcyclic_function_indirection
;
79 Lisp_Object Qsetting_constant
, Qinvalid_read_syntax
;
80 Lisp_Object Qinvalid_function
, Qwrong_number_of_arguments
, Qno_catch
;
81 Lisp_Object Qend_of_file
, Qarith_error
, Qmark_inactive
;
82 Lisp_Object Qbeginning_of_buffer
, Qend_of_buffer
, Qbuffer_read_only
;
83 Lisp_Object Qintegerp
, Qnatnump
, Qwholenump
, Qsymbolp
, Qlistp
, Qconsp
;
84 Lisp_Object Qstringp
, Qarrayp
, Qsequencep
, Qbufferp
;
85 Lisp_Object Qchar_or_string_p
, Qmarkerp
, Qinteger_or_marker_p
, Qvectorp
;
86 Lisp_Object Qbuffer_or_string_p
;
87 Lisp_Object Qboundp
, Qfboundp
;
88 Lisp_Object Qchar_table_p
, Qvector_or_char_table_p
;
91 Lisp_Object Qad_advice_info
, Qad_activate
;
93 Lisp_Object Qrange_error
, Qdomain_error
, Qsingularity_error
;
94 Lisp_Object Qoverflow_error
, Qunderflow_error
;
96 #ifdef LISP_FLOAT_TYPE
98 Lisp_Object Qnumberp
, Qnumber_or_marker_p
;
101 static Lisp_Object Qinteger
, Qsymbol
, Qstring
, Qcons
, Qmarker
, Qoverlay
;
102 static Lisp_Object Qfloat
, Qwindow_configuration
, Qwindow
;
103 Lisp_Object Qprocess
;
104 static Lisp_Object Qcompiled_function
, Qbuffer
, Qframe
, Qvector
;
105 static Lisp_Object Qchar_table
, Qbool_vector
;
107 static Lisp_Object
swap_in_symval_forwarding ();
109 Lisp_Object
set_internal ();
112 wrong_type_argument (predicate
, value
)
113 register Lisp_Object predicate
, value
;
115 register Lisp_Object tem
;
118 if (!EQ (Vmocklisp_arguments
, Qt
))
120 if (STRINGP (value
) &&
121 (EQ (predicate
, Qintegerp
) || EQ (predicate
, Qinteger_or_marker_p
)))
122 return Fstring_to_number (value
, Qnil
);
123 if (INTEGERP (value
) && EQ (predicate
, Qstringp
))
124 return Fnumber_to_string (value
);
127 /* If VALUE is not even a valid Lisp object, abort here
128 where we can get a backtrace showing where it came from. */
129 if ((unsigned int) XGCTYPE (value
) >= Lisp_Type_Limit
)
132 value
= Fsignal (Qwrong_type_argument
, Fcons (predicate
, Fcons (value
, Qnil
)));
133 tem
= call1 (predicate
, value
);
142 error ("Attempt to modify read-only object");
146 args_out_of_range (a1
, a2
)
150 Fsignal (Qargs_out_of_range
, Fcons (a1
, Fcons (a2
, Qnil
)));
154 args_out_of_range_3 (a1
, a2
, a3
)
155 Lisp_Object a1
, a2
, a3
;
158 Fsignal (Qargs_out_of_range
, Fcons (a1
, Fcons (a2
, Fcons (a3
, Qnil
))));
161 /* On some machines, XINT needs a temporary location.
162 Here it is, in case it is needed. */
164 int sign_extend_temp
;
166 /* On a few machines, XINT can only be done by calling this. */
169 sign_extend_lisp_int (num
)
172 if (num
& (((EMACS_INT
) 1) << (VALBITS
- 1)))
173 return num
| (((EMACS_INT
) (-1)) << VALBITS
);
175 return num
& ((((EMACS_INT
) 1) << VALBITS
) - 1);
178 /* Data type predicates */
180 DEFUN ("eq", Feq
, Seq
, 2, 2, 0,
181 "Return t if the two args are the same Lisp object.")
183 Lisp_Object obj1
, obj2
;
190 DEFUN ("null", Fnull
, Snull
, 1, 1, 0, "Return t if OBJECT is nil.")
199 DEFUN ("type-of", Ftype_of
, Stype_of
, 1, 1, 0,
200 "Return a symbol representing the type of OBJECT.\n\
201 The symbol returned names the object's basic type;\n\
202 for example, (type-of 1) returns `integer'.")
206 switch (XGCTYPE (object
))
221 switch (XMISCTYPE (object
))
223 case Lisp_Misc_Marker
:
225 case Lisp_Misc_Overlay
:
227 case Lisp_Misc_Float
:
232 case Lisp_Vectorlike
:
233 if (GC_WINDOW_CONFIGURATIONP (object
))
234 return Qwindow_configuration
;
235 if (GC_PROCESSP (object
))
237 if (GC_WINDOWP (object
))
239 if (GC_SUBRP (object
))
241 if (GC_COMPILEDP (object
))
242 return Qcompiled_function
;
243 if (GC_BUFFERP (object
))
245 if (GC_CHAR_TABLE_P (object
))
247 if (GC_BOOL_VECTOR_P (object
))
249 if (GC_FRAMEP (object
))
253 #ifdef LISP_FLOAT_TYPE
263 DEFUN ("consp", Fconsp
, Sconsp
, 1, 1, 0, "Return t if OBJECT is a cons cell.")
272 DEFUN ("atom", Fatom
, Satom
, 1, 1, 0,
273 "Return t if OBJECT is not a cons cell. This includes nil.")
282 DEFUN ("listp", Flistp
, Slistp
, 1, 1, 0,
283 "Return t if OBJECT is a list. This includes nil.")
287 if (CONSP (object
) || NILP (object
))
292 DEFUN ("nlistp", Fnlistp
, Snlistp
, 1, 1, 0,
293 "Return t if OBJECT is not a list. Lists include nil.")
297 if (CONSP (object
) || NILP (object
))
302 DEFUN ("symbolp", Fsymbolp
, Ssymbolp
, 1, 1, 0,
303 "Return t if OBJECT is a symbol.")
307 if (SYMBOLP (object
))
312 DEFUN ("vectorp", Fvectorp
, Svectorp
, 1, 1, 0,
313 "Return t if OBJECT is a vector.")
317 if (VECTORP (object
))
322 DEFUN ("stringp", Fstringp
, Sstringp
, 1, 1, 0,
323 "Return t if OBJECT is a string.")
327 if (STRINGP (object
))
332 DEFUN ("multibyte-string-p", Fmultibyte_string_p
, Smultibyte_string_p
,
333 1, 1, 0, "Return t if OBJECT is a multibyte string.")
337 if (STRINGP (object
) && STRING_MULTIBYTE (object
))
342 DEFUN ("char-table-p", Fchar_table_p
, Schar_table_p
, 1, 1, 0,
343 "Return t if OBJECT is a char-table.")
347 if (CHAR_TABLE_P (object
))
352 DEFUN ("vector-or-char-table-p", Fvector_or_char_table_p
,
353 Svector_or_char_table_p
, 1, 1, 0,
354 "Return t if OBJECT is a char-table or vector.")
358 if (VECTORP (object
) || CHAR_TABLE_P (object
))
363 DEFUN ("bool-vector-p", Fbool_vector_p
, Sbool_vector_p
, 1, 1, 0, "Return t if OBJECT is a bool-vector.")
367 if (BOOL_VECTOR_P (object
))
372 DEFUN ("arrayp", Farrayp
, Sarrayp
, 1, 1, 0, "Return t if OBJECT is an array (string or vector).")
376 if (VECTORP (object
) || STRINGP (object
)
377 || CHAR_TABLE_P (object
) || BOOL_VECTOR_P (object
))
382 DEFUN ("sequencep", Fsequencep
, Ssequencep
, 1, 1, 0,
383 "Return t if OBJECT is a sequence (list or array).")
385 register Lisp_Object object
;
387 if (CONSP (object
) || NILP (object
) || VECTORP (object
) || STRINGP (object
)
388 || CHAR_TABLE_P (object
) || BOOL_VECTOR_P (object
))
393 DEFUN ("bufferp", Fbufferp
, Sbufferp
, 1, 1, 0, "Return t if OBJECT is an editor buffer.")
397 if (BUFFERP (object
))
402 DEFUN ("markerp", Fmarkerp
, Smarkerp
, 1, 1, 0, "Return t if OBJECT is a marker (editor pointer).")
406 if (MARKERP (object
))
411 DEFUN ("subrp", Fsubrp
, Ssubrp
, 1, 1, 0, "Return t if OBJECT is a built-in function.")
420 DEFUN ("byte-code-function-p", Fbyte_code_function_p
, Sbyte_code_function_p
,
421 1, 1, 0, "Return t if OBJECT is a byte-compiled function object.")
425 if (COMPILEDP (object
))
430 DEFUN ("char-or-string-p", Fchar_or_string_p
, Schar_or_string_p
, 1, 1, 0,
431 "Return t if OBJECT is a character (an integer) or a string.")
433 register Lisp_Object object
;
435 if (INTEGERP (object
) || STRINGP (object
))
440 DEFUN ("integerp", Fintegerp
, Sintegerp
, 1, 1, 0, "Return t if OBJECT is an integer.")
444 if (INTEGERP (object
))
449 DEFUN ("integer-or-marker-p", Finteger_or_marker_p
, Sinteger_or_marker_p
, 1, 1, 0,
450 "Return t if OBJECT is an integer or a marker (editor pointer).")
452 register Lisp_Object object
;
454 if (MARKERP (object
) || INTEGERP (object
))
459 DEFUN ("natnump", Fnatnump
, Snatnump
, 1, 1, 0,
460 "Return t if OBJECT is a nonnegative integer.")
464 if (NATNUMP (object
))
469 DEFUN ("numberp", Fnumberp
, Snumberp
, 1, 1, 0,
470 "Return t if OBJECT is a number (floating point or integer).")
474 if (NUMBERP (object
))
480 DEFUN ("number-or-marker-p", Fnumber_or_marker_p
,
481 Snumber_or_marker_p
, 1, 1, 0,
482 "Return t if OBJECT is a number or a marker.")
486 if (NUMBERP (object
) || MARKERP (object
))
491 #ifdef LISP_FLOAT_TYPE
492 DEFUN ("floatp", Ffloatp
, Sfloatp
, 1, 1, 0,
493 "Return t if OBJECT is a floating point number.")
501 #endif /* LISP_FLOAT_TYPE */
503 /* Extract and set components of lists */
505 DEFUN ("car", Fcar
, Scar
, 1, 1, 0,
506 "Return the car of LIST. If arg is nil, return nil.\n\
507 Error if arg is not nil and not a cons cell. See also `car-safe'.")
509 register Lisp_Object list
;
514 return XCONS (list
)->car
;
515 else if (EQ (list
, Qnil
))
518 list
= wrong_type_argument (Qlistp
, list
);
522 DEFUN ("car-safe", Fcar_safe
, Scar_safe
, 1, 1, 0,
523 "Return the car of OBJECT if it is a cons cell, or else nil.")
528 return XCONS (object
)->car
;
533 DEFUN ("cdr", Fcdr
, Scdr
, 1, 1, 0,
534 "Return the cdr of LIST. If arg is nil, return nil.\n\
535 Error if arg is not nil and not a cons cell. See also `cdr-safe'.")
538 register Lisp_Object list
;
543 return XCONS (list
)->cdr
;
544 else if (EQ (list
, Qnil
))
547 list
= wrong_type_argument (Qlistp
, list
);
551 DEFUN ("cdr-safe", Fcdr_safe
, Scdr_safe
, 1, 1, 0,
552 "Return the cdr of OBJECT if it is a cons cell, or else nil.")
557 return XCONS (object
)->cdr
;
562 DEFUN ("setcar", Fsetcar
, Ssetcar
, 2, 2, 0,
563 "Set the car of CELL to be NEWCAR. Returns NEWCAR.")
565 register Lisp_Object cell
, newcar
;
568 cell
= wrong_type_argument (Qconsp
, cell
);
571 XCONS (cell
)->car
= newcar
;
575 DEFUN ("setcdr", Fsetcdr
, Ssetcdr
, 2, 2, 0,
576 "Set the cdr of CELL to be NEWCDR. Returns NEWCDR.")
578 register Lisp_Object cell
, newcdr
;
581 cell
= wrong_type_argument (Qconsp
, cell
);
584 XCONS (cell
)->cdr
= newcdr
;
588 /* Extract and set components of symbols */
590 DEFUN ("boundp", Fboundp
, Sboundp
, 1, 1, 0, "Return t if SYMBOL's value is not void.")
592 register Lisp_Object symbol
;
594 Lisp_Object valcontents
;
595 CHECK_SYMBOL (symbol
, 0);
597 valcontents
= XSYMBOL (symbol
)->value
;
599 if (BUFFER_LOCAL_VALUEP (valcontents
)
600 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
601 valcontents
= swap_in_symval_forwarding (symbol
, valcontents
);
603 return (EQ (valcontents
, Qunbound
) ? Qnil
: Qt
);
606 DEFUN ("fboundp", Ffboundp
, Sfboundp
, 1, 1, 0, "Return t if SYMBOL's function definition is not void.")
608 register Lisp_Object symbol
;
610 CHECK_SYMBOL (symbol
, 0);
611 return (EQ (XSYMBOL (symbol
)->function
, Qunbound
) ? Qnil
: Qt
);
614 DEFUN ("makunbound", Fmakunbound
, Smakunbound
, 1, 1, 0, "Make SYMBOL's value be void.")
616 register Lisp_Object symbol
;
618 CHECK_SYMBOL (symbol
, 0);
619 if (NILP (symbol
) || EQ (symbol
, Qt
)
620 || (XSYMBOL (symbol
)->name
->data
[0] == ':'
621 && EQ (XSYMBOL (symbol
)->obarray
, initial_obarray
)
622 && keyword_symbols_constant_flag
))
623 return Fsignal (Qsetting_constant
, Fcons (symbol
, Qnil
));
624 Fset (symbol
, Qunbound
);
628 DEFUN ("fmakunbound", Ffmakunbound
, Sfmakunbound
, 1, 1, 0, "Make SYMBOL's function definition be void.")
630 register Lisp_Object symbol
;
632 CHECK_SYMBOL (symbol
, 0);
633 if (NILP (symbol
) || EQ (symbol
, Qt
))
634 return Fsignal (Qsetting_constant
, Fcons (symbol
, Qnil
));
635 XSYMBOL (symbol
)->function
= Qunbound
;
639 DEFUN ("symbol-function", Fsymbol_function
, Ssymbol_function
, 1, 1, 0,
640 "Return SYMBOL's function definition. Error if that is void.")
642 register Lisp_Object symbol
;
644 CHECK_SYMBOL (symbol
, 0);
645 if (EQ (XSYMBOL (symbol
)->function
, Qunbound
))
646 return Fsignal (Qvoid_function
, Fcons (symbol
, Qnil
));
647 return XSYMBOL (symbol
)->function
;
650 DEFUN ("symbol-plist", Fsymbol_plist
, Ssymbol_plist
, 1, 1, 0, "Return SYMBOL's property list.")
652 register Lisp_Object symbol
;
654 CHECK_SYMBOL (symbol
, 0);
655 return XSYMBOL (symbol
)->plist
;
658 DEFUN ("symbol-name", Fsymbol_name
, Ssymbol_name
, 1, 1, 0, "Return SYMBOL's name, a string.")
660 register Lisp_Object symbol
;
662 register Lisp_Object name
;
664 CHECK_SYMBOL (symbol
, 0);
665 XSETSTRING (name
, XSYMBOL (symbol
)->name
);
669 DEFUN ("fset", Ffset
, Sfset
, 2, 2, 0,
670 "Set SYMBOL's function definition to DEFINITION, and return DEFINITION.")
672 register Lisp_Object symbol
, definition
;
674 CHECK_SYMBOL (symbol
, 0);
675 if (NILP (symbol
) || EQ (symbol
, Qt
))
676 return Fsignal (Qsetting_constant
, Fcons (symbol
, Qnil
));
677 if (!NILP (Vautoload_queue
) && !EQ (XSYMBOL (symbol
)->function
, Qunbound
))
678 Vautoload_queue
= Fcons (Fcons (symbol
, XSYMBOL (symbol
)->function
),
680 XSYMBOL (symbol
)->function
= definition
;
681 /* Handle automatic advice activation */
682 if (CONSP (XSYMBOL (symbol
)->plist
) && !NILP (Fget (symbol
, Qad_advice_info
)))
684 call2 (Qad_activate
, symbol
, Qnil
);
685 definition
= XSYMBOL (symbol
)->function
;
690 DEFUN ("defalias", Fdefalias
, Sdefalias
, 2, 2, 0,
691 "Set SYMBOL's function definition to DEFINITION, and return DEFINITION.\n\
692 Associates the function with the current load file, if any.")
694 register Lisp_Object symbol
, definition
;
696 CHECK_SYMBOL (symbol
, 0);
697 if (!NILP (Vautoload_queue
) && !EQ (XSYMBOL (symbol
)->function
, Qunbound
))
698 Vautoload_queue
= Fcons (Fcons (symbol
, XSYMBOL (symbol
)->function
),
700 XSYMBOL (symbol
)->function
= definition
;
701 /* Handle automatic advice activation */
702 if (CONSP (XSYMBOL (symbol
)->plist
) && !NILP (Fget (symbol
, Qad_advice_info
)))
704 call2 (Qad_activate
, symbol
, Qnil
);
705 definition
= XSYMBOL (symbol
)->function
;
707 LOADHIST_ATTACH (symbol
);
711 DEFUN ("setplist", Fsetplist
, Ssetplist
, 2, 2, 0,
712 "Set SYMBOL's property list to NEWVAL, and return NEWVAL.")
714 register Lisp_Object symbol
, newplist
;
716 CHECK_SYMBOL (symbol
, 0);
717 XSYMBOL (symbol
)->plist
= newplist
;
722 /* Getting and setting values of symbols */
724 /* Given the raw contents of a symbol value cell,
725 return the Lisp value of the symbol.
726 This does not handle buffer-local variables; use
727 swap_in_symval_forwarding for that. */
730 do_symval_forwarding (valcontents
)
731 register Lisp_Object valcontents
;
733 register Lisp_Object val
;
735 if (MISCP (valcontents
))
736 switch (XMISCTYPE (valcontents
))
738 case Lisp_Misc_Intfwd
:
739 XSETINT (val
, *XINTFWD (valcontents
)->intvar
);
742 case Lisp_Misc_Boolfwd
:
743 return (*XBOOLFWD (valcontents
)->boolvar
? Qt
: Qnil
);
745 case Lisp_Misc_Objfwd
:
746 return *XOBJFWD (valcontents
)->objvar
;
748 case Lisp_Misc_Buffer_Objfwd
:
749 offset
= XBUFFER_OBJFWD (valcontents
)->offset
;
750 return *(Lisp_Object
*)(offset
+ (char *)current_buffer
);
752 case Lisp_Misc_Kboard_Objfwd
:
753 offset
= XKBOARD_OBJFWD (valcontents
)->offset
;
754 return *(Lisp_Object
*)(offset
+ (char *)current_kboard
);
759 /* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell
760 of SYMBOL. If SYMBOL is buffer-local, VALCONTENTS should be the
761 buffer-independent contents of the value cell: forwarded just one
762 step past the buffer-localness. */
765 store_symval_forwarding (symbol
, valcontents
, newval
)
767 register Lisp_Object valcontents
, newval
;
769 switch (SWITCH_ENUM_CAST (XTYPE (valcontents
)))
772 switch (XMISCTYPE (valcontents
))
774 case Lisp_Misc_Intfwd
:
775 CHECK_NUMBER (newval
, 1);
776 *XINTFWD (valcontents
)->intvar
= XINT (newval
);
777 if (*XINTFWD (valcontents
)->intvar
!= XINT (newval
))
778 error ("Value out of range for variable `%s'",
779 XSYMBOL (symbol
)->name
->data
);
782 case Lisp_Misc_Boolfwd
:
783 *XBOOLFWD (valcontents
)->boolvar
= NILP (newval
) ? 0 : 1;
786 case Lisp_Misc_Objfwd
:
787 *XOBJFWD (valcontents
)->objvar
= newval
;
790 case Lisp_Misc_Buffer_Objfwd
:
792 int offset
= XBUFFER_OBJFWD (valcontents
)->offset
;
795 type
= *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
);
796 if (XINT (type
) == -1)
797 error ("Variable %s is read-only", XSYMBOL (symbol
)->name
->data
);
799 if (! NILP (type
) && ! NILP (newval
)
800 && XTYPE (newval
) != XINT (type
))
801 buffer_slot_type_mismatch (offset
);
803 *(Lisp_Object
*)(offset
+ (char *)current_buffer
) = newval
;
807 case Lisp_Misc_Kboard_Objfwd
:
808 (*(Lisp_Object
*)((char *)current_kboard
809 + XKBOARD_OBJFWD (valcontents
)->offset
))
820 valcontents
= XSYMBOL (symbol
)->value
;
821 if (BUFFER_LOCAL_VALUEP (valcontents
)
822 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
823 XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
= newval
;
825 XSYMBOL (symbol
)->value
= newval
;
829 /* Set up the buffer-local symbol SYMBOL for validity in the current
830 buffer. VALCONTENTS is the contents of its value cell.
831 Return the value forwarded one step past the buffer-local indicator. */
834 swap_in_symval_forwarding (symbol
, valcontents
)
835 Lisp_Object symbol
, valcontents
;
837 /* valcontents is a pointer to a struct resembling the cons
838 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)).
840 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
841 local_var_alist, that being the element whose car is this
842 variable. Or it can be a pointer to the
843 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not have
844 an element in its alist for this variable.
846 If the current buffer is not BUFFER, we store the current
847 REALVALUE value into CURRENT-ALIST-ELEMENT, then find the
848 appropriate alist element for the buffer now current and set up
849 CURRENT-ALIST-ELEMENT. Then we set REALVALUE out of that
850 element, and store into BUFFER.
852 Note that REALVALUE can be a forwarding pointer. */
854 register Lisp_Object tem1
;
855 tem1
= XBUFFER_LOCAL_VALUE (valcontents
)->buffer
;
857 if (NILP (tem1
) || current_buffer
!= XBUFFER (tem1
)
858 || selected_frame
!= XFRAME (XBUFFER_LOCAL_VALUE (valcontents
)->frame
))
860 tem1
= XCONS (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
)->car
;
862 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
));
863 tem1
= assq_no_quit (symbol
, current_buffer
->local_var_alist
);
864 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 0;
865 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
868 if (XBUFFER_LOCAL_VALUE (valcontents
)->check_frame
)
869 tem1
= assq_no_quit (symbol
, selected_frame
->param_alist
);
871 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 1;
873 tem1
= XBUFFER_LOCAL_VALUE (valcontents
)->cdr
;
876 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 1;
878 XCONS (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
)->car
= tem1
;
879 XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents
)->buffer
, current_buffer
);
880 XSETFRAME (XBUFFER_LOCAL_VALUE (valcontents
)->frame
, selected_frame
);
881 store_symval_forwarding (symbol
,
882 XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
,
885 return XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
;
888 /* Find the value of a symbol, returning Qunbound if it's not bound.
889 This is helpful for code which just wants to get a variable's value
890 if it has one, without signaling an error.
891 Note that it must not be possible to quit
892 within this function. Great care is required for this. */
895 find_symbol_value (symbol
)
898 register Lisp_Object valcontents
, tem1
;
899 register Lisp_Object val
;
900 CHECK_SYMBOL (symbol
, 0);
901 valcontents
= XSYMBOL (symbol
)->value
;
903 if (BUFFER_LOCAL_VALUEP (valcontents
)
904 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
905 valcontents
= swap_in_symval_forwarding (symbol
, valcontents
);
907 if (MISCP (valcontents
))
909 switch (XMISCTYPE (valcontents
))
911 case Lisp_Misc_Intfwd
:
912 XSETINT (val
, *XINTFWD (valcontents
)->intvar
);
915 case Lisp_Misc_Boolfwd
:
916 return (*XBOOLFWD (valcontents
)->boolvar
? Qt
: Qnil
);
918 case Lisp_Misc_Objfwd
:
919 return *XOBJFWD (valcontents
)->objvar
;
921 case Lisp_Misc_Buffer_Objfwd
:
922 return *(Lisp_Object
*)(XBUFFER_OBJFWD (valcontents
)->offset
923 + (char *)current_buffer
);
925 case Lisp_Misc_Kboard_Objfwd
:
926 return *(Lisp_Object
*)(XKBOARD_OBJFWD (valcontents
)->offset
927 + (char *)current_kboard
);
934 DEFUN ("symbol-value", Fsymbol_value
, Ssymbol_value
, 1, 1, 0,
935 "Return SYMBOL's value. Error if that is void.")
941 val
= find_symbol_value (symbol
);
942 if (EQ (val
, Qunbound
))
943 return Fsignal (Qvoid_variable
, Fcons (symbol
, Qnil
));
948 DEFUN ("set", Fset
, Sset
, 2, 2, 0,
949 "Set SYMBOL's value to NEWVAL, and return NEWVAL.")
951 register Lisp_Object symbol
, newval
;
953 return set_internal (symbol
, newval
, 0);
956 /* Store the value NEWVAL into SYMBOL.
957 If BINDFLAG is zero, then if this symbol is supposed to become
958 local in every buffer where it is set, then we make it local.
959 If BINDFLAG is nonzero, we don't do that. */
962 set_internal (symbol
, newval
, bindflag
)
963 register Lisp_Object symbol
, newval
;
966 int voide
= EQ (newval
, Qunbound
);
968 register Lisp_Object valcontents
, tem1
, current_alist_element
;
970 CHECK_SYMBOL (symbol
, 0);
971 if (NILP (symbol
) || EQ (symbol
, Qt
)
972 || (XSYMBOL (symbol
)->name
->data
[0] == ':'
973 && EQ (XSYMBOL (symbol
)->obarray
, initial_obarray
)
974 && keyword_symbols_constant_flag
&& ! EQ (newval
, symbol
)))
975 return Fsignal (Qsetting_constant
, Fcons (symbol
, Qnil
));
976 valcontents
= XSYMBOL (symbol
)->value
;
978 if (BUFFER_OBJFWDP (valcontents
))
980 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
981 register int mask
= XINT (*((Lisp_Object
*)
982 (idx
+ (char *)&buffer_local_flags
)));
984 current_buffer
->local_var_flags
|= mask
;
987 else if (BUFFER_LOCAL_VALUEP (valcontents
)
988 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
990 /* valcontents is actually a pointer to a struct resembling a cons,
991 with contents something like:
992 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE).
994 BUFFER is the last buffer for which this symbol's value was
997 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
998 local_var_alist, that being the element whose car is this
999 variable. Or it can be a pointer to the
1000 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not
1001 have an element in its alist for this variable (that is, if
1002 BUFFER sees the default value of this variable).
1004 If we want to examine or set the value and BUFFER is current,
1005 we just examine or set REALVALUE. If BUFFER is not current, we
1006 store the current REALVALUE value into CURRENT-ALIST-ELEMENT,
1007 then find the appropriate alist element for the buffer now
1008 current and set up CURRENT-ALIST-ELEMENT. Then we set
1009 REALVALUE out of that element, and store into BUFFER.
1011 If we are setting the variable and the current buffer does
1012 not have an alist entry for this variable, an alist entry is
1015 Note that REALVALUE can be a forwarding pointer. Each time
1016 it is examined or set, forwarding must be done. */
1018 /* What value are we caching right now? */
1019 current_alist_element
1020 = XCONS (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
)->car
;
1022 /* If the current buffer is not the buffer whose binding is
1023 currently cached, or if it's a Lisp_Buffer_Local_Value and
1024 we're looking at the default value, the cache is invalid; we
1025 need to write it out, and find the new CURRENT-ALIST-ELEMENT. */
1026 if (current_buffer
!= XBUFFER (XBUFFER_LOCAL_VALUE (valcontents
)->buffer
)
1028 selected_frame
!= XFRAME (XBUFFER_LOCAL_VALUE (valcontents
)->frame
)
1029 || (BUFFER_LOCAL_VALUEP (valcontents
)
1030 && EQ (XCONS (current_alist_element
)->car
,
1031 current_alist_element
)))
1033 /* Write out the cached value for the old buffer; copy it
1034 back to its alist element. This works if the current
1035 buffer only sees the default value, too. */
1036 Fsetcdr (current_alist_element
,
1037 do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
));
1039 /* Find the new value for CURRENT-ALIST-ELEMENT. */
1040 tem1
= Fassq (symbol
, current_buffer
->local_var_alist
);
1041 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 1;
1042 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 0;
1046 /* This buffer still sees the default value. */
1048 /* If the variable is a Lisp_Some_Buffer_Local_Value,
1049 or if this is `let' rather than `set',
1050 make CURRENT-ALIST-ELEMENT point to itself,
1051 indicating that we're seeing the default value. */
1052 if (bindflag
|| SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1054 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
1056 if (XBUFFER_LOCAL_VALUE (valcontents
)->check_frame
)
1057 tem1
= Fassq (symbol
, selected_frame
->param_alist
);
1060 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_frame
= 1;
1062 tem1
= XBUFFER_LOCAL_VALUE (valcontents
)->cdr
;
1064 /* If it's a Lisp_Buffer_Local_Value, being set not bound,
1065 give this buffer a new assoc for a local value and set
1066 CURRENT-ALIST-ELEMENT to point to that. */
1069 tem1
= Fcons (symbol
, Fcdr (current_alist_element
));
1070 current_buffer
->local_var_alist
1071 = Fcons (tem1
, current_buffer
->local_var_alist
);
1075 /* Cache the new buffer's assoc in CURRENT-ALIST-ELEMENT. */
1076 XCONS (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
)->car
1079 /* Set BUFFER and FRAME for binding now loaded. */
1080 XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents
)->buffer
,
1082 XSETFRAME (XBUFFER_LOCAL_VALUE (valcontents
)->frame
,
1085 valcontents
= XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
;
1088 /* If storing void (making the symbol void), forward only through
1089 buffer-local indicator, not through Lisp_Objfwd, etc. */
1091 store_symval_forwarding (symbol
, Qnil
, newval
);
1093 store_symval_forwarding (symbol
, valcontents
, newval
);
1098 /* Access or set a buffer-local symbol's default value. */
1100 /* Return the default value of SYMBOL, but don't check for voidness.
1101 Return Qunbound if it is void. */
1104 default_value (symbol
)
1107 register Lisp_Object valcontents
;
1109 CHECK_SYMBOL (symbol
, 0);
1110 valcontents
= XSYMBOL (symbol
)->value
;
1112 /* For a built-in buffer-local variable, get the default value
1113 rather than letting do_symval_forwarding get the current value. */
1114 if (BUFFER_OBJFWDP (valcontents
))
1116 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1118 if (XINT (*(Lisp_Object
*) (idx
+ (char *) &buffer_local_flags
)) != 0)
1119 return *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
1122 /* Handle user-created local variables. */
1123 if (BUFFER_LOCAL_VALUEP (valcontents
)
1124 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1126 /* If var is set up for a buffer that lacks a local value for it,
1127 the current value is nominally the default value.
1128 But the current value slot may be more up to date, since
1129 ordinary setq stores just that slot. So use that. */
1130 Lisp_Object current_alist_element
, alist_element_car
;
1131 current_alist_element
1132 = XCONS (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
)->car
;
1133 alist_element_car
= XCONS (current_alist_element
)->car
;
1134 if (EQ (alist_element_car
, current_alist_element
))
1135 return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
);
1137 return XCONS (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
)->cdr
;
1139 /* For other variables, get the current value. */
1140 return do_symval_forwarding (valcontents
);
1143 DEFUN ("default-boundp", Fdefault_boundp
, Sdefault_boundp
, 1, 1, 0,
1144 "Return t if SYMBOL has a non-void default value.\n\
1145 This is the value that is seen in buffers that do not have their own values\n\
1146 for this variable.")
1150 register Lisp_Object value
;
1152 value
= default_value (symbol
);
1153 return (EQ (value
, Qunbound
) ? Qnil
: Qt
);
1156 DEFUN ("default-value", Fdefault_value
, Sdefault_value
, 1, 1, 0,
1157 "Return SYMBOL's default value.\n\
1158 This is the value that is seen in buffers that do not have their own values\n\
1159 for this variable. The default value is meaningful for variables with\n\
1160 local bindings in certain buffers.")
1164 register Lisp_Object value
;
1166 value
= default_value (symbol
);
1167 if (EQ (value
, Qunbound
))
1168 return Fsignal (Qvoid_variable
, Fcons (symbol
, Qnil
));
1172 DEFUN ("set-default", Fset_default
, Sset_default
, 2, 2, 0,
1173 "Set SYMBOL's default value to VAL. SYMBOL and VAL are evaluated.\n\
1174 The default value is seen in buffers that do not have their own values\n\
1175 for this variable.")
1177 Lisp_Object symbol
, value
;
1179 register Lisp_Object valcontents
, current_alist_element
, alist_element_buffer
;
1181 CHECK_SYMBOL (symbol
, 0);
1182 valcontents
= XSYMBOL (symbol
)->value
;
1184 /* Handle variables like case-fold-search that have special slots
1185 in the buffer. Make them work apparently like Lisp_Buffer_Local_Value
1187 if (BUFFER_OBJFWDP (valcontents
))
1189 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1190 register struct buffer
*b
;
1191 register int mask
= XINT (*((Lisp_Object
*)
1192 (idx
+ (char *)&buffer_local_flags
)));
1194 *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
) = value
;
1196 /* If this variable is not always local in all buffers,
1197 set it in the buffers that don't nominally have a local value. */
1200 for (b
= all_buffers
; b
; b
= b
->next
)
1201 if (!(b
->local_var_flags
& mask
))
1202 *(Lisp_Object
*)(idx
+ (char *) b
) = value
;
1207 if (!BUFFER_LOCAL_VALUEP (valcontents
)
1208 && !SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1209 return Fset (symbol
, value
);
1211 /* Store new value into the DEFAULT-VALUE slot */
1212 XCONS (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
)->cdr
= value
;
1214 /* If that slot is current, we must set the REALVALUE slot too */
1215 current_alist_element
1216 = XCONS (XBUFFER_LOCAL_VALUE (valcontents
)->cdr
)->car
;
1217 alist_element_buffer
= Fcar (current_alist_element
);
1218 if (EQ (alist_element_buffer
, current_alist_element
))
1219 store_symval_forwarding (symbol
, XBUFFER_LOCAL_VALUE (valcontents
)->realvalue
,
1225 DEFUN ("setq-default", Fsetq_default
, Ssetq_default
, 2, UNEVALLED
, 0,
1226 "Set the default value of variable VAR to VALUE.\n\
1227 VAR, the variable name, is literal (not evaluated);\n\
1228 VALUE is an expression and it is evaluated.\n\
1229 The default value of a variable is seen in buffers\n\
1230 that do not have their own values for the variable.\n\
1232 More generally, you can use multiple variables and values, as in\n\
1233 (setq-default SYMBOL VALUE SYMBOL VALUE...)\n\
1234 This sets each SYMBOL's default value to the corresponding VALUE.\n\
1235 The VALUE for the Nth SYMBOL can refer to the new default values\n\
1240 register Lisp_Object args_left
;
1241 register Lisp_Object val
, symbol
;
1242 struct gcpro gcpro1
;
1252 val
= Feval (Fcar (Fcdr (args_left
)));
1253 symbol
= Fcar (args_left
);
1254 Fset_default (symbol
, val
);
1255 args_left
= Fcdr (Fcdr (args_left
));
1257 while (!NILP (args_left
));
1263 /* Lisp functions for creating and removing buffer-local variables. */
1265 DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local
, Smake_variable_buffer_local
,
1266 1, 1, "vMake Variable Buffer Local: ",
1267 "Make VARIABLE have a separate value for each buffer.\n\
1268 At any time, the value for the current buffer is in effect.\n\
1269 There is also a default value which is seen in any buffer which has not yet\n\
1270 set its own value.\n\
1271 Using `set' or `setq' to set the variable causes it to have a separate value\n\
1272 for the current buffer if it was previously using the default value.\n\
1273 The function `default-value' gets the default value and `set-default' sets it.")
1275 register Lisp_Object variable
;
1277 register Lisp_Object tem
, valcontents
, newval
;
1279 CHECK_SYMBOL (variable
, 0);
1281 valcontents
= XSYMBOL (variable
)->value
;
1282 if (EQ (variable
, Qnil
) || EQ (variable
, Qt
) || KBOARD_OBJFWDP (valcontents
))
1283 error ("Symbol %s may not be buffer-local", XSYMBOL (variable
)->name
->data
);
1285 if (BUFFER_LOCAL_VALUEP (valcontents
) || BUFFER_OBJFWDP (valcontents
))
1287 if (SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1289 XMISCTYPE (XSYMBOL (variable
)->value
) = Lisp_Misc_Buffer_Local_Value
;
1292 if (EQ (valcontents
, Qunbound
))
1293 XSYMBOL (variable
)->value
= Qnil
;
1294 tem
= Fcons (Qnil
, Fsymbol_value (variable
));
1295 XCONS (tem
)->car
= tem
;
1296 newval
= allocate_misc ();
1297 XMISCTYPE (newval
) = Lisp_Misc_Buffer_Local_Value
;
1298 XBUFFER_LOCAL_VALUE (newval
)->realvalue
= XSYMBOL (variable
)->value
;
1299 XBUFFER_LOCAL_VALUE (newval
)->buffer
= Fcurrent_buffer ();
1300 XBUFFER_LOCAL_VALUE (newval
)->frame
= Qnil
;
1301 XBUFFER_LOCAL_VALUE (newval
)->found_for_buffer
= 1;
1302 XBUFFER_LOCAL_VALUE (newval
)->found_for_frame
= 0;
1303 XBUFFER_LOCAL_VALUE (newval
)->check_frame
= 0;
1304 XBUFFER_LOCAL_VALUE (newval
)->cdr
= tem
;
1305 XSYMBOL (variable
)->value
= newval
;
1309 DEFUN ("make-local-variable", Fmake_local_variable
, Smake_local_variable
,
1310 1, 1, "vMake Local Variable: ",
1311 "Make VARIABLE have a separate value in the current buffer.\n\
1312 Other buffers will continue to share a common default value.\n\
1313 \(The buffer-local value of VARIABLE starts out as the same value\n\
1314 VARIABLE previously had. If VARIABLE was void, it remains void.\)\n\
1315 See also `make-variable-buffer-local'.\n\n\
1316 If the variable is already arranged to become local when set,\n\
1317 this function causes a local value to exist for this buffer,\n\
1318 just as setting the variable would do.\n\
1320 Do not use `make-local-variable' to make a hook variable buffer-local.\n\
1321 Use `make-local-hook' instead.")
1323 register Lisp_Object variable
;
1325 register Lisp_Object tem
, valcontents
;
1327 CHECK_SYMBOL (variable
, 0);
1329 valcontents
= XSYMBOL (variable
)->value
;
1330 if (EQ (variable
, Qnil
) || EQ (variable
, Qt
) || KBOARD_OBJFWDP (valcontents
))
1331 error ("Symbol %s may not be buffer-local", XSYMBOL (variable
)->name
->data
);
1333 if (BUFFER_LOCAL_VALUEP (valcontents
) || BUFFER_OBJFWDP (valcontents
))
1335 tem
= Fboundp (variable
);
1337 /* Make sure the symbol has a local value in this particular buffer,
1338 by setting it to the same value it already has. */
1339 Fset (variable
, (EQ (tem
, Qt
) ? Fsymbol_value (variable
) : Qunbound
));
1342 /* Make sure symbol is set up to hold per-buffer values */
1343 if (!SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1346 tem
= Fcons (Qnil
, do_symval_forwarding (valcontents
));
1347 XCONS (tem
)->car
= tem
;
1348 newval
= allocate_misc ();
1349 XMISCTYPE (newval
) = Lisp_Misc_Some_Buffer_Local_Value
;
1350 XBUFFER_LOCAL_VALUE (newval
)->realvalue
= XSYMBOL (variable
)->value
;
1351 XBUFFER_LOCAL_VALUE (newval
)->buffer
= Qnil
;
1352 XBUFFER_LOCAL_VALUE (newval
)->frame
= Qnil
;
1353 XBUFFER_LOCAL_VALUE (newval
)->found_for_buffer
= 0;
1354 XBUFFER_LOCAL_VALUE (newval
)->found_for_frame
= 0;
1355 XBUFFER_LOCAL_VALUE (newval
)->check_frame
= 0;
1356 XBUFFER_LOCAL_VALUE (newval
)->cdr
= tem
;
1357 XSYMBOL (variable
)->value
= newval
;
1359 /* Make sure this buffer has its own value of symbol */
1360 tem
= Fassq (variable
, current_buffer
->local_var_alist
);
1363 /* Swap out any local binding for some other buffer, and make
1364 sure the current value is permanently recorded, if it's the
1366 find_symbol_value (variable
);
1368 current_buffer
->local_var_alist
1369 = Fcons (Fcons (variable
, XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (variable
)->value
)->cdr
)->cdr
),
1370 current_buffer
->local_var_alist
);
1372 /* Make sure symbol does not think it is set up for this buffer;
1373 force it to look once again for this buffer's value */
1375 Lisp_Object
*pvalbuf
;
1377 valcontents
= XSYMBOL (variable
)->value
;
1379 pvalbuf
= &XBUFFER_LOCAL_VALUE (valcontents
)->buffer
;
1380 if (current_buffer
== XBUFFER (*pvalbuf
))
1382 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
1386 /* If the symbol forwards into a C variable, then swap in the
1387 variable for this buffer immediately. If C code modifies the
1388 variable before we swap in, then that new value will clobber the
1389 default value the next time we swap. */
1390 valcontents
= XBUFFER_LOCAL_VALUE (XSYMBOL (variable
)->value
)->realvalue
;
1391 if (INTFWDP (valcontents
) || BOOLFWDP (valcontents
) || OBJFWDP (valcontents
))
1392 swap_in_symval_forwarding (variable
, XSYMBOL (variable
)->value
);
1397 DEFUN ("kill-local-variable", Fkill_local_variable
, Skill_local_variable
,
1398 1, 1, "vKill Local Variable: ",
1399 "Make VARIABLE no longer have a separate value in the current buffer.\n\
1400 From now on the default value will apply in this buffer.")
1402 register Lisp_Object variable
;
1404 register Lisp_Object tem
, valcontents
;
1406 CHECK_SYMBOL (variable
, 0);
1408 valcontents
= XSYMBOL (variable
)->value
;
1410 if (BUFFER_OBJFWDP (valcontents
))
1412 register int idx
= XBUFFER_OBJFWD (valcontents
)->offset
;
1413 register int mask
= XINT (*((Lisp_Object
*)
1414 (idx
+ (char *)&buffer_local_flags
)));
1418 *(Lisp_Object
*)(idx
+ (char *) current_buffer
)
1419 = *(Lisp_Object
*)(idx
+ (char *) &buffer_defaults
);
1420 current_buffer
->local_var_flags
&= ~mask
;
1425 if (!BUFFER_LOCAL_VALUEP (valcontents
)
1426 && !SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1429 /* Get rid of this buffer's alist element, if any */
1431 tem
= Fassq (variable
, current_buffer
->local_var_alist
);
1433 current_buffer
->local_var_alist
1434 = Fdelq (tem
, current_buffer
->local_var_alist
);
1436 /* If the symbol is set up for the current buffer, recompute its
1437 value. We have to do it now, or else forwarded objects won't
1440 Lisp_Object
*pvalbuf
;
1441 valcontents
= XSYMBOL (variable
)->value
;
1442 pvalbuf
= &XBUFFER_LOCAL_VALUE (valcontents
)->buffer
;
1443 if (current_buffer
== XBUFFER (*pvalbuf
))
1446 XBUFFER_LOCAL_VALUE (valcontents
)->found_for_buffer
= 0;
1447 find_symbol_value (variable
);
1454 /* Lisp functions for creating and removing buffer-local variables. */
1456 DEFUN ("make-variable-frame-local", Fmake_variable_frame_local
, Smake_variable_frame_local
,
1457 1, 1, "vMake Variable Frame Local: ",
1458 "Enable VARIABLE to have frame-local bindings.\n\
1459 When a frame-local binding exists in the current frame,\n\
1460 it is in effect whenever the current buffer has no buffer-local binding.\n\
1461 A frame-local binding is actual a frame parameter value;\n\
1462 thus, any given frame has a local binding for VARIABLE\n\
1463 if it has a value for the frame parameter named VARIABLE.\n\
1464 See `modify-frame-parameters'.")
1466 register Lisp_Object variable
;
1468 register Lisp_Object tem
, valcontents
, newval
;
1470 CHECK_SYMBOL (variable
, 0);
1472 valcontents
= XSYMBOL (variable
)->value
;
1473 if (EQ (variable
, Qnil
) || EQ (variable
, Qt
) || KBOARD_OBJFWDP (valcontents
)
1474 || BUFFER_OBJFWDP (valcontents
))
1475 error ("Symbol %s may not be frame-local", XSYMBOL (variable
)->name
->data
);
1477 if (BUFFER_LOCAL_VALUEP (valcontents
)
1478 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1481 if (EQ (valcontents
, Qunbound
))
1482 XSYMBOL (variable
)->value
= Qnil
;
1483 tem
= Fcons (Qnil
, Fsymbol_value (variable
));
1484 XCONS (tem
)->car
= tem
;
1485 newval
= allocate_misc ();
1486 XMISCTYPE (newval
) = Lisp_Misc_Some_Buffer_Local_Value
;
1487 XBUFFER_LOCAL_VALUE (newval
)->realvalue
= XSYMBOL (variable
)->value
;
1488 XBUFFER_LOCAL_VALUE (newval
)->buffer
= Qnil
;
1489 XBUFFER_LOCAL_VALUE (newval
)->frame
= Qnil
;
1490 XBUFFER_LOCAL_VALUE (newval
)->found_for_buffer
= 0;
1491 XBUFFER_LOCAL_VALUE (newval
)->found_for_frame
= 0;
1492 XBUFFER_LOCAL_VALUE (newval
)->check_frame
= 1;
1493 XBUFFER_LOCAL_VALUE (newval
)->cdr
= tem
;
1494 XSYMBOL (variable
)->value
= newval
;
1498 DEFUN ("local-variable-p", Flocal_variable_p
, Slocal_variable_p
,
1500 "Non-nil if VARIABLE has a local binding in buffer BUFFER.\n\
1501 BUFFER defaults to the current buffer.")
1503 register Lisp_Object variable
, buffer
;
1505 Lisp_Object valcontents
;
1506 register struct buffer
*buf
;
1509 buf
= current_buffer
;
1512 CHECK_BUFFER (buffer
, 0);
1513 buf
= XBUFFER (buffer
);
1516 CHECK_SYMBOL (variable
, 0);
1518 valcontents
= XSYMBOL (variable
)->value
;
1519 if (BUFFER_LOCAL_VALUEP (valcontents
)
1520 || SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1522 Lisp_Object tail
, elt
;
1523 for (tail
= buf
->local_var_alist
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1525 elt
= XCONS (tail
)->car
;
1526 if (EQ (variable
, XCONS (elt
)->car
))
1530 if (BUFFER_OBJFWDP (valcontents
))
1532 int offset
= XBUFFER_OBJFWD (valcontents
)->offset
;
1533 int mask
= XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
));
1534 if (mask
== -1 || (buf
->local_var_flags
& mask
))
1540 DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p
, Slocal_variable_if_set_p
,
1542 "Non-nil if VARIABLE will be local in buffer BUFFER if it is set there.\n\
1543 BUFFER defaults to the current buffer.")
1545 register Lisp_Object variable
, buffer
;
1547 Lisp_Object valcontents
;
1548 register struct buffer
*buf
;
1551 buf
= current_buffer
;
1554 CHECK_BUFFER (buffer
, 0);
1555 buf
= XBUFFER (buffer
);
1558 CHECK_SYMBOL (variable
, 0);
1560 valcontents
= XSYMBOL (variable
)->value
;
1562 /* This means that make-variable-buffer-local was done. */
1563 if (BUFFER_LOCAL_VALUEP (valcontents
))
1565 /* All these slots become local if they are set. */
1566 if (BUFFER_OBJFWDP (valcontents
))
1568 if (SOME_BUFFER_LOCAL_VALUEP (valcontents
))
1570 Lisp_Object tail
, elt
;
1571 for (tail
= buf
->local_var_alist
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1573 elt
= XCONS (tail
)->car
;
1574 if (EQ (variable
, XCONS (elt
)->car
))
1581 /* Find the function at the end of a chain of symbol function indirections. */
1583 /* If OBJECT is a symbol, find the end of its function chain and
1584 return the value found there. If OBJECT is not a symbol, just
1585 return it. If there is a cycle in the function chain, signal a
1586 cyclic-function-indirection error.
1588 This is like Findirect_function, except that it doesn't signal an
1589 error if the chain ends up unbound. */
1591 indirect_function (object
)
1592 register Lisp_Object object
;
1594 Lisp_Object tortoise
, hare
;
1596 hare
= tortoise
= object
;
1600 if (!SYMBOLP (hare
) || EQ (hare
, Qunbound
))
1602 hare
= XSYMBOL (hare
)->function
;
1603 if (!SYMBOLP (hare
) || EQ (hare
, Qunbound
))
1605 hare
= XSYMBOL (hare
)->function
;
1607 tortoise
= XSYMBOL (tortoise
)->function
;
1609 if (EQ (hare
, tortoise
))
1610 Fsignal (Qcyclic_function_indirection
, Fcons (object
, Qnil
));
1616 DEFUN ("indirect-function", Findirect_function
, Sindirect_function
, 1, 1, 0,
1617 "Return the function at the end of OBJECT's function chain.\n\
1618 If OBJECT is a symbol, follow all function indirections and return the final\n\
1619 function binding.\n\
1620 If OBJECT is not a symbol, just return it.\n\
1621 Signal a void-function error if the final symbol is unbound.\n\
1622 Signal a cyclic-function-indirection error if there is a loop in the\n\
1623 function chain of symbols.")
1625 register Lisp_Object object
;
1629 result
= indirect_function (object
);
1631 if (EQ (result
, Qunbound
))
1632 return Fsignal (Qvoid_function
, Fcons (object
, Qnil
));
1636 /* Extract and set vector and string elements */
1638 DEFUN ("aref", Faref
, Saref
, 2, 2, 0,
1639 "Return the element of ARRAY at index IDX.\n\
1640 ARRAY may be a vector, a string, a char-table, a bool-vector,\n\
1641 or a byte-code object. IDX starts at 0.")
1643 register Lisp_Object array
;
1646 register int idxval
;
1648 CHECK_NUMBER (idx
, 1);
1649 idxval
= XINT (idx
);
1650 if (STRINGP (array
))
1655 if (idxval
< 0 || idxval
>= XSTRING (array
)->size
)
1656 args_out_of_range (array
, idx
);
1657 if (! STRING_MULTIBYTE (array
))
1658 return make_number ((unsigned char) XSTRING (array
)->data
[idxval
]);
1659 idxval_byte
= string_char_to_byte (array
, idxval
);
1661 c
= STRING_CHAR (&XSTRING (array
)->data
[idxval_byte
],
1662 STRING_BYTES (XSTRING (array
)) - idxval_byte
);
1663 return make_number (c
);
1665 else if (BOOL_VECTOR_P (array
))
1669 if (idxval
< 0 || idxval
>= XBOOL_VECTOR (array
)->size
)
1670 args_out_of_range (array
, idx
);
1672 val
= (unsigned char) XBOOL_VECTOR (array
)->data
[idxval
/ BITS_PER_CHAR
];
1673 return (val
& (1 << (idxval
% BITS_PER_CHAR
)) ? Qt
: Qnil
);
1675 else if (CHAR_TABLE_P (array
))
1680 args_out_of_range (array
, idx
);
1681 if (idxval
< CHAR_TABLE_ORDINARY_SLOTS
)
1683 /* For ASCII and 8-bit European characters, the element is
1684 stored in the top table. */
1685 val
= XCHAR_TABLE (array
)->contents
[idxval
];
1687 val
= XCHAR_TABLE (array
)->defalt
;
1688 while (NILP (val
)) /* Follow parents until we find some value. */
1690 array
= XCHAR_TABLE (array
)->parent
;
1693 val
= XCHAR_TABLE (array
)->contents
[idxval
];
1695 val
= XCHAR_TABLE (array
)->defalt
;
1702 Lisp_Object sub_table
;
1704 SPLIT_NON_ASCII_CHAR (idxval
, code
[0], code
[1], code
[2]);
1705 if (code
[0] != CHARSET_COMPOSITION
)
1707 if (code
[1] < 32) code
[1] = -1;
1708 else if (code
[2] < 32) code
[2] = -1;
1710 /* Here, the possible range of CODE[0] (== charset ID) is
1711 128..MAX_CHARSET. Since the top level char table contains
1712 data for multibyte characters after 256th element, we must
1713 increment CODE[0] by 128 to get a correct index. */
1715 code
[3] = -1; /* anchor */
1717 try_parent_char_table
:
1719 for (i
= 0; code
[i
] >= 0; i
++)
1721 val
= XCHAR_TABLE (sub_table
)->contents
[code
[i
]];
1722 if (SUB_CHAR_TABLE_P (val
))
1727 val
= XCHAR_TABLE (sub_table
)->defalt
;
1730 array
= XCHAR_TABLE (array
)->parent
;
1732 goto try_parent_char_table
;
1737 /* Here, VAL is a sub char table. We try the default value
1739 val
= XCHAR_TABLE (val
)->defalt
;
1742 array
= XCHAR_TABLE (array
)->parent
;
1744 goto try_parent_char_table
;
1752 if (VECTORP (array
))
1753 size
= XVECTOR (array
)->size
;
1754 else if (COMPILEDP (array
))
1755 size
= XVECTOR (array
)->size
& PSEUDOVECTOR_SIZE_MASK
;
1757 wrong_type_argument (Qarrayp
, array
);
1759 if (idxval
< 0 || idxval
>= size
)
1760 args_out_of_range (array
, idx
);
1761 return XVECTOR (array
)->contents
[idxval
];
1765 DEFUN ("aset", Faset
, Saset
, 3, 3, 0,
1766 "Store into the element of ARRAY at index IDX the value NEWELT.\n\
1767 ARRAY may be a vector, a string, a char-table or a bool-vector.\n\
1769 (array
, idx
, newelt
)
1770 register Lisp_Object array
;
1771 Lisp_Object idx
, newelt
;
1773 register int idxval
;
1775 CHECK_NUMBER (idx
, 1);
1776 idxval
= XINT (idx
);
1777 if (!VECTORP (array
) && !STRINGP (array
) && !BOOL_VECTOR_P (array
)
1778 && ! CHAR_TABLE_P (array
))
1779 array
= wrong_type_argument (Qarrayp
, array
);
1780 CHECK_IMPURE (array
);
1782 if (VECTORP (array
))
1784 if (idxval
< 0 || idxval
>= XVECTOR (array
)->size
)
1785 args_out_of_range (array
, idx
);
1786 XVECTOR (array
)->contents
[idxval
] = newelt
;
1788 else if (BOOL_VECTOR_P (array
))
1792 if (idxval
< 0 || idxval
>= XBOOL_VECTOR (array
)->size
)
1793 args_out_of_range (array
, idx
);
1795 val
= (unsigned char) XBOOL_VECTOR (array
)->data
[idxval
/ BITS_PER_CHAR
];
1797 if (! NILP (newelt
))
1798 val
|= 1 << (idxval
% BITS_PER_CHAR
);
1800 val
&= ~(1 << (idxval
% BITS_PER_CHAR
));
1801 XBOOL_VECTOR (array
)->data
[idxval
/ BITS_PER_CHAR
] = val
;
1803 else if (CHAR_TABLE_P (array
))
1808 args_out_of_range (array
, idx
);
1809 if (idxval
< CHAR_TABLE_ORDINARY_SLOTS
)
1810 XCHAR_TABLE (array
)->contents
[idxval
] = newelt
;
1816 SPLIT_NON_ASCII_CHAR (idxval
, code
[0], code
[1], code
[2]);
1817 if (code
[0] != CHARSET_COMPOSITION
)
1819 if (code
[1] < 32) code
[1] = -1;
1820 else if (code
[2] < 32) code
[2] = -1;
1822 /* See the comment of the corresponding part in Faref. */
1824 code
[3] = -1; /* anchor */
1825 for (i
= 0; code
[i
+ 1] >= 0; i
++)
1827 val
= XCHAR_TABLE (array
)->contents
[code
[i
]];
1828 if (SUB_CHAR_TABLE_P (val
))
1834 /* VAL is a leaf. Create a sub char table with the
1835 default value VAL or XCHAR_TABLE (array)->defalt
1836 and look into it. */
1838 temp
= make_sub_char_table (NILP (val
)
1839 ? XCHAR_TABLE (array
)->defalt
1841 XCHAR_TABLE (array
)->contents
[code
[i
]] = temp
;
1845 XCHAR_TABLE (array
)->contents
[code
[i
]] = newelt
;
1848 else if (STRING_MULTIBYTE (array
))
1850 Lisp_Object new_len
;
1851 int c
, idxval_byte
, actual_len
;
1852 unsigned char *p
, *str
;
1854 if (idxval
< 0 || idxval
>= XSTRING (array
)->size
)
1855 args_out_of_range (array
, idx
);
1857 idxval_byte
= string_char_to_byte (array
, idxval
);
1858 p
= &XSTRING (array
)->data
[idxval_byte
];
1861 = MULTIBYTE_FORM_LENGTH (p
, STRING_BYTES (XSTRING (array
)) - idxval_byte
);
1862 new_len
= Fchar_bytes (newelt
);
1863 if (actual_len
!= XINT (new_len
))
1864 error ("Attempt to change byte length of a string");
1866 CHAR_STRING (XINT (newelt
), p
, str
);
1868 bcopy (str
, p
, actual_len
);
1872 if (idxval
< 0 || idxval
>= XSTRING (array
)->size
)
1873 args_out_of_range (array
, idx
);
1874 CHECK_NUMBER (newelt
, 2);
1875 XSTRING (array
)->data
[idxval
] = XINT (newelt
);
1881 /* Arithmetic functions */
1883 enum comparison
{ equal
, notequal
, less
, grtr
, less_or_equal
, grtr_or_equal
};
1886 arithcompare (num1
, num2
, comparison
)
1887 Lisp_Object num1
, num2
;
1888 enum comparison comparison
;
1893 #ifdef LISP_FLOAT_TYPE
1894 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1
, 0);
1895 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2
, 0);
1897 if (FLOATP (num1
) || FLOATP (num2
))
1900 f1
= (FLOATP (num1
)) ? XFLOAT (num1
)->data
: XINT (num1
);
1901 f2
= (FLOATP (num2
)) ? XFLOAT (num2
)->data
: XINT (num2
);
1904 CHECK_NUMBER_COERCE_MARKER (num1
, 0);
1905 CHECK_NUMBER_COERCE_MARKER (num2
, 0);
1906 #endif /* LISP_FLOAT_TYPE */
1911 if (floatp
? f1
== f2
: XINT (num1
) == XINT (num2
))
1916 if (floatp
? f1
!= f2
: XINT (num1
) != XINT (num2
))
1921 if (floatp
? f1
< f2
: XINT (num1
) < XINT (num2
))
1926 if (floatp
? f1
<= f2
: XINT (num1
) <= XINT (num2
))
1931 if (floatp
? f1
> f2
: XINT (num1
) > XINT (num2
))
1936 if (floatp
? f1
>= f2
: XINT (num1
) >= XINT (num2
))
1945 DEFUN ("=", Feqlsign
, Seqlsign
, 2, 2, 0,
1946 "Return t if two args, both numbers or markers, are equal.")
1948 register Lisp_Object num1
, num2
;
1950 return arithcompare (num1
, num2
, equal
);
1953 DEFUN ("<", Flss
, Slss
, 2, 2, 0,
1954 "Return t if first arg is less than second arg. Both must be numbers or markers.")
1956 register Lisp_Object num1
, num2
;
1958 return arithcompare (num1
, num2
, less
);
1961 DEFUN (">", Fgtr
, Sgtr
, 2, 2, 0,
1962 "Return t if first arg is greater than second arg. Both must be numbers or markers.")
1964 register Lisp_Object num1
, num2
;
1966 return arithcompare (num1
, num2
, grtr
);
1969 DEFUN ("<=", Fleq
, Sleq
, 2, 2, 0,
1970 "Return t if first arg is less than or equal to second arg.\n\
1971 Both must be numbers or markers.")
1973 register Lisp_Object num1
, num2
;
1975 return arithcompare (num1
, num2
, less_or_equal
);
1978 DEFUN (">=", Fgeq
, Sgeq
, 2, 2, 0,
1979 "Return t if first arg is greater than or equal to second arg.\n\
1980 Both must be numbers or markers.")
1982 register Lisp_Object num1
, num2
;
1984 return arithcompare (num1
, num2
, grtr_or_equal
);
1987 DEFUN ("/=", Fneq
, Sneq
, 2, 2, 0,
1988 "Return t if first arg is not equal to second arg. Both must be numbers or markers.")
1990 register Lisp_Object num1
, num2
;
1992 return arithcompare (num1
, num2
, notequal
);
1995 DEFUN ("zerop", Fzerop
, Szerop
, 1, 1, 0, "Return t if NUMBER is zero.")
1997 register Lisp_Object number
;
1999 #ifdef LISP_FLOAT_TYPE
2000 CHECK_NUMBER_OR_FLOAT (number
, 0);
2002 if (FLOATP (number
))
2004 if (XFLOAT(number
)->data
== 0.0)
2009 CHECK_NUMBER (number
, 0);
2010 #endif /* LISP_FLOAT_TYPE */
2017 /* Convert between long values and pairs of Lisp integers. */
2023 unsigned int top
= i
>> 16;
2024 unsigned int bot
= i
& 0xFFFF;
2026 return make_number (bot
);
2027 if (top
== (unsigned long)-1 >> 16)
2028 return Fcons (make_number (-1), make_number (bot
));
2029 return Fcons (make_number (top
), make_number (bot
));
2036 Lisp_Object top
, bot
;
2039 top
= XCONS (c
)->car
;
2040 bot
= XCONS (c
)->cdr
;
2042 bot
= XCONS (bot
)->car
;
2043 return ((XINT (top
) << 16) | XINT (bot
));
2046 DEFUN ("number-to-string", Fnumber_to_string
, Snumber_to_string
, 1, 1, 0,
2047 "Convert NUMBER to a string by printing it in decimal.\n\
2048 Uses a minus sign if negative.\n\
2049 NUMBER may be an integer or a floating point number.")
2053 char buffer
[VALBITS
];
2055 #ifndef LISP_FLOAT_TYPE
2056 CHECK_NUMBER (number
, 0);
2058 CHECK_NUMBER_OR_FLOAT (number
, 0);
2060 if (FLOATP (number
))
2062 char pigbuf
[350]; /* see comments in float_to_string */
2064 float_to_string (pigbuf
, XFLOAT(number
)->data
);
2065 return build_string (pigbuf
);
2067 #endif /* LISP_FLOAT_TYPE */
2069 if (sizeof (int) == sizeof (EMACS_INT
))
2070 sprintf (buffer
, "%d", XINT (number
));
2071 else if (sizeof (long) == sizeof (EMACS_INT
))
2072 sprintf (buffer
, "%ld", XINT (number
));
2075 return build_string (buffer
);
2079 digit_to_number (character
, base
)
2080 int character
, base
;
2084 if (character
>= '0' && character
<= '9')
2085 digit
= character
- '0';
2086 else if (character
>= 'a' && character
<= 'z')
2087 digit
= character
- 'a' + 10;
2088 else if (character
>= 'A' && character
<= 'Z')
2089 digit
= character
- 'A' + 10;
2099 DEFUN ("string-to-number", Fstring_to_number
, Sstring_to_number
, 1, 2, 0,
2100 "Convert STRING to a number by parsing it as a decimal number.\n\
2101 This parses both integers and floating point numbers.\n\
2102 It ignores leading spaces and tabs.\n\
2104 If BASE, interpret STRING as a number in that base. If BASE isn't\n\
2105 present, base 10 is used. BASE must be between 2 and 16 (inclusive).\n\
2106 Floating point numbers always use base 10.")
2108 register Lisp_Object string
, base
;
2110 register unsigned char *p
;
2111 register int b
, digit
, v
= 0;
2114 CHECK_STRING (string
, 0);
2120 CHECK_NUMBER (base
, 1);
2122 if (b
< 2 || b
> 16)
2123 Fsignal (Qargs_out_of_range
, Fcons (base
, Qnil
));
2126 p
= XSTRING (string
)->data
;
2128 /* Skip any whitespace at the front of the number. Some versions of
2129 atoi do this anyway, so we might as well make Emacs lisp consistent. */
2130 while (*p
== ' ' || *p
== '\t')
2141 #ifdef LISP_FLOAT_TYPE
2142 if (isfloat_string (p
))
2143 return make_float (negative
* atof (p
));
2144 #endif /* LISP_FLOAT_TYPE */
2148 int digit
= digit_to_number (*p
++, b
);
2154 return make_number (negative
* v
);
2159 { Aadd
, Asub
, Amult
, Adiv
, Alogand
, Alogior
, Alogxor
, Amax
, Amin
};
2161 extern Lisp_Object
float_arith_driver ();
2162 extern Lisp_Object
fmod_float ();
2165 arith_driver (code
, nargs
, args
)
2168 register Lisp_Object
*args
;
2170 register Lisp_Object val
;
2171 register int argnum
;
2172 register EMACS_INT accum
;
2173 register EMACS_INT next
;
2175 switch (SWITCH_ENUM_CAST (code
))
2188 for (argnum
= 0; argnum
< nargs
; argnum
++)
2190 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
2191 #ifdef LISP_FLOAT_TYPE
2192 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
2194 if (FLOATP (val
)) /* time to do serious math */
2195 return (float_arith_driver ((double) accum
, argnum
, code
,
2198 CHECK_NUMBER_COERCE_MARKER (val
, argnum
);
2199 #endif /* LISP_FLOAT_TYPE */
2200 args
[argnum
] = val
; /* runs into a compiler bug. */
2201 next
= XINT (args
[argnum
]);
2202 switch (SWITCH_ENUM_CAST (code
))
2204 case Aadd
: accum
+= next
; break;
2206 if (!argnum
&& nargs
!= 1)
2210 case Amult
: accum
*= next
; break;
2212 if (!argnum
) accum
= next
;
2216 Fsignal (Qarith_error
, Qnil
);
2220 case Alogand
: accum
&= next
; break;
2221 case Alogior
: accum
|= next
; break;
2222 case Alogxor
: accum
^= next
; break;
2223 case Amax
: if (!argnum
|| next
> accum
) accum
= next
; break;
2224 case Amin
: if (!argnum
|| next
< accum
) accum
= next
; break;
2228 XSETINT (val
, accum
);
2233 #define isnan(x) ((x) != (x))
2235 #ifdef LISP_FLOAT_TYPE
2238 float_arith_driver (accum
, argnum
, code
, nargs
, args
)
2240 register int argnum
;
2243 register Lisp_Object
*args
;
2245 register Lisp_Object val
;
2248 for (; argnum
< nargs
; argnum
++)
2250 val
= args
[argnum
]; /* using args[argnum] as argument to CHECK_NUMBER_... */
2251 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val
, argnum
);
2255 next
= XFLOAT (val
)->data
;
2259 args
[argnum
] = val
; /* runs into a compiler bug. */
2260 next
= XINT (args
[argnum
]);
2262 switch (SWITCH_ENUM_CAST (code
))
2268 if (!argnum
&& nargs
!= 1)
2280 if (! IEEE_FLOATING_POINT
&& next
== 0)
2281 Fsignal (Qarith_error
, Qnil
);
2288 return wrong_type_argument (Qinteger_or_marker_p
, val
);
2290 if (!argnum
|| isnan (next
) || next
> accum
)
2294 if (!argnum
|| isnan (next
) || next
< accum
)
2300 return make_float (accum
);
2302 #endif /* LISP_FLOAT_TYPE */
2304 DEFUN ("+", Fplus
, Splus
, 0, MANY
, 0,
2305 "Return sum of any number of arguments, which are numbers or markers.")
2310 return arith_driver (Aadd
, nargs
, args
);
2313 DEFUN ("-", Fminus
, Sminus
, 0, MANY
, 0,
2314 "Negate number or subtract numbers or markers.\n\
2315 With one arg, negates it. With more than one arg,\n\
2316 subtracts all but the first from the first.")
2321 return arith_driver (Asub
, nargs
, args
);
2324 DEFUN ("*", Ftimes
, Stimes
, 0, MANY
, 0,
2325 "Returns product of any number of arguments, which are numbers or markers.")
2330 return arith_driver (Amult
, nargs
, args
);
2333 DEFUN ("/", Fquo
, Squo
, 2, MANY
, 0,
2334 "Returns first argument divided by all the remaining arguments.\n\
2335 The arguments must be numbers or markers.")
2340 return arith_driver (Adiv
, nargs
, args
);
2343 DEFUN ("%", Frem
, Srem
, 2, 2, 0,
2344 "Returns remainder of X divided by Y.\n\
2345 Both must be integers or markers.")
2347 register Lisp_Object x
, y
;
2351 CHECK_NUMBER_COERCE_MARKER (x
, 0);
2352 CHECK_NUMBER_COERCE_MARKER (y
, 1);
2354 if (XFASTINT (y
) == 0)
2355 Fsignal (Qarith_error
, Qnil
);
2357 XSETINT (val
, XINT (x
) % XINT (y
));
2371 /* If the magnitude of the result exceeds that of the divisor, or
2372 the sign of the result does not agree with that of the dividend,
2373 iterate with the reduced value. This does not yield a
2374 particularly accurate result, but at least it will be in the
2375 range promised by fmod. */
2377 r
-= f2
* floor (r
/ f2
);
2378 while (f2
<= (r
< 0 ? -r
: r
) || ((r
< 0) != (f1
< 0) && ! isnan (r
)));
2382 #endif /* ! HAVE_FMOD */
2384 DEFUN ("mod", Fmod
, Smod
, 2, 2, 0,
2385 "Returns X modulo Y.\n\
2386 The result falls between zero (inclusive) and Y (exclusive).\n\
2387 Both X and Y must be numbers or markers.")
2389 register Lisp_Object x
, y
;
2394 #ifdef LISP_FLOAT_TYPE
2395 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (x
, 0);
2396 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (y
, 1);
2398 if (FLOATP (x
) || FLOATP (y
))
2399 return fmod_float (x
, y
);
2401 #else /* not LISP_FLOAT_TYPE */
2402 CHECK_NUMBER_COERCE_MARKER (x
, 0);
2403 CHECK_NUMBER_COERCE_MARKER (y
, 1);
2404 #endif /* not LISP_FLOAT_TYPE */
2410 Fsignal (Qarith_error
, Qnil
);
2414 /* If the "remainder" comes out with the wrong sign, fix it. */
2415 if (i2
< 0 ? i1
> 0 : i1
< 0)
2422 DEFUN ("max", Fmax
, Smax
, 1, MANY
, 0,
2423 "Return largest of all the arguments (which must be numbers or markers).\n\
2424 The value is always a number; markers are converted to numbers.")
2429 return arith_driver (Amax
, nargs
, args
);
2432 DEFUN ("min", Fmin
, Smin
, 1, MANY
, 0,
2433 "Return smallest of all the arguments (which must be numbers or markers).\n\
2434 The value is always a number; markers are converted to numbers.")
2439 return arith_driver (Amin
, nargs
, args
);
2442 DEFUN ("logand", Flogand
, Slogand
, 0, MANY
, 0,
2443 "Return bitwise-and of all the arguments.\n\
2444 Arguments may be integers, or markers converted to integers.")
2449 return arith_driver (Alogand
, nargs
, args
);
2452 DEFUN ("logior", Flogior
, Slogior
, 0, MANY
, 0,
2453 "Return bitwise-or of all the arguments.\n\
2454 Arguments may be integers, or markers converted to integers.")
2459 return arith_driver (Alogior
, nargs
, args
);
2462 DEFUN ("logxor", Flogxor
, Slogxor
, 0, MANY
, 0,
2463 "Return bitwise-exclusive-or of all the arguments.\n\
2464 Arguments may be integers, or markers converted to integers.")
2469 return arith_driver (Alogxor
, nargs
, args
);
2472 DEFUN ("ash", Fash
, Sash
, 2, 2, 0,
2473 "Return VALUE with its bits shifted left by COUNT.\n\
2474 If COUNT is negative, shifting is actually to the right.\n\
2475 In this case, the sign bit is duplicated.")
2477 register Lisp_Object value
, count
;
2479 register Lisp_Object val
;
2481 CHECK_NUMBER (value
, 0);
2482 CHECK_NUMBER (count
, 1);
2484 if (XINT (count
) >= BITS_PER_EMACS_INT
)
2486 else if (XINT (count
) > 0)
2487 XSETINT (val
, XINT (value
) << XFASTINT (count
));
2488 else if (XINT (count
) <= -BITS_PER_EMACS_INT
)
2489 XSETINT (val
, XINT (value
) < 0 ? -1 : 0);
2491 XSETINT (val
, XINT (value
) >> -XINT (count
));
2495 DEFUN ("lsh", Flsh
, Slsh
, 2, 2, 0,
2496 "Return VALUE with its bits shifted left by COUNT.\n\
2497 If COUNT is negative, shifting is actually to the right.\n\
2498 In this case, zeros are shifted in on the left.")
2500 register Lisp_Object value
, count
;
2502 register Lisp_Object val
;
2504 CHECK_NUMBER (value
, 0);
2505 CHECK_NUMBER (count
, 1);
2507 if (XINT (count
) >= BITS_PER_EMACS_INT
)
2509 else if (XINT (count
) > 0)
2510 XSETINT (val
, (EMACS_UINT
) XUINT (value
) << XFASTINT (count
));
2511 else if (XINT (count
) <= -BITS_PER_EMACS_INT
)
2514 XSETINT (val
, (EMACS_UINT
) XUINT (value
) >> -XINT (count
));
2518 DEFUN ("1+", Fadd1
, Sadd1
, 1, 1, 0,
2519 "Return NUMBER plus one. NUMBER may be a number or a marker.\n\
2520 Markers are converted to integers.")
2522 register Lisp_Object number
;
2524 #ifdef LISP_FLOAT_TYPE
2525 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number
, 0);
2527 if (FLOATP (number
))
2528 return (make_float (1.0 + XFLOAT (number
)->data
));
2530 CHECK_NUMBER_COERCE_MARKER (number
, 0);
2531 #endif /* LISP_FLOAT_TYPE */
2533 XSETINT (number
, XINT (number
) + 1);
2537 DEFUN ("1-", Fsub1
, Ssub1
, 1, 1, 0,
2538 "Return NUMBER minus one. NUMBER may be a number or a marker.\n\
2539 Markers are converted to integers.")
2541 register Lisp_Object number
;
2543 #ifdef LISP_FLOAT_TYPE
2544 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (number
, 0);
2546 if (FLOATP (number
))
2547 return (make_float (-1.0 + XFLOAT (number
)->data
));
2549 CHECK_NUMBER_COERCE_MARKER (number
, 0);
2550 #endif /* LISP_FLOAT_TYPE */
2552 XSETINT (number
, XINT (number
) - 1);
2556 DEFUN ("lognot", Flognot
, Slognot
, 1, 1, 0,
2557 "Return the bitwise complement of NUMBER. NUMBER must be an integer.")
2559 register Lisp_Object number
;
2561 CHECK_NUMBER (number
, 0);
2562 XSETINT (number
, ~XINT (number
));
2569 Lisp_Object error_tail
, arith_tail
;
2571 Qquote
= intern ("quote");
2572 Qlambda
= intern ("lambda");
2573 Qsubr
= intern ("subr");
2574 Qerror_conditions
= intern ("error-conditions");
2575 Qerror_message
= intern ("error-message");
2576 Qtop_level
= intern ("top-level");
2578 Qerror
= intern ("error");
2579 Qquit
= intern ("quit");
2580 Qwrong_type_argument
= intern ("wrong-type-argument");
2581 Qargs_out_of_range
= intern ("args-out-of-range");
2582 Qvoid_function
= intern ("void-function");
2583 Qcyclic_function_indirection
= intern ("cyclic-function-indirection");
2584 Qvoid_variable
= intern ("void-variable");
2585 Qsetting_constant
= intern ("setting-constant");
2586 Qinvalid_read_syntax
= intern ("invalid-read-syntax");
2588 Qinvalid_function
= intern ("invalid-function");
2589 Qwrong_number_of_arguments
= intern ("wrong-number-of-arguments");
2590 Qno_catch
= intern ("no-catch");
2591 Qend_of_file
= intern ("end-of-file");
2592 Qarith_error
= intern ("arith-error");
2593 Qbeginning_of_buffer
= intern ("beginning-of-buffer");
2594 Qend_of_buffer
= intern ("end-of-buffer");
2595 Qbuffer_read_only
= intern ("buffer-read-only");
2596 Qmark_inactive
= intern ("mark-inactive");
2598 Qlistp
= intern ("listp");
2599 Qconsp
= intern ("consp");
2600 Qsymbolp
= intern ("symbolp");
2601 Qintegerp
= intern ("integerp");
2602 Qnatnump
= intern ("natnump");
2603 Qwholenump
= intern ("wholenump");
2604 Qstringp
= intern ("stringp");
2605 Qarrayp
= intern ("arrayp");
2606 Qsequencep
= intern ("sequencep");
2607 Qbufferp
= intern ("bufferp");
2608 Qvectorp
= intern ("vectorp");
2609 Qchar_or_string_p
= intern ("char-or-string-p");
2610 Qmarkerp
= intern ("markerp");
2611 Qbuffer_or_string_p
= intern ("buffer-or-string-p");
2612 Qinteger_or_marker_p
= intern ("integer-or-marker-p");
2613 Qboundp
= intern ("boundp");
2614 Qfboundp
= intern ("fboundp");
2616 #ifdef LISP_FLOAT_TYPE
2617 Qfloatp
= intern ("floatp");
2618 Qnumberp
= intern ("numberp");
2619 Qnumber_or_marker_p
= intern ("number-or-marker-p");
2620 #endif /* LISP_FLOAT_TYPE */
2622 Qchar_table_p
= intern ("char-table-p");
2623 Qvector_or_char_table_p
= intern ("vector-or-char-table-p");
2625 Qcdr
= intern ("cdr");
2627 /* Handle automatic advice activation */
2628 Qad_advice_info
= intern ("ad-advice-info");
2629 Qad_activate
= intern ("ad-activate");
2631 error_tail
= Fcons (Qerror
, Qnil
);
2633 /* ERROR is used as a signaler for random errors for which nothing else is right */
2635 Fput (Qerror
, Qerror_conditions
,
2637 Fput (Qerror
, Qerror_message
,
2638 build_string ("error"));
2640 Fput (Qquit
, Qerror_conditions
,
2641 Fcons (Qquit
, Qnil
));
2642 Fput (Qquit
, Qerror_message
,
2643 build_string ("Quit"));
2645 Fput (Qwrong_type_argument
, Qerror_conditions
,
2646 Fcons (Qwrong_type_argument
, error_tail
));
2647 Fput (Qwrong_type_argument
, Qerror_message
,
2648 build_string ("Wrong type argument"));
2650 Fput (Qargs_out_of_range
, Qerror_conditions
,
2651 Fcons (Qargs_out_of_range
, error_tail
));
2652 Fput (Qargs_out_of_range
, Qerror_message
,
2653 build_string ("Args out of range"));
2655 Fput (Qvoid_function
, Qerror_conditions
,
2656 Fcons (Qvoid_function
, error_tail
));
2657 Fput (Qvoid_function
, Qerror_message
,
2658 build_string ("Symbol's function definition is void"));
2660 Fput (Qcyclic_function_indirection
, Qerror_conditions
,
2661 Fcons (Qcyclic_function_indirection
, error_tail
));
2662 Fput (Qcyclic_function_indirection
, Qerror_message
,
2663 build_string ("Symbol's chain of function indirections contains a loop"));
2665 Fput (Qvoid_variable
, Qerror_conditions
,
2666 Fcons (Qvoid_variable
, error_tail
));
2667 Fput (Qvoid_variable
, Qerror_message
,
2668 build_string ("Symbol's value as variable is void"));
2670 Fput (Qsetting_constant
, Qerror_conditions
,
2671 Fcons (Qsetting_constant
, error_tail
));
2672 Fput (Qsetting_constant
, Qerror_message
,
2673 build_string ("Attempt to set a constant symbol"));
2675 Fput (Qinvalid_read_syntax
, Qerror_conditions
,
2676 Fcons (Qinvalid_read_syntax
, error_tail
));
2677 Fput (Qinvalid_read_syntax
, Qerror_message
,
2678 build_string ("Invalid read syntax"));
2680 Fput (Qinvalid_function
, Qerror_conditions
,
2681 Fcons (Qinvalid_function
, error_tail
));
2682 Fput (Qinvalid_function
, Qerror_message
,
2683 build_string ("Invalid function"));
2685 Fput (Qwrong_number_of_arguments
, Qerror_conditions
,
2686 Fcons (Qwrong_number_of_arguments
, error_tail
));
2687 Fput (Qwrong_number_of_arguments
, Qerror_message
,
2688 build_string ("Wrong number of arguments"));
2690 Fput (Qno_catch
, Qerror_conditions
,
2691 Fcons (Qno_catch
, error_tail
));
2692 Fput (Qno_catch
, Qerror_message
,
2693 build_string ("No catch for tag"));
2695 Fput (Qend_of_file
, Qerror_conditions
,
2696 Fcons (Qend_of_file
, error_tail
));
2697 Fput (Qend_of_file
, Qerror_message
,
2698 build_string ("End of file during parsing"));
2700 arith_tail
= Fcons (Qarith_error
, error_tail
);
2701 Fput (Qarith_error
, Qerror_conditions
,
2703 Fput (Qarith_error
, Qerror_message
,
2704 build_string ("Arithmetic error"));
2706 Fput (Qbeginning_of_buffer
, Qerror_conditions
,
2707 Fcons (Qbeginning_of_buffer
, error_tail
));
2708 Fput (Qbeginning_of_buffer
, Qerror_message
,
2709 build_string ("Beginning of buffer"));
2711 Fput (Qend_of_buffer
, Qerror_conditions
,
2712 Fcons (Qend_of_buffer
, error_tail
));
2713 Fput (Qend_of_buffer
, Qerror_message
,
2714 build_string ("End of buffer"));
2716 Fput (Qbuffer_read_only
, Qerror_conditions
,
2717 Fcons (Qbuffer_read_only
, error_tail
));
2718 Fput (Qbuffer_read_only
, Qerror_message
,
2719 build_string ("Buffer is read-only"));
2721 #ifdef LISP_FLOAT_TYPE
2722 Qrange_error
= intern ("range-error");
2723 Qdomain_error
= intern ("domain-error");
2724 Qsingularity_error
= intern ("singularity-error");
2725 Qoverflow_error
= intern ("overflow-error");
2726 Qunderflow_error
= intern ("underflow-error");
2728 Fput (Qdomain_error
, Qerror_conditions
,
2729 Fcons (Qdomain_error
, arith_tail
));
2730 Fput (Qdomain_error
, Qerror_message
,
2731 build_string ("Arithmetic domain error"));
2733 Fput (Qrange_error
, Qerror_conditions
,
2734 Fcons (Qrange_error
, arith_tail
));
2735 Fput (Qrange_error
, Qerror_message
,
2736 build_string ("Arithmetic range error"));
2738 Fput (Qsingularity_error
, Qerror_conditions
,
2739 Fcons (Qsingularity_error
, Fcons (Qdomain_error
, arith_tail
)));
2740 Fput (Qsingularity_error
, Qerror_message
,
2741 build_string ("Arithmetic singularity error"));
2743 Fput (Qoverflow_error
, Qerror_conditions
,
2744 Fcons (Qoverflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2745 Fput (Qoverflow_error
, Qerror_message
,
2746 build_string ("Arithmetic overflow error"));
2748 Fput (Qunderflow_error
, Qerror_conditions
,
2749 Fcons (Qunderflow_error
, Fcons (Qdomain_error
, arith_tail
)));
2750 Fput (Qunderflow_error
, Qerror_message
,
2751 build_string ("Arithmetic underflow error"));
2753 staticpro (&Qrange_error
);
2754 staticpro (&Qdomain_error
);
2755 staticpro (&Qsingularity_error
);
2756 staticpro (&Qoverflow_error
);
2757 staticpro (&Qunderflow_error
);
2758 #endif /* LISP_FLOAT_TYPE */
2762 staticpro (&Qquote
);
2763 staticpro (&Qlambda
);
2765 staticpro (&Qunbound
);
2766 staticpro (&Qerror_conditions
);
2767 staticpro (&Qerror_message
);
2768 staticpro (&Qtop_level
);
2770 staticpro (&Qerror
);
2772 staticpro (&Qwrong_type_argument
);
2773 staticpro (&Qargs_out_of_range
);
2774 staticpro (&Qvoid_function
);
2775 staticpro (&Qcyclic_function_indirection
);
2776 staticpro (&Qvoid_variable
);
2777 staticpro (&Qsetting_constant
);
2778 staticpro (&Qinvalid_read_syntax
);
2779 staticpro (&Qwrong_number_of_arguments
);
2780 staticpro (&Qinvalid_function
);
2781 staticpro (&Qno_catch
);
2782 staticpro (&Qend_of_file
);
2783 staticpro (&Qarith_error
);
2784 staticpro (&Qbeginning_of_buffer
);
2785 staticpro (&Qend_of_buffer
);
2786 staticpro (&Qbuffer_read_only
);
2787 staticpro (&Qmark_inactive
);
2789 staticpro (&Qlistp
);
2790 staticpro (&Qconsp
);
2791 staticpro (&Qsymbolp
);
2792 staticpro (&Qintegerp
);
2793 staticpro (&Qnatnump
);
2794 staticpro (&Qwholenump
);
2795 staticpro (&Qstringp
);
2796 staticpro (&Qarrayp
);
2797 staticpro (&Qsequencep
);
2798 staticpro (&Qbufferp
);
2799 staticpro (&Qvectorp
);
2800 staticpro (&Qchar_or_string_p
);
2801 staticpro (&Qmarkerp
);
2802 staticpro (&Qbuffer_or_string_p
);
2803 staticpro (&Qinteger_or_marker_p
);
2804 #ifdef LISP_FLOAT_TYPE
2805 staticpro (&Qfloatp
);
2806 staticpro (&Qnumberp
);
2807 staticpro (&Qnumber_or_marker_p
);
2808 #endif /* LISP_FLOAT_TYPE */
2809 staticpro (&Qchar_table_p
);
2810 staticpro (&Qvector_or_char_table_p
);
2812 staticpro (&Qboundp
);
2813 staticpro (&Qfboundp
);
2815 staticpro (&Qad_advice_info
);
2816 staticpro (&Qad_activate
);
2818 /* Types that type-of returns. */
2819 Qinteger
= intern ("integer");
2820 Qsymbol
= intern ("symbol");
2821 Qstring
= intern ("string");
2822 Qcons
= intern ("cons");
2823 Qmarker
= intern ("marker");
2824 Qoverlay
= intern ("overlay");
2825 Qfloat
= intern ("float");
2826 Qwindow_configuration
= intern ("window-configuration");
2827 Qprocess
= intern ("process");
2828 Qwindow
= intern ("window");
2829 /* Qsubr = intern ("subr"); */
2830 Qcompiled_function
= intern ("compiled-function");
2831 Qbuffer
= intern ("buffer");
2832 Qframe
= intern ("frame");
2833 Qvector
= intern ("vector");
2834 Qchar_table
= intern ("char-table");
2835 Qbool_vector
= intern ("bool-vector");
2837 staticpro (&Qinteger
);
2838 staticpro (&Qsymbol
);
2839 staticpro (&Qstring
);
2841 staticpro (&Qmarker
);
2842 staticpro (&Qoverlay
);
2843 staticpro (&Qfloat
);
2844 staticpro (&Qwindow_configuration
);
2845 staticpro (&Qprocess
);
2846 staticpro (&Qwindow
);
2847 /* staticpro (&Qsubr); */
2848 staticpro (&Qcompiled_function
);
2849 staticpro (&Qbuffer
);
2850 staticpro (&Qframe
);
2851 staticpro (&Qvector
);
2852 staticpro (&Qchar_table
);
2853 staticpro (&Qbool_vector
);
2855 DEFVAR_BOOL ("keyword-symbols-constant-flag", &keyword_symbols_constant_flag
,
2856 "Non-nil means it is an error to set a keyword symbol.\n\
2857 A keyword symbol is a symbol whose name starts with a colon (`:').");
2858 keyword_symbols_constant_flag
= 1;
2862 defsubr (&Stype_of
);
2867 defsubr (&Sintegerp
);
2868 defsubr (&Sinteger_or_marker_p
);
2869 defsubr (&Snumberp
);
2870 defsubr (&Snumber_or_marker_p
);
2871 #ifdef LISP_FLOAT_TYPE
2873 #endif /* LISP_FLOAT_TYPE */
2874 defsubr (&Snatnump
);
2875 defsubr (&Ssymbolp
);
2876 defsubr (&Sstringp
);
2877 defsubr (&Smultibyte_string_p
);
2878 defsubr (&Svectorp
);
2879 defsubr (&Schar_table_p
);
2880 defsubr (&Svector_or_char_table_p
);
2881 defsubr (&Sbool_vector_p
);
2883 defsubr (&Ssequencep
);
2884 defsubr (&Sbufferp
);
2885 defsubr (&Smarkerp
);
2887 defsubr (&Sbyte_code_function_p
);
2888 defsubr (&Schar_or_string_p
);
2891 defsubr (&Scar_safe
);
2892 defsubr (&Scdr_safe
);
2895 defsubr (&Ssymbol_function
);
2896 defsubr (&Sindirect_function
);
2897 defsubr (&Ssymbol_plist
);
2898 defsubr (&Ssymbol_name
);
2899 defsubr (&Smakunbound
);
2900 defsubr (&Sfmakunbound
);
2902 defsubr (&Sfboundp
);
2904 defsubr (&Sdefalias
);
2905 defsubr (&Ssetplist
);
2906 defsubr (&Ssymbol_value
);
2908 defsubr (&Sdefault_boundp
);
2909 defsubr (&Sdefault_value
);
2910 defsubr (&Sset_default
);
2911 defsubr (&Ssetq_default
);
2912 defsubr (&Smake_variable_buffer_local
);
2913 defsubr (&Smake_local_variable
);
2914 defsubr (&Skill_local_variable
);
2915 defsubr (&Smake_variable_frame_local
);
2916 defsubr (&Slocal_variable_p
);
2917 defsubr (&Slocal_variable_if_set_p
);
2920 defsubr (&Snumber_to_string
);
2921 defsubr (&Sstring_to_number
);
2922 defsubr (&Seqlsign
);
2946 XSYMBOL (Qwholenump
)->function
= XSYMBOL (Qnatnump
)->function
;
2953 #if defined(USG) && !defined(POSIX_SIGNALS)
2954 /* USG systems forget handlers when they are used;
2955 must reestablish each time */
2956 signal (signo
, arith_error
);
2959 /* VMS systems are like USG. */
2960 signal (signo
, arith_error
);
2964 #else /* not BSD4_1 */
2965 sigsetmask (SIGEMPTYMASK
);
2966 #endif /* not BSD4_1 */
2968 Fsignal (Qarith_error
, Qnil
);
2974 /* Don't do this if just dumping out.
2975 We don't want to call `signal' in this case
2976 so that we don't have trouble with dumping
2977 signal-delivering routines in an inconsistent state. */
2981 #endif /* CANNOT_DUMP */
2982 signal (SIGFPE
, arith_error
);
2985 signal (SIGEMT
, arith_error
);