diff options
author | Paul Eggert <eggert@cs.ucla.edu> | 2018-08-27 21:27:50 -0700 |
---|---|---|
committer | Paul Eggert <eggert@cs.ucla.edu> | 2018-08-27 21:45:23 -0700 |
commit | d77d01d22902acdc45c2c7059de4f1b158ab5806 (patch) | |
tree | 35f2b77594dc43e824852bb29598430945c5e6a4 /src/bignum.c | |
parent | 9abaf5f3581ecb76f30e8a6e7ee0e9633c133d1c (diff) | |
download | emacs-d77d01d22902acdc45c2c7059de4f1b158ab5806.tar.gz |
Improve bignum support for system types
Use bignums when Emacs converts to and from system types like
off_t for file sizes whose values can exceed fixnum range.
Formerly, Emacs sometimes generted floats and sometimes ad-hoc
conses of integers. Emacs still accepts floats and conses for
these system types, in case some stray Lisp code is generating
them, though this usage is obsolescent.
* doc/lispref/files.texi (File Attributes):
* doc/lispref/hash.texi (Defining Hash):
* doc/lispref/nonascii.texi (Character Sets):
* doc/lispref/os.texi (User Identification):
* doc/lispref/processes.texi (System Processes):
* etc/NEWS:
Document changes.
* src/bignum.c (mpz_set_uintmax, make_biguint)
(mpz_set_uintmax_slow, bignum_to_intmax, bignum_to_uintmax):
New functions.
(mpz_set_intmax_slow): Implement via mpz_limbs_write,
to avoid the need for an extra pass through a negative number.
* src/charset.c (Fencode_char):
* src/composite.h (LGLYPH_SET_CODE):
* src/dired.c (file_attributes):
* src/dosfns.c, src/w32.c (list_system_processes)
(system_process_attributes):
* src/editfns.c (init_editfns, Fuser_uid, Fuser_real_uid)
(Fgroup_gid, Fgroup_real_gid, Femacs_pid):
* src/emacs-module.c (check_vec_index):
* src/fns.c (Fsafe_length):
* src/process.c (record_deleted_pid, Fprocess_id):
* src/sysdep.c (list_system_processes, system_process_attributes):
* src/xselect.c (x_own_selection, selection_data_to_lisp_data):
* src/xterm.c (set_wm_state):
* src/inotify.c (inotifyevent_to_event, add_watch)
(inotify_callback):
If an integer is out of fixnum range, use a bignum
instead of converting it to a float or a cons of integers.
* src/coding.c (Fdefine_coding_system_internal):
* src/frame.c (frame_windows_min_size)
(x_set_frame_parameters):
* src/fringe.c (Fdefine_fringe_bitmap):
* src/nsterm.m (mouseDown:):
* src/syntax.c (find_defun_start):
* src/w32fns.c (x_set_undecorated, w32_createwindow)
(w32_wnd_proc, Fx_create_frame, Fx_show_tip)
(w32_console_toggle_lock_key):
* src/w32inevt.c (key_event):
* src/w32proc.c (Fw32_get_locale_info):
Do not mishandle floats by treating their addresses as their
values.
* src/data.c (store_symval_forwarding):
* src/gnutls.c (Fgnutls_error_fatalp, Fgnutls_error_string):
* src/keyboard.c (command_loop_1, make_lispy_event):
* src/lread.c (read_filtered_event, read1)
(substitute_object_recurse):
* src/window.c (Fcoordinates_in_window_p, Fwindow_at)
(window_resize_apply, Fset_window_vscroll):
* src/xdisp.c (handle_single_display_spec, try_scrolling)
(redisplay_window, calc_pixel_width_or_height)
(calc_line_height_property, on_hot_spot_p):
* src/xfaces.c (check_lface_attrs):
* src/xselect.c (x_get_local_selection, cons_to_x_long)
(lisp_data_to_selection_data, clean_local_selection_data)
(x_check_property_data, x_fill_property_data):
(x_send_client_event):
Do not reject bignums.
* src/data.c (INTBIG_TO_LISP, intbig_to_lisp)
(uintbig_to_lisp):
Remove. All uses removed.
* src/data.c (cons_to_unsigned, cons_to_signed):
* src/dbusbind.c (xd_signature, xd_extract_signed)
(xd_extract_unsigned):
* src/dispnew.c (sit_for):
* src/dosfns.c, src/w32.c (system_process_attributes):
* src/editfns.c (Fuser_full_name):
* src/fileio.c (file_offset):
* src/fileio.c (write_region):
* src/font.c (font_unparse_xlfd, font_open_for_lface, Fopen_font):
* src/frame.c (x_set_screen_gamma):
* src/frame.h (NUMVAL, FRAME_PIXEL_X_FROM_CANON_X)
(FRAME_PIXEL_Y_FROM_CANON_Y):
* src/image.c (parse_image_spec, x_edge_detection)
(compute_image_size):
* src/json.c (json_to_lisp):
* src/lcms.c (PARSE_LAB_LIST_FIELD, Flcms_cie_de2000)
(PARSE_XYZ_LIST_FIELD, PARSE_JCH_LIST_FIELD)
(PARSE_JAB_LIST_FIELD, PARSE_VIEW_CONDITION_FLOAT)
(Flcms_temp_to_white_point):
* src/nsimage.m (ns_load_image, setSizeFromSpec):
* src/process.c (Fsignal_process, handle_child_signal):
* src/sysdep.c (system_process_attributes):
* src/xdisp.c (calc_line_height_property):
Handle bignums.
* src/data.c (Fnumber_to_string): Use proper predicate name in
signal if the argument is not a number.
* src/lisp.h (make_uint): New function.
(INT_TO_INTEGER): New macro.
(FIXED_OR_FLOATP, CHECK_FIXNUM_OR_FLOAT)
(CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER, INTEGER_TO_CONS)
(make_fixnum_or_float): Remove; no longer used.
* src/nsfns.m, src/w32fns.c, src/xfns.c (Fx_create_frame):
Reject floating-point min-width or min-height.
* src/process.c (handle_child_signal): Do not worry
about floating-point pids, as they are no longer generated.
Diffstat (limited to 'src/bignum.c')
-rw-r--r-- | src/bignum.c | 123 |
1 files changed, 109 insertions, 14 deletions
diff --git a/src/bignum.c b/src/bignum.c index 18f94e7ed63..5dbfdb9319a 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -67,6 +67,18 @@ make_bignum (mpz_t const op) return make_bignum_bits (op, mpz_sizeinbase (op, 2)); } +static void mpz_set_uintmax_slow (mpz_t, uintmax_t); + +/* Set RESULT to V. */ +static void +mpz_set_uintmax (mpz_t result, uintmax_t v) +{ + if (v <= ULONG_MAX) + mpz_set_ui (result, v); + else + mpz_set_uintmax_slow (result, v); +} + /* Return a Lisp integer equal to N, which must not be in fixnum range. */ Lisp_Object make_bigint (intmax_t n) @@ -79,6 +91,17 @@ make_bigint (intmax_t n) mpz_clear (z); return result; } +Lisp_Object +make_biguint (uintmax_t n) +{ + eassert (FIXNUM_OVERFLOW_P (n)); + mpz_t z; + mpz_init (z); + mpz_set_uintmax (z, n); + Lisp_Object result = make_bignum (z); + mpz_clear (z); + return result; +} /* Return a Lisp integer with value taken from OP. */ Lisp_Object @@ -109,23 +132,95 @@ make_integer (mpz_t const op) return make_bignum_bits (op, bits); } +/* Set RESULT to V. This code is for when intmax_t is wider than long. */ void mpz_set_intmax_slow (mpz_t result, intmax_t v) { - bool complement = v < 0; - if (complement) - v = -1 - v; - - enum { nails = sizeof v * CHAR_BIT - INTMAX_WIDTH }; -# ifndef HAVE_GMP - /* mini-gmp requires NAILS to be zero, which is true for all - likely Emacs platforms. Sanity-check this. */ - verify (nails == 0); -# endif - - mpz_import (result, 1, -1, sizeof v, 0, nails, &v); - if (complement) - mpz_com (result, result); + int maxlimbs = (INTMAX_WIDTH + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS; + mp_limb_t *limb = mpz_limbs_write (result, maxlimbs); + int n = 0; + uintmax_t u = v; + bool negative = v < 0; + if (negative) + { + uintmax_t two = 2; + u = -u & ((two << (UINTMAX_WIDTH - 1)) - 1); + } + + do + { + limb[n++] = u; + u = GMP_NUMB_BITS < UINTMAX_WIDTH ? u >> GMP_NUMB_BITS : 0; + } + while (u != 0); + + mpz_limbs_finish (result, negative ? -n : n); +} +static void +mpz_set_uintmax_slow (mpz_t result, uintmax_t v) +{ + int maxlimbs = (UINTMAX_WIDTH + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS; + mp_limb_t *limb = mpz_limbs_write (result, maxlimbs); + int n = 0; + + do + { + limb[n++] = v; + v = GMP_NUMB_BITS < INTMAX_WIDTH ? v >> GMP_NUMB_BITS : 0; + } + while (v != 0); + + mpz_limbs_finish (result, n); +} + +/* Return the value of the bignum X if it fits, 0 otherwise. + A bignum cannot be zero, so 0 indicates failure reliably. */ +intmax_t +bignum_to_intmax (Lisp_Object x) +{ + ptrdiff_t bits = mpz_sizeinbase (XBIGNUM (x)->value, 2); + bool negative = mpz_sgn (XBIGNUM (x)->value) < 0; + + if (bits < INTMAX_WIDTH) + { + intmax_t v = 0; + int i = 0, shift = 0; + + do + { + intmax_t limb = mpz_getlimbn (XBIGNUM (x)->value, i++); + v += limb << shift; + shift += GMP_NUMB_BITS; + } + while (shift < bits); + + return negative ? -v : v; + } + return ((bits == INTMAX_WIDTH && INTMAX_MIN < -INTMAX_MAX && negative + && mpz_scan1 (XBIGNUM (x)->value, 0) == INTMAX_WIDTH - 1) + ? INTMAX_MIN : 0); +} +uintmax_t +bignum_to_uintmax (Lisp_Object x) +{ + uintmax_t v = 0; + if (0 <= mpz_sgn (XBIGNUM (x)->value)) + { + ptrdiff_t bits = mpz_sizeinbase (XBIGNUM (x)->value, 2); + if (bits <= UINTMAX_WIDTH) + { + int i = 0, shift = 0; + + do + { + uintmax_t limb = mpz_getlimbn (XBIGNUM (x)->value, i++); + v += limb << shift; + shift += GMP_NUMB_BITS; + } + while (shift < bits); + } + } + return v; } /* Convert NUM to a base-BASE Lisp string. */ |