Mercurial > hg > xemacs-beta

comparison src/number.c @ 5495:1f0b15040456

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 01 May 2011 18:44:03 +0100
parents 2aa9cd456ae7
children 56144c8593a8
comparison
equal deleted inserted replaced
5494:861f2601a38b 5495:1f0b15040456
1 /* Numeric types for XEmacs. 1 /* Numeric types for XEmacs.
2 Copyright (C) 2004 Jerry James. 2 Copyright (C) 2004 Jerry James.
3 Copyright (C) 2010 Ben Wing.
3 4
4 This file is part of XEmacs. 5 This file is part of XEmacs.
5 6
6 XEmacs is free software; you can redistribute it and/or modify it 7 XEmacs is free software: you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the 8 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any 9 Free Software Foundation, either version 3 of the License, or (at your
9 later version. 10 option) any later version.
10 11
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 for more details. 15 for more details.
15 16
16 You should have received a copy of the GNU General Public License 17 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to 18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */
18 the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor,
19 Boston, MA 02111-1301, USA. */
20 19
21 /* Synched up with: Not in FSF. */ 20 /* Synched up with: Not in FSF. */
22 21
23 #include <config.h> 22 #include <config.h>
24 #include <limits.h> 23 #include <limits.h>
58 xfree (bstr); 57 xfree (bstr);
59 } 58 }
60 59
61 #ifdef NEW_GC 60 #ifdef NEW_GC
62 static void 61 static void
63 bignum_finalize (void *header, int for_disksave) 62 bignum_finalize (Lisp_Object obj)
64 { 63 {
65 if (!for_disksave) 64 struct Lisp_Bignum *num = XBIGNUM (obj);
66 { 65 /* #### WARNING: It would be better to put some sort of check to make
67 struct Lisp_Bignum *num = (struct Lisp_Bignum *) header; 66 sure this doesn't happen more than once, just in case ---
68 bignum_fini (num->data); 67 e.g. checking if it's zero before finalizing and then setting it to
69 } 68 zero after finalizing. */
70 } 69 bignum_fini (num->data);
71 #define BIGNUM_FINALIZE bignum_finalize 70 }
72 #else
73 #define BIGNUM_FINALIZE 0
74 #endif 71 #endif
75 72
76 static int 73 static int
77 bignum_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), 74 bignum_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth),
78 int UNUSED (foldcase)) 75 int UNUSED (foldcase))
79 { 76 {
80 return bignum_eql (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2)); 77 return bignum_eql (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2));
81 } 78 }
82 79
83 static Hashcode 80 static Hashcode
84 bignum_hash (Lisp_Object obj, int UNUSED (depth)) 81 bignum_hash (Lisp_Object obj, int UNUSED (depth), Boolint equalp)
85 { 82 {
86 return bignum_hashcode (XBIGNUM_DATA (obj)); 83 if (equalp)
84 {
85 return FLOAT_HASHCODE_FROM_DOUBLE (bignum_to_double (XBIGNUM_DATA (obj)));
86 }
87 else
88 {
89 return bignum_hashcode (XBIGNUM_DATA (obj));
90 }
87 } 91 }
88 92
89 static void 93 static void
90 bignum_convert (const void *object, void **data, Bytecount *size) 94 bignum_convert (const void *object, void **data, Bytecount *size)
91 { 95 {
120 { XD_OPAQUE_DATA_CONVERTIBLE, offsetof (Lisp_Bignum, data), 124 { XD_OPAQUE_DATA_CONVERTIBLE, offsetof (Lisp_Bignum, data),
121 0, { &bignum_opc }, XD_FLAG_NO_KKCC }, 125 0, { &bignum_opc }, XD_FLAG_NO_KKCC },
122 { XD_END } 126 { XD_END }
123 }; 127 };
124 128
125 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bignum", bignum, 1, 0, bignum_print, 129 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("bignum", bignum, 0, bignum_print,
126 BIGNUM_FINALIZE, bignum_equal, 130 IF_NEW_GC (bignum_finalize),
127 bignum_hash, bignum_description, 131 bignum_equal, bignum_hash,
128 Lisp_Bignum); 132 bignum_description, Lisp_Bignum);
129
130 #endif /* HAVE_BIGNUM */ 133 #endif /* HAVE_BIGNUM */
131 134
132 Lisp_Object Qbignump; 135 Lisp_Object Qbignump;
133 136
134 DEFUN ("bignump", Fbignump, 1, 1, 0, /* 137 DEFUN ("bignump", Fbignump, 1, 1, 0, /*
151 xfree (rstr); 154 xfree (rstr);
152 } 155 }
153 156
154 #ifdef NEW_GC 157 #ifdef NEW_GC
155 static void 158 static void
156 ratio_finalize (void *header, int for_disksave) 159 ratio_finalize (Lisp_Object obj)
157 { 160 {
158 if (!for_disksave) 161 struct Lisp_Ratio *num = XRATIO (obj);
159 { 162 /* #### WARNING: It would be better to put some sort of check to make
160 struct Lisp_Ratio *num = (struct Lisp_Ratio *) header; 163 sure this doesn't happen more than once, just in case ---
161 ratio_fini (num->data); 164 e.g. checking if it's zero before finalizing and then setting it to
162 } 165 zero after finalizing. */
163 } 166 ratio_fini (num->data);
164 #define RATIO_FINALIZE ratio_finalize 167 }
165 #else 168 #endif /* not NEW_GC */
166 #define RATIO_FINALIZE 0
167 #endif
168 169
169 static int 170 static int
170 ratio_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), 171 ratio_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth),
171 int UNUSED (foldcase)) 172 int UNUSED (foldcase))
172 { 173 {
173 return ratio_eql (XRATIO_DATA (obj1), XRATIO_DATA (obj2)); 174 return ratio_eql (XRATIO_DATA (obj1), XRATIO_DATA (obj2));
174 } 175 }
175 176
176 static Hashcode 177 static Hashcode
177 ratio_hash (Lisp_Object obj, int UNUSED (depth)) 178 ratio_hash (Lisp_Object obj, int UNUSED (depth), Boolint equalp)
178 { 179 {
179 return ratio_hashcode (XRATIO_DATA (obj)); 180 if (equalp)
181 {
182 return FLOAT_HASHCODE_FROM_DOUBLE (ratio_to_double (XRATIO_DATA (obj)));
183 }
184 else
185 {
186 return ratio_hashcode (XRATIO_DATA (obj));
187 }
180 } 188 }
181 189
182 static const struct memory_description ratio_description[] = { 190 static const struct memory_description ratio_description[] = {
183 { XD_OPAQUE_PTR, offsetof (Lisp_Ratio, data) }, 191 { XD_OPAQUE_PTR, offsetof (Lisp_Ratio, data) },
184 { XD_END } 192 { XD_END }
185 }; 193 };
186 194
187 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("ratio", ratio, 0, 0, ratio_print, 195 DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("ratio", ratio, 0, ratio_print,
188 RATIO_FINALIZE, ratio_equal, ratio_hash, 196 IF_NEW_GC (ratio_finalize),
189 ratio_description, Lisp_Ratio); 197 ratio_equal, ratio_hash,
198 ratio_description, Lisp_Ratio);
190 199
191 #endif /* HAVE_RATIO */ 200 #endif /* HAVE_RATIO */
192 201
193 Lisp_Object Qratiop; 202 Lisp_Object Qratiop;
194 203
256 xfree (fstr); 265 xfree (fstr);
257 } 266 }
258 267
259 #ifdef NEW_GC 268 #ifdef NEW_GC
260 static void 269 static void
261 bigfloat_finalize (void *header, int for_disksave) 270 bigfloat_finalize (Lisp_Object obj)
262 { 271 {
263 if (!for_disksave) 272 struct Lisp_Bigfloat *num = XBIGFLOAT (obj);
264 { 273 /* #### WARNING: It would be better to put some sort of check to make
265 struct Lisp_Bigfloat *num = (struct Lisp_Bigfloat *) header; 274 sure this doesn't happen more than once, just in case ---
266 bigfloat_fini (num->bf); 275 e.g. checking if it's zero before finalizing and then setting it to
267 } 276 zero after finalizing. */
268 } 277 bigfloat_fini (num->bf);
269 #define BIGFLOAT_FINALIZE bigfloat_finalize 278 }
270 #else 279 #endif /* not NEW_GC */
271 #define BIGFLOAT_FINALIZE 0
272 #endif
273 280
274 static int 281 static int
275 bigfloat_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), 282 bigfloat_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth),
276 int UNUSED (foldcase)) 283 int UNUSED (foldcase))
277 { 284 {
278 return bigfloat_eql (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2)); 285 return bigfloat_eql (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2));
279 } 286 }
280 287
281 static Hashcode 288 static Hashcode
282 bigfloat_hash (Lisp_Object obj, int UNUSED (depth)) 289 bigfloat_hash (Lisp_Object obj, int UNUSED (depth), Boolint equalp)
283 { 290 {
284 return bigfloat_hashcode (XBIGFLOAT_DATA (obj)); 291 if (equalp)
292 {
293 return
294 FLOAT_HASHCODE_FROM_DOUBLE (bigfloat_to_double (XBIGFLOAT_DATA (obj)));
295 }
296 else
297 {
298 return bigfloat_hashcode (XBIGFLOAT_DATA (obj));
299 }
285 } 300 }
286 301
287 static const struct memory_description bigfloat_description[] = { 302 static const struct memory_description bigfloat_description[] = {
288 { XD_OPAQUE_PTR, offsetof (Lisp_Bigfloat, bf) }, 303 { XD_OPAQUE_PTR, offsetof (Lisp_Bigfloat, bf) },
289 { XD_END } 304 { XD_END }
290 }; 305 };
291 306
292 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bigfloat", bigfloat, 1, 0, 307 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("bigfloat", bigfloat, 0,
293 bigfloat_print, BIGFLOAT_FINALIZE, 308 bigfloat_print,
294 bigfloat_equal, bigfloat_hash, 309 IF_NEW_GC (bigfloat_finalize),
295 bigfloat_description, Lisp_Bigfloat); 310 bigfloat_equal, bigfloat_hash,
311 bigfloat_description, Lisp_Bigfloat);
296 312
297 #endif /* HAVE_BIGFLOAT */ 313 #endif /* HAVE_BIGFLOAT */
298 314
299 Lisp_Object Qbigfloatp; 315 Lisp_Object Qbigfloatp;
300 316
760 776
761 void 777 void
762 syms_of_number (void) 778 syms_of_number (void)
763 { 779 {
764 #ifdef HAVE_BIGNUM 780 #ifdef HAVE_BIGNUM
765 INIT_LRECORD_IMPLEMENTATION (bignum); 781 INIT_LISP_OBJECT (bignum);
766 #endif 782 #endif
767 #ifdef HAVE_RATIO 783 #ifdef HAVE_RATIO
768 INIT_LRECORD_IMPLEMENTATION (ratio); 784 INIT_LISP_OBJECT (ratio);
769 #endif 785 #endif
770 #ifdef HAVE_BIGFLOAT 786 #ifdef HAVE_BIGFLOAT
771 INIT_LRECORD_IMPLEMENTATION (bigfloat); 787 INIT_LISP_OBJECT (bigfloat);
772 #endif 788 #endif
773 789
774 /* Type predicates */ 790 /* Type predicates */
775 DEFSYMBOL (Qrationalp); 791 DEFSYMBOL (Qrationalp);
776 DEFSYMBOL (Qfloatingp); 792 DEFSYMBOL (Qfloatingp);