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