aboutsummaryrefslogtreecommitdiffstats
path: root/src/floatfns.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/floatfns.c')
-rw-r--r--src/floatfns.c50
1 files changed, 15 insertions, 35 deletions
diff --git a/src/floatfns.c b/src/floatfns.c
index e7884864eef..8008929be61 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -42,6 +42,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
42#include <config.h> 42#include <config.h>
43 43
44#include "lisp.h" 44#include "lisp.h"
45#include "bignum.h"
45 46
46#include <math.h> 47#include <math.h>
47 48
@@ -209,7 +210,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
209 210
210 /* Common Lisp spec: don't promote if both are integers, and if the 211 /* Common Lisp spec: don't promote if both are integers, and if the
211 result is not fractional. */ 212 result is not fractional. */
212 if (INTEGERP (arg1) && NATNUMP (arg2)) 213 if (INTEGERP (arg1) && Fnatnump (arg2))
213 return expt_integer (arg1, arg2); 214 return expt_integer (arg1, arg2);
214 215
215 return make_float (pow (XFLOATINT (arg1), XFLOATINT (arg2))); 216 return make_float (pow (XFLOATINT (arg1), XFLOATINT (arg2)));
@@ -258,19 +259,7 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
258 if (FIXNUMP (arg)) 259 if (FIXNUMP (arg))
259 { 260 {
260 if (XFIXNUM (arg) < 0) 261 if (XFIXNUM (arg) < 0)
261 { 262 arg = make_int (-XFIXNUM (arg));
262 EMACS_INT absarg = -XFIXNUM (arg);
263 if (absarg <= MOST_POSITIVE_FIXNUM)
264 arg = make_fixnum (absarg);
265 else
266 {
267 mpz_t val;
268 mpz_init (val);
269 mpz_set_intmax (val, absarg);
270 arg = make_number (val);
271 mpz_clear (val);
272 }
273 }
274 } 263 }
275 else if (FLOATP (arg)) 264 else if (FLOATP (arg))
276 { 265 {
@@ -284,7 +273,7 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
284 mpz_t val; 273 mpz_t val;
285 mpz_init (val); 274 mpz_init (val);
286 mpz_neg (val, XBIGNUM (arg)->value); 275 mpz_neg (val, XBIGNUM (arg)->value);
287 arg = make_number (val); 276 arg = make_integer (val);
288 mpz_clear (val); 277 mpz_clear (val);
289 } 278 }
290 } 279 }
@@ -297,13 +286,8 @@ DEFUN ("float", Ffloat, Sfloat, 1, 1, 0,
297 (register Lisp_Object arg) 286 (register Lisp_Object arg)
298{ 287{
299 CHECK_NUMBER (arg); 288 CHECK_NUMBER (arg);
300 289 /* If ARG is a float, give 'em the same float back. */
301 if (BIGNUMP (arg)) 290 return FLOATP (arg) ? arg : make_float (XFLOATINT (arg));
302 return make_float (mpz_get_d (XBIGNUM (arg)->value));
303 if (FIXNUMP (arg))
304 return make_float ((double) XFIXNUM (arg));
305 else /* give 'em the same float back */
306 return arg;
307} 291}
308 292
309static int 293static int
@@ -386,7 +370,7 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
386 (FIXNUMP (divisor) 370 (FIXNUMP (divisor)
387 ? (mpz_set_intmax (d, XFIXNUM (divisor)), d) 371 ? (mpz_set_intmax (d, XFIXNUM (divisor)), d)
388 : XBIGNUM (divisor)->value)); 372 : XBIGNUM (divisor)->value));
389 Lisp_Object result = make_number (q); 373 Lisp_Object result = make_integer (q);
390 mpz_clear (d); 374 mpz_clear (d);
391 mpz_clear (q); 375 mpz_clear (q);
392 return result; 376 return result;
@@ -410,12 +394,7 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
410 if (! FIXNUM_OVERFLOW_P (ir)) 394 if (! FIXNUM_OVERFLOW_P (ir))
411 return make_fixnum (ir); 395 return make_fixnum (ir);
412 } 396 }
413 mpz_t drz; 397 return double_to_bignum (dr);
414 mpz_init (drz);
415 mpz_set_d (drz, dr);
416 Lisp_Object rounded = make_number (drz);
417 mpz_clear (drz);
418 return rounded;
419} 398}
420 399
421static void 400static void
@@ -433,9 +412,9 @@ rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d)
433 r = n % d; 412 r = n % d;
434 neg_d = d < 0; 413 neg_d = d < 0;
435 neg_r = r < 0; 414 neg_r = r < 0;
436 r = eabs (r); 415 abs_r = eabs (r);
437 abs_r1 = eabs (d) - r; 416 abs_r1 = eabs (d) - abs_r;
438 if (abs_r1 < r + (q & 1)) 417 if (abs_r1 < abs_r + (q & 1))
439 q += neg_d == neg_r ? 1 : -1; */ 418 q += neg_d == neg_r ? 1 : -1; */
440 419
441 mpz_t r, abs_r1; 420 mpz_t r, abs_r1;
@@ -444,10 +423,11 @@ rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d)
444 mpz_tdiv_qr (q, r, n, d); 423 mpz_tdiv_qr (q, r, n, d);
445 bool neg_d = mpz_sgn (d) < 0; 424 bool neg_d = mpz_sgn (d) < 0;
446 bool neg_r = mpz_sgn (r) < 0; 425 bool neg_r = mpz_sgn (r) < 0;
447 mpz_abs (r, r); 426 mpz_t *abs_r = &r;
427 mpz_abs (*abs_r, r);
448 mpz_abs (abs_r1, d); 428 mpz_abs (abs_r1, d);
449 mpz_sub (abs_r1, abs_r1, r); 429 mpz_sub (abs_r1, abs_r1, *abs_r);
450 if (mpz_cmp (abs_r1, r) < (mpz_odd_p (q) != 0)) 430 if (mpz_cmp (abs_r1, *abs_r) < (mpz_odd_p (q) != 0))
451 (neg_d == neg_r ? mpz_add_ui : mpz_sub_ui) (q, q, 1); 431 (neg_d == neg_r ? mpz_add_ui : mpz_sub_ui) (q, q, 1);
452 mpz_clear (r); 432 mpz_clear (r);
453 mpz_clear (abs_r1); 433 mpz_clear (abs_r1);