annotate src/data.c @ 440:8de8e3f6228a r21-2-28

Import from CVS: tag r21-2-28
author cvs
date Mon, 13 Aug 2007 11:33:38 +0200
parents 080151679be2
children abe6d1db359e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Primitive operations on Lisp data types for XEmacs Lisp interpreter.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985, 1986, 1988, 1992, 1993, 1994, 1995
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Mule 2.0, FSF 19.30. Some of FSF's data.c is in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 XEmacs' symbols.c. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 /* This file has been Mule-ized. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "syssignal.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 /* Need to define a differentiating symbol -- see sysfloat.h */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 # define THIS_FILENAME data_c
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 # include "sysfloat.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 Lisp_Object Qerror_conditions, Qerror_message;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 Lisp_Object Qvoid_variable, Qcyclic_variable_indirection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 Lisp_Object Qvoid_function, Qcyclic_function_indirection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 Lisp_Object Qmalformed_list, Qmalformed_property_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 Lisp_Object Qcircular_list, Qcircular_property_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 Lisp_Object Qio_error, Qend_of_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 Lisp_Object Qarith_error, Qrange_error, Qdomain_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 Lisp_Object Qsingularity_error, Qoverflow_error, Qunderflow_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 Lisp_Object Qintegerp, Qnatnump, Qsymbolp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 Lisp_Object Qlistp, Qtrue_list_p, Qweak_listp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 Lisp_Object Qconsp, Qsubrp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 Lisp_Object Qcharacterp, Qstringp, Qarrayp, Qsequencep, Qvectorp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qbufferp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 Lisp_Object Qinteger_or_char_p, Qinteger_char_or_marker_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 Lisp_Object Qnumberp, Qnumber_char_or_marker_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 Lisp_Object Qbit_vectorp, Qbitp, Qcdr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 Lisp_Object Qfloatp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 #ifdef DEBUG_XEMACS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 int debug_issue_ebola_notices;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 int debug_ebola_backtrace_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 eq_with_ebola_notice (Lisp_Object obj1, Lisp_Object obj2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 if (debug_issue_ebola_notices
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 && ((CHARP (obj1) && INTP (obj2)) || (CHARP (obj2) && INTP (obj1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 /* #### It would be really nice if this were a proper warning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 instead of brain-dead print ro Qexternal_debugging_output. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 write_c_string ("Comparison between integer and character is constant nil (",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 Qexternal_debugging_output);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 Fprinc (obj1, Qexternal_debugging_output);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 write_c_string (" and ", Qexternal_debugging_output);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 Fprinc (obj2, Qexternal_debugging_output);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 write_c_string (")\n", Qexternal_debugging_output);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 debug_short_backtrace (debug_ebola_backtrace_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 return EQ (obj1, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 #endif /* DEBUG_XEMACS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 wrong_type_argument (Lisp_Object predicate, Lisp_Object value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 REGISTER Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 value = Fsignal (Qwrong_type_argument, list2 (predicate, value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 tem = call1 (predicate, value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 while (NILP (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 return value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 DOESNT_RETURN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 dead_wrong_type_argument (Lisp_Object predicate, Lisp_Object value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 signal_error (Qwrong_type_argument, list2 (predicate, value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 DEFUN ("wrong-type-argument", Fwrong_type_argument, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 Signal an error until the correct type value is given by the user.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 This function loops, signalling a continuable `wrong-type-argument' error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 with PREDICATE and VALUE as the data associated with the error and then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 calling PREDICATE on the returned value, until the value gotten satisfies
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 PREDICATE. At that point, the gotten value is returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 (predicate, value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 return wrong_type_argument (predicate, value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 DOESNT_RETURN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 c_write_error (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 signal_simple_error ("Attempt to modify read-only object (c)", obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 DOESNT_RETURN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 lisp_write_error (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 signal_simple_error ("Attempt to modify read-only object (lisp)", obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 DOESNT_RETURN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 args_out_of_range (Lisp_Object a1, Lisp_Object a2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 signal_error (Qargs_out_of_range, list2 (a1, a2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 DOESNT_RETURN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 signal_error (Qargs_out_of_range, list3 (a1, a2, a3));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 check_int_range (EMACS_INT val, EMACS_INT min, EMACS_INT max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 if (val < min || val > max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 args_out_of_range_3 (make_int (val), make_int (min), make_int (max));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 /* On some machines, XINT needs a temporary location.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 Here it is, in case it is needed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 EMACS_INT sign_extend_temp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 /* On a few machines, XINT can only be done by calling this. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 /* XEmacs: only used by m/convex.h */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 EMACS_INT sign_extend_lisp_int (EMACS_INT num);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 EMACS_INT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 sign_extend_lisp_int (EMACS_INT num)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 if (num & (1L << (VALBITS - 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 return num | ((-1L) << VALBITS);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 return num & ((1L << VALBITS) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 /* Data type predicates */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 DEFUN ("eq", Feq, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 Return t if the two args are the same Lisp object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 (obj1, obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 return EQ_WITH_EBOLA_NOTICE (obj1, obj2) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 DEFUN ("old-eq", Fold_eq, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 Return t if the two args are (in most cases) the same Lisp object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 Special kludge: A character is considered `old-eq' to its equivalent integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 even though they are not the same object and are in fact of different
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 types. This is ABSOLUTELY AND UTTERLY HORRENDOUS but is necessary to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 preserve byte-code compatibility with v19. This kludge is known as the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 \"char-int confoundance disease\" and appears in a number of other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 functions with `old-foo' equivalents.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 Do not use this function!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (obj1, obj2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 /* #### blasphemy */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 return HACKEQ_UNSAFE (obj1, obj2) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 DEFUN ("null", Fnull, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 Return t if OBJECT is nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 return NILP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 DEFUN ("consp", Fconsp, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 Return t if OBJECT is a cons cell. `nil' is not a cons cell.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 return CONSP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 DEFUN ("atom", Fatom, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 Return t if OBJECT is not a cons cell. `nil' is not a cons cell.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 return CONSP (object) ? Qnil : Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 DEFUN ("listp", Flistp, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 Return t if OBJECT is a list. `nil' is a list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 return LISTP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 DEFUN ("nlistp", Fnlistp, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 Return t if OBJECT is not a list. `nil' is a list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 return LISTP (object) ? Qnil : Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 DEFUN ("true-list-p", Ftrue_list_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 Return t if OBJECT is a non-dotted, i.e. nil-terminated, list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 return TRUE_LIST_P (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 DEFUN ("symbolp", Fsymbolp, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 Return t if OBJECT is a symbol.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 return SYMBOLP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 DEFUN ("keywordp", Fkeywordp, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 Return t if OBJECT is a keyword.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 return KEYWORDP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 DEFUN ("vectorp", Fvectorp, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 Return t if OBJECT is a vector.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 return VECTORP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 DEFUN ("bit-vector-p", Fbit_vector_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 Return t if OBJECT is a bit vector.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 return BIT_VECTORP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 DEFUN ("stringp", Fstringp, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 Return t if OBJECT is a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 return STRINGP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 DEFUN ("arrayp", Farrayp, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 Return t if OBJECT is an array (string, vector, or bit vector).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 return (VECTORP (object) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 STRINGP (object) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 BIT_VECTORP (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 DEFUN ("sequencep", Fsequencep, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 Return t if OBJECT is a sequence (list or array).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 return (LISTP (object) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 VECTORP (object) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 STRINGP (object) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 BIT_VECTORP (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 DEFUN ("markerp", Fmarkerp, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 Return t if OBJECT is a marker (editor pointer).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 return MARKERP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 DEFUN ("subrp", Fsubrp, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 Return t if OBJECT is a built-in function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 return SUBRP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 DEFUN ("subr-min-args", Fsubr_min_args, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 Return minimum number of args built-in function SUBR may be called with.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 (subr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 CHECK_SUBR (subr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 return make_int (XSUBR (subr)->min_args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 DEFUN ("subr-max-args", Fsubr_max_args, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 Return maximum number of args built-in function SUBR may be called with,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 or nil if it takes an arbitrary number of arguments or is a special form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 (subr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 int nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 CHECK_SUBR (subr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 nargs = XSUBR (subr)->max_args;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 if (nargs == MANY || nargs == UNEVALLED)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 return make_int (nargs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 DEFUN ("subr-interactive", Fsubr_interactive, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 Return the interactive spec of the subr object, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 If non-nil, the return value will be a list whose first element is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 `interactive' and whose second element is the interactive spec.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 (subr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 CONST char *prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 CHECK_SUBR (subr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 prompt = XSUBR (subr)->prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 return prompt ? list2 (Qinteractive, build_string (prompt)) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 DEFUN ("characterp", Fcharacterp, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 Return t if OBJECT is a character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 Unlike in XEmacs v19 and FSF Emacs, a character is its own primitive type.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 Any character can be converted into an equivalent integer using
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 `char-int'. To convert the other way, use `int-char'; however,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 only some integers can be converted into characters. Such an integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 is called a `char-int'; see `char-int-p'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 Some functions that work on integers (e.g. the comparison functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 <, <=, =, /=, etc. and the arithmetic functions +, -, *, etc.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 accept characters and implicitly convert them into integers. In
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 general, functions that work on characters also accept char-ints and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 implicitly convert them into characters. WARNING: Neither of these
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 behaviors is very desirable, and they are maintained for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 compatibility with old E-Lisp programs that confounded characters and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 integers willy-nilly. These behaviors may change in the future; therefore,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 do not rely on them. Instead, use the character-specific functions such
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 as `char='.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 return CHARP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 DEFUN ("char-to-int", Fchar_to_int, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 Convert a character into an equivalent integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 The resulting integer will always be non-negative. The integers in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 the range 0 - 255 map to characters as follows:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 0 - 31 Control set 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 32 - 127 ASCII
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 128 - 159 Control set 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 160 - 255 Right half of ISO-8859-1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 If support for Mule does not exist, these are the only valid character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 values. When Mule support exists, the values assigned to other characters
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 may vary depending on the particular version of XEmacs, the order in which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 character sets were loaded, etc., and you should not depend on them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (ch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 CHECK_CHAR (ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 return make_int (XCHAR (ch));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 DEFUN ("int-to-char", Fint_to_char, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 Convert an integer into the equivalent character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 Not all integers correspond to valid characters; use `char-int-p' to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 determine whether this is the case. If the integer cannot be converted,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 nil is returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 (integer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 CHECK_INT (integer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 if (CHAR_INTP (integer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 return make_char (XINT (integer));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 DEFUN ("char-int-p", Fchar_int_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 Return t if OBJECT is an integer that can be converted into a character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 See `char-int'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 return CHAR_INTP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 DEFUN ("char-or-char-int-p", Fchar_or_char_int_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 Return t if OBJECT is a character or an integer that can be converted into one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 return CHAR_OR_CHAR_INTP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 DEFUN ("char-or-string-p", Fchar_or_string_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 Return t if OBJECT is a character (or a char-int) or a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 It is semi-hateful that we allow a char-int here, as it goes against
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 the name of this function, but it makes the most sense considering the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 other steps we take to maintain compatibility with the old character/integer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 confoundedness in older versions of E-Lisp.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 return CHAR_OR_CHAR_INTP (object) || STRINGP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 DEFUN ("integerp", Fintegerp, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 Return t if OBJECT is an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 return INTP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 DEFUN ("integer-or-marker-p", Finteger_or_marker_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 Return t if OBJECT is an integer or a marker (editor pointer).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 return INTP (object) || MARKERP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 DEFUN ("integer-or-char-p", Finteger_or_char_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 Return t if OBJECT is an integer or a character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 return INTP (object) || CHARP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 DEFUN ("integer-char-or-marker-p", Finteger_char_or_marker_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 Return t if OBJECT is an integer, character or a marker (editor pointer).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 return INTP (object) || CHARP (object) || MARKERP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 DEFUN ("natnump", Fnatnump, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 Return t if OBJECT is a nonnegative integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 return NATNUMP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 DEFUN ("bitp", Fbitp, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 Return t if OBJECT is a bit (0 or 1).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 return BITP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 DEFUN ("numberp", Fnumberp, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 Return t if OBJECT is a number (floating point or integer).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 return INT_OR_FLOATP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 DEFUN ("number-or-marker-p", Fnumber_or_marker_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 Return t if OBJECT is a number or a marker.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 return INT_OR_FLOATP (object) || MARKERP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 DEFUN ("number-char-or-marker-p", Fnumber_char_or_marker_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 Return t if OBJECT is a number, character or a marker.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 return (INT_OR_FLOATP (object) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 CHARP (object) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 MARKERP (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 DEFUN ("floatp", Ffloatp, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 Return t if OBJECT is a floating point number.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 return FLOATP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 DEFUN ("type-of", Ftype_of, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 Return a symbol representing the type of OBJECT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 switch (XTYPE (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 case Lisp_Type_Record:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 return intern (XRECORD_LHEADER_IMPLEMENTATION (object)->name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 case Lisp_Type_Char: return Qcharacter;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 default: return Qinteger;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 /* Extract and set components of lists */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 DEFUN ("car", Fcar, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 Return the car of LIST. If arg is nil, return nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 Error if arg is not nil and not a cons cell. See also `car-safe'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 if (CONSP (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 return XCAR (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 else if (NILP (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 list = wrong_type_argument (Qlistp, list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 DEFUN ("car-safe", Fcar_safe, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 Return the car of OBJECT if it is a cons cell, or else nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 return CONSP (object) ? XCAR (object) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 DEFUN ("cdr", Fcdr, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 Return the cdr of LIST. If arg is nil, return nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 Error if arg is not nil and not a cons cell. See also `cdr-safe'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 if (CONSP (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 return XCDR (list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 else if (NILP (list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 list = wrong_type_argument (Qlistp, list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 DEFUN ("cdr-safe", Fcdr_safe, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 Return the cdr of OBJECT if it is a cons cell, else nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 return CONSP (object) ? XCDR (object) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 DEFUN ("setcar", Fsetcar, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 Set the car of CONSCELL to be NEWCAR. Return NEWCAR.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 (conscell, newcar))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 if (!CONSP (conscell))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 conscell = wrong_type_argument (Qconsp, conscell);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 XCAR (conscell) = newcar;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 return newcar;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 DEFUN ("setcdr", Fsetcdr, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 Set the cdr of CONSCELL to be NEWCDR. Return NEWCDR.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 (conscell, newcdr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 if (!CONSP (conscell))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 conscell = wrong_type_argument (Qconsp, conscell);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 XCDR (conscell) = newcdr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 return newcdr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 /* Find the function at the end of a chain of symbol function indirections.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 If OBJECT is a symbol, find the end of its function chain and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 return the value found there. If OBJECT is not a symbol, just
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 return it. If there is a cycle in the function chain, signal a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 cyclic-function-indirection error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 This is like Findirect_function, except that it doesn't signal an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 error if the chain ends up unbound. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 indirect_function (Lisp_Object object, int errorp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 #define FUNCTION_INDIRECTION_SUSPICION_LENGTH 16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 Lisp_Object tortoise, hare;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 int count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 for (hare = tortoise = object, count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 SYMBOLP (hare);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 hare = XSYMBOL (hare)->function, count++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 if (count < FUNCTION_INDIRECTION_SUSPICION_LENGTH) continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 if (count & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 tortoise = XSYMBOL (tortoise)->function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 if (EQ (hare, tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 return Fsignal (Qcyclic_function_indirection, list1 (object));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 if (errorp && UNBOUNDP (hare))
436
080151679be2 Import from CVS: tag r21-2-26
cvs
parents: 428
diff changeset
663 return signal_void_function_error (object);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 return hare;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 DEFUN ("indirect-function", Findirect_function, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 Return the function at the end of OBJECT's function chain.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 If OBJECT is a symbol, follow all function indirections and return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 the final function binding.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 If OBJECT is not a symbol, just return it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 Signal a void-function error if the final symbol is unbound.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 Signal a cyclic-function-indirection error if there is a loop in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 function chain of symbols.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 return indirect_function (object, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 /* Extract and set vector and string elements */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 DEFUN ("aref", Faref, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 Return the element of ARRAY at index INDEX.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 ARRAY may be a vector, bit vector, or string. INDEX starts at 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 (array, index_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 EMACS_INT idx;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 if (INTP (index_)) idx = XINT (index_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 index_ = wrong_type_argument (Qinteger_or_char_p, index_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 if (idx < 0) goto range_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 if (VECTORP (array))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 if (idx >= XVECTOR_LENGTH (array)) goto range_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 return XVECTOR_DATA (array)[idx];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 else if (BIT_VECTORP (array))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 if (idx >= bit_vector_length (XBIT_VECTOR (array))) goto range_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 return make_int (bit_vector_bit (XBIT_VECTOR (array), idx));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 else if (STRINGP (array))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 if (idx >= XSTRING_CHAR_LENGTH (array)) goto range_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 return make_char (string_char (XSTRING (array), idx));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 #ifdef LOSING_BYTECODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 else if (COMPILED_FUNCTIONP (array))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 /* Weird, gross compatibility kludge */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 return Felt (array, index_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 check_losing_bytecode ("aref", array);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 array = wrong_type_argument (Qarrayp, array);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 range_error:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 args_out_of_range (array, index_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 return Qnil; /* not reached */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 DEFUN ("aset", Faset, 3, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 Store into the element of ARRAY at index INDEX the value NEWVAL.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 ARRAY may be a vector, bit vector, or string. INDEX starts at 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 (array, index_, newval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 EMACS_INT idx;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 if (INTP (index_)) idx = XINT (index_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 index_ = wrong_type_argument (Qinteger_or_char_p, index_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 if (idx < 0) goto range_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 if (VECTORP (array))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 if (idx >= XVECTOR_LENGTH (array)) goto range_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 XVECTOR_DATA (array)[idx] = newval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 else if (BIT_VECTORP (array))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 if (idx >= bit_vector_length (XBIT_VECTOR (array))) goto range_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 CHECK_BIT (newval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 set_bit_vector_bit (XBIT_VECTOR (array), idx, !ZEROP (newval));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 else if (STRINGP (array))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 CHECK_CHAR_COERCE_INT (newval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 if (idx >= XSTRING_CHAR_LENGTH (array)) goto range_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 set_string_char (XSTRING (array), idx, XCHAR (newval));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 bump_string_modiff (array);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 array = wrong_type_argument (Qarrayp, array);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 return newval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 range_error:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 args_out_of_range (array, index_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 return Qnil; /* not reached */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 /* Arithmetic functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 /**********************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 typedef struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 int int_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 union
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 EMACS_INT ival;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 double dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 } c;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 } int_or_double;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 number_char_or_marker_to_int_or_double (Lisp_Object obj, int_or_double *p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 p->int_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 if (INTP (obj)) p->c.ival = XINT (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 else if (CHARP (obj)) p->c.ival = XCHAR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 else if (MARKERP (obj)) p->c.ival = marker_position (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 else if (FLOATP (obj)) p->c.dval = XFLOAT_DATA (obj), p->int_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 obj = wrong_type_argument (Qnumber_char_or_marker_p, obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 static double
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 number_char_or_marker_to_double (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 if (INTP (obj)) return (double) XINT (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 else if (CHARP (obj)) return (double) XCHAR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 else if (MARKERP (obj)) return (double) marker_position (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 else if (FLOATP (obj)) return XFLOAT_DATA (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 obj = wrong_type_argument (Qnumber_char_or_marker_p, obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 static EMACS_INT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 integer_char_or_marker_to_int (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 if (INTP (obj)) return XINT (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 else if (CHARP (obj)) return XCHAR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 else if (MARKERP (obj)) return marker_position (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 obj = wrong_type_argument (Qinteger_char_or_marker_p, obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 #define ARITHCOMPARE_MANY(op) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 int_or_double iod1, iod2, *p = &iod1, *q = &iod2; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 Lisp_Object *args_end = args + nargs; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 number_char_or_marker_to_int_or_double (*args++, p); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 while (args < args_end) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 number_char_or_marker_to_int_or_double (*args++, q); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 if (!((p->int_p && q->int_p) ? \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 (p->c.ival op q->c.ival) : \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 ((p->int_p ? (double) p->c.ival : p->c.dval) op \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 (q->int_p ? (double) q->c.ival : q->c.dval)))) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 return Qnil; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 { /* swap */ int_or_double *r = p; p = q; q = r; } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 return Qt; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 DEFUN ("=", Feqlsign, 1, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 Return t if all the arguments are numerically equal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 The arguments may be numbers, characters or markers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 ARITHCOMPARE_MANY (==)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 DEFUN ("<", Flss, 1, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 Return t if the sequence of arguments is monotonically increasing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 The arguments may be numbers, characters or markers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 ARITHCOMPARE_MANY (<)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 DEFUN (">", Fgtr, 1, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 Return t if the sequence of arguments is monotonically decreasing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 The arguments may be numbers, characters or markers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 ARITHCOMPARE_MANY (>)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 DEFUN ("<=", Fleq, 1, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 Return t if the sequence of arguments is monotonically nondecreasing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 The arguments may be numbers, characters or markers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 ARITHCOMPARE_MANY (<=)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 DEFUN (">=", Fgeq, 1, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 Return t if the sequence of arguments is monotonically nonincreasing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 The arguments may be numbers, characters or markers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 ARITHCOMPARE_MANY (>=)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 DEFUN ("/=", Fneq, 1, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 Return t if no two arguments are numerically equal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 The arguments may be numbers, characters or markers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 Lisp_Object *args_end = args + nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 Lisp_Object *p, *q;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 /* Unlike all the other comparisons, this is an N*N algorithm.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 We could use a hash table for nargs > 50 to make this linear. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 for (p = args; p < args_end; p++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 int_or_double iod1, iod2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 number_char_or_marker_to_int_or_double (*p, &iod1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 for (q = p + 1; q < args_end; q++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 number_char_or_marker_to_int_or_double (*q, &iod2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 if (!((iod1.int_p && iod2.int_p) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 (iod1.c.ival != iod2.c.ival) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 ((iod1.int_p ? (double) iod1.c.ival : iod1.c.dval) !=
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 (iod2.int_p ? (double) iod2.c.ival : iod2.c.dval))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 DEFUN ("zerop", Fzerop, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 Return t if NUMBER is zero.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 (number))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 if (INTP (number))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 return EQ (number, Qzero) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 else if (FLOATP (number))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 return XFLOAT_DATA (number) == 0.0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 number = wrong_type_argument (Qnumberp, number);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 /* Convert between a 32-bit value and a cons of two 16-bit values.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 This is used to pass 32-bit integers to and from the user.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 Use time_to_lisp() and lisp_to_time() for time values.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 If you're thinking of using this to store a pointer into a Lisp Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 for internal purposes (such as when calling record_unwind_protect()),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 try using make_opaque_ptr()/get_opaque_ptr() instead. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 word_to_lisp (unsigned int item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 return Fcons (make_int (item >> 16), make_int (item & 0xffff));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 unsigned int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 lisp_to_word (Lisp_Object item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 if (INTP (item))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 return XINT (item);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 Lisp_Object top = Fcar (item);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 Lisp_Object bot = Fcdr (item);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 CHECK_INT (top);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 CHECK_INT (bot);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 return (XINT (top) << 16) | (XINT (bot) & 0xffff);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 DEFUN ("number-to-string", Fnumber_to_string, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 Convert NUM to a string by printing it in decimal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 Uses a minus sign if negative.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 NUM may be an integer or a floating point number.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 (num))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 char buffer[VALBITS];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 CHECK_INT_OR_FLOAT (num);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 if (FLOATP (num))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 char pigbuf[350]; /* see comments in float_to_string */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 float_to_string (pigbuf, XFLOAT_DATA (num));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 return build_string (pigbuf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 long_to_string (buffer, XINT (num));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 return build_string (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 digit_to_number (int character, int base)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 /* Assumes ASCII */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 int digit = ((character >= '0' && character <= '9') ? character - '0' :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 (character >= 'a' && character <= 'z') ? character - 'a' + 10 :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 (character >= 'A' && character <= 'Z') ? character - 'A' + 10 :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 return digit >= base ? -1 : digit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 DEFUN ("string-to-number", Fstring_to_number, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 Convert STRING to a number by parsing it as a decimal number.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 This parses both integers and floating point numbers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 It ignores leading spaces and tabs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 If BASE, interpret STRING as a number in that base. If BASE isn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 present, base 10 is used. BASE must be between 2 and 16 (inclusive).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 Floating point numbers always use base 10.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 (string, base))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 char *p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 int b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 if (NILP (base))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 b = 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 CHECK_INT (base);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 b = XINT (base);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 check_int_range (b, 2, 16);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 p = (char *) XSTRING_DATA (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 /* Skip any whitespace at the front of the number. Some versions of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 atoi do this anyway, so we might as well make Emacs lisp consistent. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 while (*p == ' ' || *p == '\t')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 if (isfloat_string (p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 return make_float (atof (p));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 if (b == 10)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 /* Use the system-provided functions for base 10. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 #if SIZEOF_EMACS_INT == SIZEOF_INT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 return make_int (atoi (p));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 #elif SIZEOF_EMACS_INT == SIZEOF_LONG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 return make_int (atol (p));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 #elif SIZEOF_EMACS_INT == SIZEOF_LONG_LONG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 return make_int (atoll (p));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 int digit, negative = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 EMACS_INT v = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 if (*p == '-')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 negative = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 else if (*p == '+')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 digit = digit_to_number (*p++, b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 if (digit < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 v = v * b + digit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 return make_int (negative * v);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 DEFUN ("+", Fplus, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 Return sum of any number of arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 The arguments should all be numbers, characters or markers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 EMACS_INT iaccum = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 Lisp_Object *args_end = args + nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 while (args < args_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 int_or_double iod;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 number_char_or_marker_to_int_or_double (*args++, &iod);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 if (iod.int_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 iaccum += iod.c.ival;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 double daccum = (double) iaccum + iod.c.dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 while (args < args_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 daccum += number_char_or_marker_to_double (*args++);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 return make_float (daccum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 return make_int (iaccum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 DEFUN ("-", Fminus, 1, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 Negate number or subtract numbers, characters or markers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 With one arg, negates it. With more than one arg,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 subtracts all but the first from the first.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 EMACS_INT iaccum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 double daccum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 Lisp_Object *args_end = args + nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 int_or_double iod;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 number_char_or_marker_to_int_or_double (*args++, &iod);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 if (iod.int_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 iaccum = nargs > 1 ? iod.c.ival : - iod.c.ival;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 daccum = nargs > 1 ? iod.c.dval : - iod.c.dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 goto do_float;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 while (args < args_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 number_char_or_marker_to_int_or_double (*args++, &iod);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 if (iod.int_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 iaccum -= iod.c.ival;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 daccum = (double) iaccum - iod.c.dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 goto do_float;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 return make_int (iaccum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 do_float:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 for (; args < args_end; args++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 daccum -= number_char_or_marker_to_double (*args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 return make_float (daccum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 DEFUN ("*", Ftimes, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 Return product of any number of arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 The arguments should all be numbers, characters or markers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 EMACS_INT iaccum = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 Lisp_Object *args_end = args + nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 while (args < args_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 int_or_double iod;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 number_char_or_marker_to_int_or_double (*args++, &iod);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 if (iod.int_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 iaccum *= iod.c.ival;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 double daccum = (double) iaccum * iod.c.dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 while (args < args_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 daccum *= number_char_or_marker_to_double (*args++);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 return make_float (daccum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 return make_int (iaccum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 DEFUN ("/", Fquo, 1, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 Return first argument divided by all the remaining arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 The arguments must be numbers, characters or markers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 With one argument, reciprocates the argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 EMACS_INT iaccum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 double daccum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 Lisp_Object *args_end = args + nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 int_or_double iod;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 if (nargs == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 iaccum = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 number_char_or_marker_to_int_or_double (*args++, &iod);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 if (iod.int_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 iaccum = iod.c.ival;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 daccum = iod.c.dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 goto divide_floats;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 while (args < args_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 number_char_or_marker_to_int_or_double (*args++, &iod);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 if (iod.int_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 if (iod.c.ival == 0) goto divide_by_zero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 iaccum /= iod.c.ival;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 if (iod.c.dval == 0) goto divide_by_zero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 daccum = (double) iaccum / iod.c.dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 goto divide_floats;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 return make_int (iaccum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 divide_floats:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 for (; args < args_end; args++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 double dval = number_char_or_marker_to_double (*args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 if (dval == 0) goto divide_by_zero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 daccum /= dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 return make_float (daccum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 divide_by_zero:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 return Qnil; /* not reached */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 DEFUN ("max", Fmax, 1, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 Return largest of all the arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 All arguments must be numbers, characters or markers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 The value is always a number; markers and characters are converted
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 to numbers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 EMACS_INT imax;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 double dmax;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 Lisp_Object *args_end = args + nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 int_or_double iod;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 number_char_or_marker_to_int_or_double (*args++, &iod);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 if (iod.int_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 imax = iod.c.ival;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 dmax = iod.c.dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 goto max_floats;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 while (args < args_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 number_char_or_marker_to_int_or_double (*args++, &iod);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 if (iod.int_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 if (imax < iod.c.ival) imax = iod.c.ival;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 dmax = (double) imax;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 if (dmax < iod.c.dval) dmax = iod.c.dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 goto max_floats;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 return make_int (imax);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 max_floats:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 while (args < args_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 double dval = number_char_or_marker_to_double (*args++);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 if (dmax < dval) dmax = dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 return make_float (dmax);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 DEFUN ("min", Fmin, 1, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 Return smallest of all the arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 All arguments must be numbers, characters or markers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 The value is always a number; markers and characters are converted
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 to numbers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 EMACS_INT imin;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 double dmin;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 Lisp_Object *args_end = args + nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 int_or_double iod;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 number_char_or_marker_to_int_or_double (*args++, &iod);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 if (iod.int_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 imin = iod.c.ival;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 dmin = iod.c.dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 goto min_floats;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 while (args < args_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 number_char_or_marker_to_int_or_double (*args++, &iod);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 if (iod.int_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 if (imin > iod.c.ival) imin = iod.c.ival;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 dmin = (double) imin;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 if (dmin > iod.c.dval) dmin = iod.c.dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 goto min_floats;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 return make_int (imin);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 min_floats:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 while (args < args_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 double dval = number_char_or_marker_to_double (*args++);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 if (dmin > dval) dmin = dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 return make_float (dmin);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 DEFUN ("logand", Flogand, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 Return bitwise-and of all the arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 Arguments may be integers, or markers or characters converted to integers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 EMACS_INT bits = ~0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 Lisp_Object *args_end = args + nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 while (args < args_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 bits &= integer_char_or_marker_to_int (*args++);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 return make_int (bits);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 DEFUN ("logior", Flogior, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 Return bitwise-or of all the arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 Arguments may be integers, or markers or characters converted to integers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 EMACS_INT bits = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 Lisp_Object *args_end = args + nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 while (args < args_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 bits |= integer_char_or_marker_to_int (*args++);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 return make_int (bits);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 DEFUN ("logxor", Flogxor, 0, MANY, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 Return bitwise-exclusive-or of all the arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 Arguments may be integers, or markers or characters converted to integers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 (int nargs, Lisp_Object *args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 EMACS_INT bits = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 Lisp_Object *args_end = args + nargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 while (args < args_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 bits ^= integer_char_or_marker_to_int (*args++);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 return make_int (bits);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 DEFUN ("lognot", Flognot, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 Return the bitwise complement of NUMBER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 NUMBER may be an integer, marker or character converted to integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 (number))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 return make_int (~ integer_char_or_marker_to_int (number));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 DEFUN ("%", Frem, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 Return remainder of first arg divided by second.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 Both must be integers, characters or markers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 (num1, num2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 EMACS_INT ival1 = integer_char_or_marker_to_int (num1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 EMACS_INT ival2 = integer_char_or_marker_to_int (num2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 if (ival2 == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 return make_int (ival1 % ival2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 /* Note, ANSI *requires* the presence of the fmod() library routine.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 If your system doesn't have it, complain to your vendor, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 that is a bug. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 #ifndef HAVE_FMOD
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 double
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 fmod (double f1, double f2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 if (f2 < 0.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 f2 = -f2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 return f1 - f2 * floor (f1/f2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 #endif /* ! HAVE_FMOD */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 DEFUN ("mod", Fmod, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 Return X modulo Y.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 The result falls between zero (inclusive) and Y (exclusive).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 Both X and Y must be numbers, characters or markers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 If either argument is a float, a float will be returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 (x, y))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 int_or_double iod1, iod2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 number_char_or_marker_to_int_or_double (x, &iod1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 number_char_or_marker_to_int_or_double (y, &iod2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 if (!iod1.int_p || !iod2.int_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 double dval1 = iod1.int_p ? (double) iod1.c.ival : iod1.c.dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 double dval2 = iod2.int_p ? (double) iod2.c.ival : iod2.c.dval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 if (dval2 == 0) goto divide_by_zero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 dval1 = fmod (dval1, dval2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 /* If the "remainder" comes out with the wrong sign, fix it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 if (dval2 < 0 ? dval1 > 0 : dval1 < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 dval1 += dval2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 return make_float (dval1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 EMACS_INT ival;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 if (iod2.c.ival == 0) goto divide_by_zero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 ival = iod1.c.ival % iod2.c.ival;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 /* If the "remainder" comes out with the wrong sign, fix it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 if (iod2.c.ival < 0 ? ival > 0 : ival < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 ival += iod2.c.ival;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 return make_int (ival);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 divide_by_zero:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 return Qnil; /* not reached */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 DEFUN ("ash", Fash, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 Return VALUE with its bits shifted left by COUNT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 If COUNT is negative, shifting is actually to the right.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 In this case, the sign bit is duplicated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 (value, count))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 CHECK_INT_COERCE_CHAR (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 CONCHECK_INT (count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 return make_int (XINT (count) > 0 ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 XINT (value) << XINT (count) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 XINT (value) >> -XINT (count));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 DEFUN ("lsh", Flsh, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 Return VALUE with its bits shifted left by COUNT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 If COUNT is negative, shifting is actually to the right.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 In this case, zeros are shifted in on the left.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 (value, count))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 CHECK_INT_COERCE_CHAR (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 CONCHECK_INT (count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 return make_int (XINT (count) > 0 ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 XUINT (value) << XINT (count) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 XUINT (value) >> -XINT (count));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 DEFUN ("1+", Fadd1, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 Return NUMBER plus one. NUMBER may be a number, character or marker.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 Markers and characters are converted to integers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 (number))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 if (INTP (number)) return make_int (XINT (number) + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 if (CHARP (number)) return make_int (XCHAR (number) + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 if (MARKERP (number)) return make_int (marker_position (number) + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 if (FLOATP (number)) return make_float (XFLOAT_DATA (number) + 1.0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 number = wrong_type_argument (Qnumber_char_or_marker_p, number);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 DEFUN ("1-", Fsub1, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 Return NUMBER minus one. NUMBER may be a number, character or marker.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 Markers and characters are converted to integers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 (number))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 if (INTP (number)) return make_int (XINT (number) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 if (CHARP (number)) return make_int (XCHAR (number) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 if (MARKERP (number)) return make_int (marker_position (number) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 if (FLOATP (number)) return make_float (XFLOAT_DATA (number) - 1.0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 number = wrong_type_argument (Qnumber_char_or_marker_p, number);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 /* weak lists */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 /* A weak list is like a normal list except that elements automatically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 disappear when no longer in use, i.e. when no longer GC-protected.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 The basic idea is that we don't mark the elements during GC, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 wait for them to be marked elsewhere. If they're not marked, we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 remove them. This is analogous to weak hash tables; see the explanation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 there for more info. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 static Lisp_Object Vall_weak_lists; /* Gemarke es nicht!!! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 static Lisp_Object encode_weak_list_type (enum weak_list_type type);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 mark_weak_list (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 return Qnil; /* nichts ist gemarkt */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 print_weak_list (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 if (print_readably)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 error ("printing unreadable object #<weak-list>");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 write_c_string ("#<weak-list ", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 print_internal (encode_weak_list_type (XWEAK_LIST (obj)->type),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 printcharfun, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 write_c_string (" ", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 print_internal (XWEAK_LIST (obj)->list, printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 write_c_string (">", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 weak_list_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 struct weak_list *w1 = XWEAK_LIST (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 struct weak_list *w2 = XWEAK_LIST (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 return ((w1->type == w2->type) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 internal_equal (w1->list, w2->list, depth + 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 static unsigned long
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 weak_list_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 struct weak_list *w = XWEAK_LIST (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 return HASH2 ((unsigned long) w->type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 internal_hash (w->list, depth + 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 make_weak_list (enum weak_list_type type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 Lisp_Object result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 struct weak_list *wl =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 alloc_lcrecord_type (struct weak_list, &lrecord_weak_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 wl->list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 wl->type = type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 XSETWEAK_LIST (result, wl);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 wl->next_weak = Vall_weak_lists;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 Vall_weak_lists = result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 static const struct lrecord_description weak_list_description[] = {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
1623 { XD_LISP_OBJECT, offsetof (struct weak_list, list) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
1624 { XD_LO_LINK, offsetof (struct weak_list, next_weak) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 DEFINE_LRECORD_IMPLEMENTATION ("weak-list", weak_list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 mark_weak_list, print_weak_list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 0, weak_list_equal, weak_list_hash,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 weak_list_description,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 struct weak_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 -- we do not mark the list elements (either the elements themselves
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 or the cons cells that hold them) in the normal marking phase.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 -- at the end of marking, we go through all weak lists that are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 marked, and mark the cons cells that hold all marked
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 objects, and possibly parts of the objects themselves.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 (See alloc.c, "after-mark".)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 -- after that, we prune away all the cons cells that are not marked.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 WARNING WARNING WARNING WARNING WARNING:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 The code in the following two functions is *unbelievably* tricky.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 Don't mess with it. You'll be sorry.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 Linked lists just majorly suck, d'ya know?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 finish_marking_weak_lists (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 Lisp_Object rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 int did_mark = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 for (rest = Vall_weak_lists;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 !NILP (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 rest = XWEAK_LIST (rest)->next_weak)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 Lisp_Object rest2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 enum weak_list_type type = XWEAK_LIST (rest)->type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 if (! marked_p (rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 /* The weak list is probably garbage. Ignore it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 for (rest2 = XWEAK_LIST (rest)->list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 /* We need to be trickier since we're inside of GC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 use CONSP instead of !NILP in case of user-visible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 imperfect lists */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 CONSP (rest2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 rest2 = XCDR (rest2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 Lisp_Object elem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 /* If the element is "marked" (meaning depends on the type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 of weak list), we need to mark the cons containing the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 element, and maybe the element itself (if only some part
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 was already marked). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 int need_to_mark_cons = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 int need_to_mark_elem = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 /* If a cons is already marked, then its car is already marked
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 (either because of an external pointer or because of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 a previous call to this function), and likewise for all
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 the rest of the elements in the list, so we can stop now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 if (marked_p (rest2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 elem = XCAR (rest2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 switch (type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 case WEAK_LIST_SIMPLE:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 if (marked_p (elem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 need_to_mark_cons = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 case WEAK_LIST_ASSOC:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 if (!CONSP (elem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 /* just leave bogus elements there */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 need_to_mark_cons = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 need_to_mark_elem = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 else if (marked_p (XCAR (elem)) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 marked_p (XCDR (elem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 need_to_mark_cons = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 /* We still need to mark elem, because it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 probably not marked. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 need_to_mark_elem = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 case WEAK_LIST_KEY_ASSOC:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 if (!CONSP (elem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 /* just leave bogus elements there */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 need_to_mark_cons = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 need_to_mark_elem = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722 else if (marked_p (XCAR (elem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 need_to_mark_cons = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 /* We still need to mark elem and XCDR (elem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 marking elem does both */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 need_to_mark_elem = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 case WEAK_LIST_VALUE_ASSOC:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 if (!CONSP (elem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 /* just leave bogus elements there */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 need_to_mark_cons = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 need_to_mark_elem = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 else if (marked_p (XCDR (elem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 need_to_mark_cons = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 /* We still need to mark elem and XCAR (elem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 marking elem does both */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 need_to_mark_elem = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 if (need_to_mark_elem && ! marked_p (elem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 mark_object (elem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 did_mark = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 /* We also need to mark the cons that holds the elem or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 assoc-pair. We do *not* want to call (mark_object) here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 because that will mark the entire list; we just want to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 mark the cons itself.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 if (need_to_mark_cons)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 Lisp_Cons *c = XCONS (rest2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 if (!CONS_MARKED_P (c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 MARK_CONS (c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 did_mark = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 /* In case of imperfect list, need to mark the final cons
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 because we're not removing it */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 if (!NILP (rest2) && ! marked_p (rest2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 mark_object (rest2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 did_mark = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 return did_mark;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 prune_weak_lists (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 Lisp_Object rest, prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 for (rest = Vall_weak_lists;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 !NILP (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 rest = XWEAK_LIST (rest)->next_weak)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 if (! (marked_p (rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 /* This weak list itself is garbage. Remove it from the list. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 if (NILP (prev))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 Vall_weak_lists = XWEAK_LIST (rest)->next_weak;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 XWEAK_LIST (prev)->next_weak =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 XWEAK_LIST (rest)->next_weak;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 Lisp_Object rest2, prev2 = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 Lisp_Object tortoise;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 int go_tortoise = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 for (rest2 = XWEAK_LIST (rest)->list, tortoise = rest2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 /* We need to be trickier since we're inside of GC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 use CONSP instead of !NILP in case of user-visible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 imperfect lists */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 CONSP (rest2);)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 /* It suffices to check the cons for marking,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 regardless of the type of weak list:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 -- if the cons is pointed to somewhere else,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 then it should stay around and will be marked.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 -- otherwise, if it should stay around, it will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 have been marked in finish_marking_weak_lists().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 -- otherwise, it's not marked and should disappear.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 if (! marked_p (rest2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 /* bye bye :-( */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 if (NILP (prev2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 XWEAK_LIST (rest)->list = XCDR (rest2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 XCDR (prev2) = XCDR (rest2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 rest2 = XCDR (rest2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 /* Ouch. Circularity checking is even trickier
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 than I thought. When we cut out a link
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 like this, we can't advance the turtle or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 it'll catch up to us. Imagine that we're
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 standing on floor tiles and moving forward --
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 what we just did here is as if the floor
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 tile under us just disappeared and all the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 ones ahead of us slid one tile towards us.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 In other words, we didn't move at all;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 if the tortoise was one step behind us
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 previously, it still is, and therefore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 it must not move. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 prev2 = rest2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 /* Implementing circularity checking is trickier here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 than in other places because we have to guarantee
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 that we've processed all elements before exiting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 due to a circularity. (In most places, an error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 is issued upon encountering a circularity, so it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 doesn't really matter if all elements are processed.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 The idea is that we process along with the hare
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 rather than the tortoise. If at any point in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 our forward process we encounter the tortoise,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 we must have already visited the spot, so we exit.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 (If we process with the tortoise, we can fail to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 process cases where a cons points to itself, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 where cons A points to cons B, which points to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 cons A.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 rest2 = XCDR (rest2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 if (go_tortoise)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 tortoise = XCDR (tortoise);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 go_tortoise = !go_tortoise;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 if (EQ (rest2, tortoise))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 prev = rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 static enum weak_list_type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 decode_weak_list_type (Lisp_Object symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 CHECK_SYMBOL (symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 if (EQ (symbol, Qsimple)) return WEAK_LIST_SIMPLE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 if (EQ (symbol, Qassoc)) return WEAK_LIST_ASSOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 if (EQ (symbol, Qold_assoc)) return WEAK_LIST_ASSOC; /* EBOLA ALERT! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 if (EQ (symbol, Qkey_assoc)) return WEAK_LIST_KEY_ASSOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 if (EQ (symbol, Qvalue_assoc)) return WEAK_LIST_VALUE_ASSOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 signal_simple_error ("Invalid weak list type", symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 return WEAK_LIST_SIMPLE; /* not reached */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 encode_weak_list_type (enum weak_list_type type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 switch (type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 case WEAK_LIST_SIMPLE: return Qsimple;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 case WEAK_LIST_ASSOC: return Qassoc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 case WEAK_LIST_KEY_ASSOC: return Qkey_assoc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 case WEAK_LIST_VALUE_ASSOC: return Qvalue_assoc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 return Qnil; /* not reached */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 DEFUN ("weak-list-p", Fweak_list_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 Return non-nil if OBJECT is a weak list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 return WEAK_LISTP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 DEFUN ("make-weak-list", Fmake_weak_list, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 Return a new weak list object of type TYPE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 A weak list object is an object that contains a list. This list behaves
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 like any other list except that its elements do not count towards
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 garbage collection -- if the only pointer to an object in inside a weak
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 list (other than pointers in similar objects such as weak hash tables),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 the object is garbage collected and automatically removed from the list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 This is used internally, for example, to manage the list holding the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 children of an extent -- an extent that is unused but has a parent will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 still be reclaimed, and will automatically be removed from its parent's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 list of children.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 Optional argument TYPE specifies the type of the weak list, and defaults
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 to `simple'. Recognized types are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 `simple' Objects in the list disappear if not pointed to.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 `assoc' Objects in the list disappear if they are conses
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 and either the car or the cdr of the cons is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 pointed to.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 `key-assoc' Objects in the list disappear if they are conses
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 and the car is not pointed to.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 `value-assoc' Objects in the list disappear if they are conses
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 and the cdr is not pointed to.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 (type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 if (NILP (type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 type = Qsimple;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 return make_weak_list (decode_weak_list_type (type));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 DEFUN ("weak-list-type", Fweak_list_type, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 Return the type of the given weak-list object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 (weak))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 CHECK_WEAK_LIST (weak);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 return encode_weak_list_type (XWEAK_LIST (weak)->type);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 DEFUN ("weak-list-list", Fweak_list_list, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 Return the list contained in a weak-list object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 (weak))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 CHECK_WEAK_LIST (weak);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 return XWEAK_LIST_LIST (weak);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 DEFUN ("set-weak-list-list", Fset_weak_list_list, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 Change the list contained in a weak-list object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 (weak, new_list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 CHECK_WEAK_LIST (weak);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 XWEAK_LIST_LIST (weak) = new_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 return new_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 static SIGTYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 arith_error (int signo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 EMACS_REESTABLISH_SIGNAL (signo, arith_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 EMACS_UNBLOCK_SIGNAL (signo);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 signal_error (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 init_data_very_early (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 /* Don't do this if just dumping out.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 We don't want to call `signal' in this case
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 so that we don't have trouble with dumping
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 signal-delivering routines in an inconsistent state. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 #ifndef CANNOT_DUMP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 if (!initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 #endif /* CANNOT_DUMP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 signal (SIGFPE, arith_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 #ifdef uts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 signal (SIGEMT, arith_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 #endif /* uts */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 init_errors_once_early (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 defsymbol (&Qerror_conditions, "error-conditions");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 defsymbol (&Qerror_message, "error-message");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 /* We declare the errors here because some other deferrors depend
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 on some of the errors below. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 /* ERROR is used as a signaler for random errors for which nothing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 else is right */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 deferror (&Qerror, "error", "error", Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 deferror (&Qquit, "quit", "Quit", Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 deferror (&Qwrong_type_argument, "wrong-type-argument",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 "Wrong type argument", Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 deferror (&Qargs_out_of_range, "args-out-of-range", "Args out of range",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 deferror (&Qvoid_function, "void-function",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 "Symbol's function definition is void", Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 deferror (&Qcyclic_function_indirection, "cyclic-function-indirection",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 "Symbol's chain of function indirections contains a loop", Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 deferror (&Qvoid_variable, "void-variable",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 "Symbol's value as variable is void", Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 deferror (&Qcyclic_variable_indirection, "cyclic-variable-indirection",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 "Symbol's chain of variable indirections contains a loop", Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 deferror (&Qsetting_constant, "setting-constant",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 "Attempt to set a constant symbol", Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 deferror (&Qinvalid_read_syntax, "invalid-read-syntax",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 "Invalid read syntax", Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 /* Generated by list traversal macros */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 deferror (&Qmalformed_list, "malformed-list",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 "Malformed list", Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 deferror (&Qmalformed_property_list, "malformed-property-list",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 "Malformed property list", Qmalformed_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 deferror (&Qcircular_list, "circular-list",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 "Circular list", Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 deferror (&Qcircular_property_list, "circular-property-list",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 "Circular property list", Qcircular_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 deferror (&Qinvalid_function, "invalid-function", "Invalid function",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 deferror (&Qwrong_number_of_arguments, "wrong-number-of-arguments",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 "Wrong number of arguments", Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 deferror (&Qno_catch, "no-catch", "No catch for tag",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 deferror (&Qbeginning_of_buffer, "beginning-of-buffer",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 "Beginning of buffer", Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 deferror (&Qend_of_buffer, "end-of-buffer", "End of buffer", Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 deferror (&Qbuffer_read_only, "buffer-read-only", "Buffer is read-only",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 deferror (&Qio_error, "io-error", "IO Error", Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 deferror (&Qend_of_file, "end-of-file", "End of stream", Qio_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 deferror (&Qarith_error, "arith-error", "Arithmetic error", Qerror);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 deferror (&Qrange_error, "range-error", "Arithmetic range error",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 Qarith_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 deferror (&Qdomain_error, "domain-error", "Arithmetic domain error",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 Qarith_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 deferror (&Qsingularity_error, "singularity-error",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 "Arithmetic singularity error", Qdomain_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 deferror (&Qoverflow_error, "overflow-error",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 "Arithmetic overflow error", Qdomain_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 deferror (&Qunderflow_error, "underflow-error",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 "Arithmetic underflow error", Qdomain_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 syms_of_data (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 defsymbol (&Qquote, "quote");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 defsymbol (&Qlambda, "lambda");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 defsymbol (&Qlistp, "listp");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 defsymbol (&Qtrue_list_p, "true-list-p");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 defsymbol (&Qconsp, "consp");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 defsymbol (&Qsubrp, "subrp");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 defsymbol (&Qsymbolp, "symbolp");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 defsymbol (&Qintegerp, "integerp");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 defsymbol (&Qcharacterp, "characterp");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 defsymbol (&Qnatnump, "natnump");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 defsymbol (&Qstringp, "stringp");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 defsymbol (&Qarrayp, "arrayp");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 defsymbol (&Qsequencep, "sequencep");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 defsymbol (&Qbufferp, "bufferp");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 defsymbol (&Qbitp, "bitp");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 defsymbol (&Qbit_vectorp, "bit-vector-p");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 defsymbol (&Qvectorp, "vectorp");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 defsymbol (&Qchar_or_string_p, "char-or-string-p");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 defsymbol (&Qmarkerp, "markerp");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 defsymbol (&Qinteger_or_marker_p, "integer-or-marker-p");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 defsymbol (&Qinteger_or_char_p, "integer-or-char-p");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 defsymbol (&Qinteger_char_or_marker_p, "integer-char-or-marker-p");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 defsymbol (&Qnumberp, "numberp");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 defsymbol (&Qnumber_char_or_marker_p, "number-char-or-marker-p");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 defsymbol (&Qcdr, "cdr");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104 defsymbol (&Qweak_listp, "weak-list-p");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 defsymbol (&Qfloatp, "floatp");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 DEFSUBR (Fwrong_type_argument);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 DEFSUBR (Feq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 DEFSUBR (Fold_eq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 DEFSUBR (Fnull);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 Ffset (intern ("not"), intern ("null"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 DEFSUBR (Flistp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 DEFSUBR (Fnlistp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 DEFSUBR (Ftrue_list_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 DEFSUBR (Fconsp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 DEFSUBR (Fatom);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 DEFSUBR (Fchar_or_string_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 DEFSUBR (Fcharacterp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 DEFSUBR (Fchar_int_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 DEFSUBR (Fchar_to_int);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 DEFSUBR (Fint_to_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 DEFSUBR (Fchar_or_char_int_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 DEFSUBR (Fintegerp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 DEFSUBR (Finteger_or_marker_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 DEFSUBR (Finteger_or_char_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 DEFSUBR (Finteger_char_or_marker_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 DEFSUBR (Fnumberp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 DEFSUBR (Fnumber_or_marker_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 DEFSUBR (Fnumber_char_or_marker_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 DEFSUBR (Ffloatp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 DEFSUBR (Fnatnump);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138 DEFSUBR (Fsymbolp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 DEFSUBR (Fkeywordp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 DEFSUBR (Fstringp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 DEFSUBR (Fvectorp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 DEFSUBR (Fbitp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 DEFSUBR (Fbit_vector_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 DEFSUBR (Farrayp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 DEFSUBR (Fsequencep);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146 DEFSUBR (Fmarkerp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 DEFSUBR (Fsubrp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 DEFSUBR (Fsubr_min_args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 DEFSUBR (Fsubr_max_args);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 DEFSUBR (Fsubr_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 DEFSUBR (Ftype_of);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 DEFSUBR (Fcar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 DEFSUBR (Fcdr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 DEFSUBR (Fcar_safe);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 DEFSUBR (Fcdr_safe);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 DEFSUBR (Fsetcar);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 DEFSUBR (Fsetcdr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 DEFSUBR (Findirect_function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 DEFSUBR (Faref);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 DEFSUBR (Faset);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 DEFSUBR (Fnumber_to_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 DEFSUBR (Fstring_to_number);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164 DEFSUBR (Feqlsign);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 DEFSUBR (Flss);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 DEFSUBR (Fgtr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 DEFSUBR (Fleq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168 DEFSUBR (Fgeq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 DEFSUBR (Fneq);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 DEFSUBR (Fzerop);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 DEFSUBR (Fplus);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 DEFSUBR (Fminus);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 DEFSUBR (Ftimes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174 DEFSUBR (Fquo);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 DEFSUBR (Frem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 DEFSUBR (Fmod);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 DEFSUBR (Fmax);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 DEFSUBR (Fmin);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 DEFSUBR (Flogand);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 DEFSUBR (Flogior);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 DEFSUBR (Flogxor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 DEFSUBR (Flsh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183 DEFSUBR (Fash);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184 DEFSUBR (Fadd1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 DEFSUBR (Fsub1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 DEFSUBR (Flognot);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 DEFSUBR (Fweak_list_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 DEFSUBR (Fmake_weak_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 DEFSUBR (Fweak_list_type);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 DEFSUBR (Fweak_list_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 DEFSUBR (Fset_weak_list_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 vars_of_data (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 /* This must not be staticpro'd */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 Vall_weak_lists = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 pdump_wire_list (&Vall_weak_lists);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 #ifdef DEBUG_XEMACS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 DEFVAR_BOOL ("debug-issue-ebola-notices", &debug_issue_ebola_notices /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 If non-zero, note when your code may be suffering from char-int confoundance.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 That is to say, if XEmacs encounters a usage of `eq', `memq', `equal',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 etc. where an int and a char with the same value are being compared,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 it will issue a notice on stderr to this effect, along with a backtrace.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 In such situations, the result would be different in XEmacs 19 versus
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 XEmacs 20, and you probably don't want this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 Note that in order to see these notices, you have to byte compile your
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 code under XEmacs 20 -- any code byte-compiled under XEmacs 19 will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 have its chars and ints all confounded in the byte code, making it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 impossible to accurately determine Ebola infection.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 debug_issue_ebola_notices = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 DEFVAR_INT ("debug-ebola-backtrace-length",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 &debug_ebola_backtrace_length /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 Length (in stack frames) of short backtrace printed out in Ebola notices.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 See `debug-issue-ebola-notices'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 debug_ebola_backtrace_length = 32;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 #endif /* DEBUG_XEMACS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 }