aboutsummaryrefslogtreecommitdiffstats
path: root/src/floatfns.c
diff options
context:
space:
mode:
authorPaul Eggert2018-08-27 21:27:50 -0700
committerPaul Eggert2018-08-27 21:45:22 -0700
commit9abaf5f3581ecb76f30e8a6e7ee0e9633c133d1c (patch)
treec39260a6e26845b0a1307be98b38581468925c58 /src/floatfns.c
parentbf1b147b55e1328efca6e40181e79dd9a369895d (diff)
downloademacs-9abaf5f3581ecb76f30e8a6e7ee0e9633c133d1c.tar.gz
emacs-9abaf5f3581ecb76f30e8a6e7ee0e9633c133d1c.zip
Modularize bignums better
* src/bignum.c, src/bignum.h: New files. Only modules that need to know how bignums are implemented should include bignum.h. Currently these are alloc.c, bignum.c (of course), data.c, emacs.c, emacs-module.c, floatfns.c, fns.c, print.c. * src/Makefile.in (base_obj): Add bignum.o. * src/alloc.c (make_bignum_str): Move to bignum.c. (make_number): Remove; replaced by bignum.c’s make_integer. All callers changed. * src/conf_post.h (ARG_NONNULL): New macro. * src/json.c (json_to_lisp): Use it. * src/data.c (Fnatnump): Move NATNUMP’s implementation here from lisp.h. * src/data.c (Fnumber_to_string): * src/editfns.c (styled_format): Move conversion of string to bignum to bignum_to_string, and call it here. * src/emacs-module.c (module_make_integer): * src/floatfns.c (Fabs): Simplify by using make_int. * src/emacs.c: Include bignum.h, to expand its inline fns. * src/floatfns.c (Ffloat): Simplify by using XFLOATINT. (rounding_driver): Simplify by using double_to_bignum. (rounddiv_q): Clarify use of temporaries. * src/lisp.h: Move decls that need to know bignum internals to bignum.h. Do not include gmp.h or mini-gmp.h; that is now bignum.h’s job. (GMP_NUM_BITS, struct Lisp_Bignum, XBIGNUM, mpz_set_intmax): Move to bignum.h. (make_int): New function. (NATNUMP): Remove; all callers changed to use Fnatnump. (XFLOATINT): If arg is a bignum, use bignum_to_double, so that bignum internals are not exposed here. * src/print.c (print_vectorlike): Use SAFE_ALLOCA to avoid the need for a record_unwind_protect_ptr.
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);