diff options
Diffstat (limited to 'src/floatfns.c')
| -rw-r--r-- | src/floatfns.c | 50 |
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 | ||
| 309 | static int | 293 | static 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 | ||
| 421 | static void | 400 | static 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); |