Mercurial > hg > xemacs-beta
comparison src/number.c @ 2092:f557693c61de
[xemacs-hg @ 2004-05-21 20:56:26 by james]
Batch of fixes and new functions for bignums, ratios, and bigfloats.
author | james |
---|---|
date | Fri, 21 May 2004 20:56:32 +0000 |
parents | b75af0ab66f3 |
children | 04bc9d2f42c7 |
comparison
equal
deleted
inserted
replaced
2091:0221e454fe63 | 2092:f557693c61de |
---|---|
70 | 70 |
71 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bignum", bignum, 0, 0, bignum_print, | 71 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bignum", bignum, 0, 0, bignum_print, |
72 0, bignum_equal, bignum_hash, | 72 0, bignum_equal, bignum_hash, |
73 bignum_description, Lisp_Bignum); | 73 bignum_description, Lisp_Bignum); |
74 | 74 |
75 #else /* !HAVE_BIGNUM */ | 75 #endif /* HAVE_BIGNUM */ |
76 | 76 |
77 Lisp_Object Qbignump; | 77 Lisp_Object Qbignump; |
78 | |
79 #endif /* HAVE_BIGNUM */ | |
80 | 78 |
81 DEFUN ("bignump", Fbignump, 1, 1, 0, /* | 79 DEFUN ("bignump", Fbignump, 1, 1, 0, /* |
82 Return t if OBJECT is a bignum, nil otherwise. | 80 Return t if OBJECT is a bignum, nil otherwise. |
83 */ | 81 */ |
84 (object)) | 82 (object)) |
148 | 146 |
149 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("ratio", ratio, 0, 0, ratio_print, | 147 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("ratio", ratio, 0, 0, ratio_print, |
150 0, ratio_equal, ratio_hash, | 148 0, ratio_equal, ratio_hash, |
151 ratio_description, Lisp_Ratio); | 149 ratio_description, Lisp_Ratio); |
152 | 150 |
153 #else /* !HAVE_RATIO */ | 151 #endif /* HAVE_RATIO */ |
154 | 152 |
155 Lisp_Object Qratiop; | 153 Lisp_Object Qratiop; |
156 | |
157 #endif /* HAVE_RATIO */ | |
158 | 154 |
159 DEFUN ("ratiop", Fratiop, 1, 1, 0, /* | 155 DEFUN ("ratiop", Fratiop, 1, 1, 0, /* |
160 Return t if OBJECT is a ratio, nil otherwise. | 156 Return t if OBJECT is a ratio, nil otherwise. |
161 */ | 157 */ |
162 (object)) | 158 (object)) |
237 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bigfloat", bigfloat, 1, 0, | 233 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bigfloat", bigfloat, 1, 0, |
238 bigfloat_print, 0, | 234 bigfloat_print, 0, |
239 bigfloat_equal, bigfloat_hash, | 235 bigfloat_equal, bigfloat_hash, |
240 bigfloat_description, Lisp_Bigfloat); | 236 bigfloat_description, Lisp_Bigfloat); |
241 | 237 |
242 #else /* !HAVE_BIGFLOAT */ | 238 #endif /* HAVE_BIGFLOAT */ |
243 | 239 |
244 Lisp_Object Qbigfloatp; | 240 Lisp_Object Qbigfloatp; |
245 | |
246 #endif /* HAVE_BIGFLOAT */ | |
247 | 241 |
248 DEFUN ("bigfloatp", Fbigfloatp, 1, 1, 0, /* | 242 DEFUN ("bigfloatp", Fbigfloatp, 1, 1, 0, /* |
249 Return t if OBJECT is a bigfloat, nil otherwise. | 243 Return t if OBJECT is a bigfloat, nil otherwise. |
250 */ | 244 */ |
251 (object)) | 245 (object)) |
252 { | 246 { |
253 return BIGFLOATP (object) ? Qt : Qnil; | 247 return BIGFLOATP (object) ? Qt : Qnil; |
248 } | |
249 | |
250 DEFUN ("bigfloat-get-precision", Fbigfloat_get_precision, 1, 1, 0, /* | |
251 Return the precision of bigfloat F as an integer. | |
252 */ | |
253 (f)) | |
254 { | |
255 CHECK_BIGFLOAT (f); | |
256 #ifdef HAVE_BIGNUM | |
257 bignum_set_ulong (scratch_bignum, XBIGFLOAT_GET_PREC (f)); | |
258 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
259 #else | |
260 return make_int ((int) XBIGFLOAT_GET_PREC (f)); | |
261 #endif | |
262 } | |
263 | |
264 DEFUN ("bigfloat-set-precision", Fbigfloat_set_precision, 2, 2, 0, /* | |
265 Set the precision of F, a bigfloat, to PRECISION, a nonnegative integer. | |
266 The new precision of F is returned. Note that the return value may differ | |
267 from PRECISION if the underlying library is unable to support exactly | |
268 PRECISION bits of precision. | |
269 */ | |
270 (f, precision)) | |
271 { | |
272 unsigned long prec; | |
273 | |
274 CHECK_BIGFLOAT (f); | |
275 if (INTP (precision)) | |
276 { | |
277 prec = (XINT (precision) <= 0) ? 1UL : (unsigned long) XINT (precision); | |
278 } | |
279 #ifdef HAVE_BIGNUM | |
280 else if (BIGNUMP (precision)) | |
281 { | |
282 prec = bignum_fits_ulong_p (XBIGNUM_DATA (precision)) | |
283 ? bignum_to_ulong (XBIGNUM_DATA (precision)) | |
284 : UINT_MAX; | |
285 } | |
286 #endif | |
287 else | |
288 { | |
289 dead_wrong_type_argument (Qintegerp, f); | |
290 return Qnil; | |
291 } | |
292 | |
293 XBIGFLOAT_SET_PREC (f, prec); | |
294 return Fbigfloat_get_precision (f); | |
254 } | 295 } |
255 | 296 |
256 static int | 297 static int |
257 default_float_precision_changed (Lisp_Object sym, Lisp_Object *val, | 298 default_float_precision_changed (Lisp_Object sym, Lisp_Object *val, |
258 Lisp_Object in_object, int flags) | 299 Lisp_Object in_object, int flags) |
667 | 708 |
668 /* Type predicates */ | 709 /* Type predicates */ |
669 DEFSYMBOL (Qrationalp); | 710 DEFSYMBOL (Qrationalp); |
670 DEFSYMBOL (Qfloatingp); | 711 DEFSYMBOL (Qfloatingp); |
671 DEFSYMBOL (Qrealp); | 712 DEFSYMBOL (Qrealp); |
672 #ifndef HAVE_BIGNUM | |
673 DEFSYMBOL (Qbignump); | 713 DEFSYMBOL (Qbignump); |
674 #endif | |
675 #ifndef HAVE_RATIO | |
676 DEFSYMBOL (Qratiop); | 714 DEFSYMBOL (Qratiop); |
677 #endif | |
678 #ifndef HAVE_BIGFLOAT | |
679 DEFSYMBOL (Qbigfloatp); | 715 DEFSYMBOL (Qbigfloatp); |
680 #endif | |
681 | 716 |
682 /* Functions */ | 717 /* Functions */ |
683 DEFSUBR (Fbignump); | 718 DEFSUBR (Fbignump); |
684 DEFSUBR (Fintegerp); | 719 DEFSUBR (Fintegerp); |
685 DEFSUBR (Fevenp); | 720 DEFSUBR (Fevenp); |
687 DEFSUBR (Fratiop); | 722 DEFSUBR (Fratiop); |
688 DEFSUBR (Frationalp); | 723 DEFSUBR (Frationalp); |
689 DEFSUBR (Fnumerator); | 724 DEFSUBR (Fnumerator); |
690 DEFSUBR (Fdenominator); | 725 DEFSUBR (Fdenominator); |
691 DEFSUBR (Fbigfloatp); | 726 DEFSUBR (Fbigfloatp); |
727 DEFSUBR (Fbigfloat_get_precision); | |
728 DEFSUBR (Fbigfloat_set_precision); | |
692 DEFSUBR (Ffloatingp); | 729 DEFSUBR (Ffloatingp); |
693 DEFSUBR (Frealp); | 730 DEFSUBR (Frealp); |
694 DEFSUBR (Fcanonicalize_number); | 731 DEFSUBR (Fcanonicalize_number); |
695 DEFSUBR (Fcoerce_number); | 732 DEFSUBR (Fcoerce_number); |
696 | 733 |
703 { | 740 { |
704 /* These variables are Lisp variables rather than number variables so that | 741 /* These variables are Lisp variables rather than number variables so that |
705 we can put bignums in them. */ | 742 we can put bignums in them. */ |
706 DEFVAR_LISP_MAGIC ("default-float-precision", &Vdefault_float_precision, /* | 743 DEFVAR_LISP_MAGIC ("default-float-precision", &Vdefault_float_precision, /* |
707 The default floating-point precision for newly created floating point values. | 744 The default floating-point precision for newly created floating point values. |
708 This should be 0 for the precision of the machine-supported floating point | 745 This should be 0 to create Lisp float types, or an unsigned integer no greater |
709 type (the C double type), or an unsigned integer no greater than | 746 than `bigfloat-maximum-precision' to create Lisp bigfloat types with the |
710 bigfloat-max-prec (currently the size of a C unsigned long). | 747 indicated precision. |
711 */ default_float_precision_changed); | 748 */ default_float_precision_changed); |
712 Vdefault_float_precision = make_int (0); | 749 Vdefault_float_precision = make_int (0); |
713 | 750 |
714 DEFVAR_CONST_LISP ("bigfloat-max-prec", &Vbigfloat_max_prec /* | 751 DEFVAR_CONST_LISP ("bigfloat-maximum-precision", &Vbigfloat_max_prec /* |
715 The maximum number of bits of precision a bigfloat can have. | 752 The maximum number of bits of precision a bigfloat can have. |
716 This is currently the value of ULONG_MAX on the target machine. | 753 This is determined by the underlying library used to implement bigfloats. |
717 */); | 754 */); |
718 | 755 |
719 #ifdef HAVE_BIGFLOAT | 756 #ifdef HAVE_BIGFLOAT |
720 #ifdef HAVE_BIGNUM | 757 #ifdef HAVE_BIGNUM |
721 /* Uncomment the next two lines and remove the line below them when dumping | 758 /* Uncomment the next two lines and remove the line below them when dumping |