Mercurial > hg > xemacs-beta

changeset 2092:f557693c61de

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[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 0221e454fe63
children 5cefe482f3e1
files lisp/ChangeLog lisp/cl.el src/ChangeLog src/floatfns.c src/number.c src/number.h
diffstat 6 files changed, 80 insertions(+), 25 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Fri May 21 03:27:58 2004 +0000
+++ b/lisp/ChangeLog	Fri May 21 20:56:32 2004 +0000
@@ -1,3 +1,8 @@
+2004-05-21  Jerry James  <james@xemacs.org>
+
+	* cl.el (cl-random-time): Chop a bignum down to a fixnum if
+	(featurep 'bignum), not if (featurep 'number-types).
+
 2004-05-15  Malcolm Purvis  <malcolmp@xemacs.org>
 
 	* gtk-widgets.el: New import: gtk-accel-group-new.
--- a/lisp/cl.el	Fri May 21 03:27:58 2004 +0000
+++ b/lisp/cl.el	Fri May 21 20:56:32 2004 +0000
@@ -311,7 +311,7 @@
 (defun cl-random-time ()
   (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
     (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i))))
-    (if (featurep 'number-types)
+    (if (featurep 'bignum)
 	(coerce-number v 'fixnum)
       v)))
 
--- a/src/ChangeLog	Fri May 21 03:27:58 2004 +0000
+++ b/src/ChangeLog	Fri May 21 20:56:32 2004 +0000
@@ -1,3 +1,16 @@
+2004-05-21  Jerry James  <james@xemacs.org>
+
+	* floatfns.c (Ffloat): Add missing return keyword.
+	* number.h: Declare Qbignump, Qratiop, and Qbigfloatp in every case. 
+	* number.c: Ditto.
+	* number.c (syms_of_number): Ditto.  Declare
+	Fbigfloat_get_precision and Fbigfloat_set_precision.
+	* number.c (Fbigfloat_get_precision): New function.
+	* number.c (Fbigfloat_set_precision): New function.
+	* number.c (vars_of_number): Clarify that default-float-precision
+	of 0 means to create normal floats.  Change bigfloat-max-prec to
+	bigfloat-maximum-precision.
+
 2004-05-15  Malcolm Purvis  <malcolmp@xemacs.org>
 
 	* glyphs-gtk.c (gtk_xpm_instantiate): Rewrite the XPM data to
--- a/src/floatfns.c	Fri May 21 03:27:58 2004 +0000
+++ b/src/floatfns.c	Fri May 21 20:56:32 2004 +0000
@@ -781,7 +781,7 @@
 
 #ifdef HAVE_RATIO
   if (RATIOP (number))
-    make_float (ratio_to_double (XRATIO_DATA (number)));
+    return make_float (ratio_to_double (XRATIO_DATA (number)));
 #endif
 
   if (FLOATP (number))		/* give 'em the same float back */
--- a/src/number.c	Fri May 21 03:27:58 2004 +0000
+++ b/src/number.c	Fri May 21 20:56:32 2004 +0000
@@ -72,12 +72,10 @@
 				     0, bignum_equal, bignum_hash,
 				     bignum_description, Lisp_Bignum);
 
-#else /* !HAVE_BIGNUM */
+#endif /* HAVE_BIGNUM */
 
 Lisp_Object Qbignump;
 
-#endif /* HAVE_BIGNUM */
-
 DEFUN ("bignump", Fbignump, 1, 1, 0, /*
 Return t if OBJECT is a bignum, nil otherwise.
 */
@@ -150,12 +148,10 @@
 				     0, ratio_equal, ratio_hash,
 				     ratio_description, Lisp_Ratio);
 
-#else /* !HAVE_RATIO */
+#endif /* HAVE_RATIO */
 
 Lisp_Object Qratiop;
 
-#endif /* HAVE_RATIO */
-
 DEFUN ("ratiop", Fratiop, 1, 1, 0, /*
 Return t if OBJECT is a ratio, nil otherwise.
 */
@@ -239,12 +235,10 @@
 				     bigfloat_equal, bigfloat_hash,
 				     bigfloat_description, Lisp_Bigfloat);
 
-#else /* !HAVE_BIGFLOAT */
+#endif /* HAVE_BIGFLOAT */
 
 Lisp_Object Qbigfloatp;
 
-#endif /* HAVE_BIGFLOAT */
-
 DEFUN ("bigfloatp", Fbigfloatp, 1, 1, 0, /*
 Return t if OBJECT is a bigfloat, nil otherwise.
 */
@@ -253,6 +247,53 @@
   return BIGFLOATP (object) ? Qt : Qnil;
 }
 
+DEFUN ("bigfloat-get-precision", Fbigfloat_get_precision, 1, 1, 0, /*
+Return the precision of bigfloat F as an integer.
+*/
+       (f))
+{
+  CHECK_BIGFLOAT (f);
+#ifdef HAVE_BIGNUM
+  bignum_set_ulong (scratch_bignum, XBIGFLOAT_GET_PREC (f));
+  return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+#else
+  return make_int ((int) XBIGFLOAT_GET_PREC (f));
+#endif
+}
+
+DEFUN ("bigfloat-set-precision", Fbigfloat_set_precision, 2, 2, 0, /*
+Set the precision of F, a bigfloat, to PRECISION, a nonnegative integer.
+The new precision of F is returned.  Note that the return value may differ
+from PRECISION if the underlying library is unable to support exactly
+PRECISION bits of precision.
+*/
+       (f, precision))
+{
+  unsigned long prec;
+
+  CHECK_BIGFLOAT (f);
+  if (INTP (precision))
+    {
+      prec = (XINT (precision) <= 0) ? 1UL : (unsigned long) XINT (precision);
+    }
+#ifdef HAVE_BIGNUM
+  else if (BIGNUMP (precision))
+    {
+      prec = bignum_fits_ulong_p (XBIGNUM_DATA (precision))
+	? bignum_to_ulong (XBIGNUM_DATA (precision))
+	: UINT_MAX;
+    }
+#endif
+  else
+    {
+      dead_wrong_type_argument (Qintegerp, f);
+      return Qnil;
+    }
+
+  XBIGFLOAT_SET_PREC (f, prec);
+  return Fbigfloat_get_precision (f);
+}
+
 static int
 default_float_precision_changed (Lisp_Object sym, Lisp_Object *val,
 				 Lisp_Object in_object, int flags)
@@ -669,15 +710,9 @@
   DEFSYMBOL (Qrationalp);
   DEFSYMBOL (Qfloatingp);
   DEFSYMBOL (Qrealp);
-#ifndef HAVE_BIGNUM
   DEFSYMBOL (Qbignump);
-#endif
-#ifndef HAVE_RATIO
   DEFSYMBOL (Qratiop);
-#endif
-#ifndef HAVE_BIGFLOAT
   DEFSYMBOL (Qbigfloatp);
-#endif
 
   /* Functions */
   DEFSUBR (Fbignump);
@@ -689,6 +724,8 @@
   DEFSUBR (Fnumerator);
   DEFSUBR (Fdenominator);
   DEFSUBR (Fbigfloatp);
+  DEFSUBR (Fbigfloat_get_precision);
+  DEFSUBR (Fbigfloat_set_precision);
   DEFSUBR (Ffloatingp);
   DEFSUBR (Frealp);
   DEFSUBR (Fcanonicalize_number);
@@ -705,15 +742,15 @@
      we can put bignums in them. */
   DEFVAR_LISP_MAGIC ("default-float-precision", &Vdefault_float_precision, /*
 The default floating-point precision for newly created floating point values.
-This should be 0 for the precision of the machine-supported floating point
-type (the C double type), or an unsigned integer no greater than
-bigfloat-max-prec (currently the size of a C unsigned long).
+This should be 0 to create Lisp float types, or an unsigned integer no greater
+than `bigfloat-maximum-precision' to create Lisp bigfloat types with the
+indicated precision.
 */ default_float_precision_changed);
   Vdefault_float_precision = make_int (0);
 
-  DEFVAR_CONST_LISP ("bigfloat-max-prec", &Vbigfloat_max_prec /*
+  DEFVAR_CONST_LISP ("bigfloat-maximum-precision", &Vbigfloat_max_prec /*
 The maximum number of bits of precision a bigfloat can have.
-This is currently the value of ULONG_MAX on the target machine.
+This is determined by the underlying library used to implement bigfloats.
 */);
 
 #ifdef HAVE_BIGFLOAT
--- a/src/number.h	Fri May 21 03:27:58 2004 +0000
+++ b/src/number.h	Fri May 21 20:56:32 2004 +0000
@@ -106,7 +106,6 @@
 
 #else /* !HAVE_BIGNUM */
 
-extern Lisp_Object Qbignump;
 #define BIGNUMP(x)         0
 #define CHECK_BIGNUM(x)    dead_wrong_type_argument (Qbignump, x)
 #define CONCHECK_BIGNUM(x) dead_wrong_type_argument (Qbignump, x)
@@ -116,6 +115,7 @@
 
 #endif /* HAVE_BIGNUM */
 
+extern Lisp_Object Qbignump;
 EXFUN (Fbignump, 1);
 
 
@@ -189,7 +189,6 @@
 
 #else /* !HAVE_RATIO */
 
-extern Lisp_Object Qratiop;
 #define RATIOP(x)          0
 #define CHECK_RATIO(x)     dead_wrong_type_argument (Qratiop, x)
 #define CONCHECK_RATIO(x)  dead_wrong_type_argument (Qratiop, x)
@@ -199,6 +198,7 @@
 
 #endif /* HAVE_RATIO */
 
+extern Lisp_Object Qratiop;
 EXFUN (Fratiop, 1);
 
 
@@ -262,7 +262,6 @@
 
 #else /* !HAVE_BIGFLOAT */
 
-extern Lisp_Object Qbigfloatp;
 #define BIGFLOATP(x)         0
 #define CHECK_BIGFLOAT(x)    dead_wrong_type_argument (Qbigfloatp, x)
 #define CONCHECK_BIGFLOAT(x) dead_wrong_type_argument (Qbigfloatp, x)
@@ -272,6 +271,7 @@
 
 #endif /* HAVE_BIGFLOAT */
 
+extern Lisp_Object Qbigfloatp;
 EXFUN (Fbigfloatp, 1);
 
 /********************************* Floating *********************************/