aboutsummaryrefslogtreecommitdiffstats
path: root/src/data.c
diff options
context:
space:
mode:
authorPaul Eggert2018-08-27 21:27:50 -0700
committerPaul Eggert2018-08-27 21:45:23 -0700
commitd77d01d22902acdc45c2c7059de4f1b158ab5806 (patch)
tree35f2b77594dc43e824852bb29598430945c5e6a4 /src/data.c
parent9abaf5f3581ecb76f30e8a6e7ee0e9633c133d1c (diff)
downloademacs-d77d01d22902acdc45c2c7059de4f1b158ab5806.tar.gz
emacs-d77d01d22902acdc45c2c7059de4f1b158ab5806.zip
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/data.c')
-rw-r--r--src/data.c157
1 files changed, 82 insertions, 75 deletions
diff --git a/src/data.c b/src/data.c
index ece76a5bc6f..6afda1e6fb9 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1132,7 +1132,7 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
1132 else if ((prop = Fget (predicate, Qrange), !NILP (prop))) 1132 else if ((prop = Fget (predicate, Qrange), !NILP (prop)))
1133 { 1133 {
1134 Lisp_Object min = XCAR (prop), max = XCDR (prop); 1134 Lisp_Object min = XCAR (prop), max = XCDR (prop);
1135 if (! FIXED_OR_FLOATP (newval) 1135 if (! NUMBERP (newval)
1136 || NILP (CALLN (Fleq, min, newval, max))) 1136 || NILP (CALLN (Fleq, min, newval, max)))
1137 wrong_range (min, max, newval); 1137 wrong_range (min, max, newval);
1138 } 1138 }
@@ -2627,48 +2627,21 @@ DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
2627 return arithcompare (num1, num2, ARITH_NOTEQUAL); 2627 return arithcompare (num1, num2, ARITH_NOTEQUAL);
2628} 2628}
2629 2629
2630/* Convert the integer I to a cons-of-integers, where I is not in
2631 fixnum range. */
2632
2633#define INTBIG_TO_LISP(i, extremum) \
2634 (eassert (FIXNUM_OVERFLOW_P (i)), \
2635 (! (FIXNUM_OVERFLOW_P ((extremum) >> 16) \
2636 && FIXNUM_OVERFLOW_P ((i) >> 16)) \
2637 ? Fcons (make_fixnum ((i) >> 16), make_fixnum ((i) & 0xffff)) \
2638 : ! (FIXNUM_OVERFLOW_P ((extremum) >> 16 >> 24) \
2639 && FIXNUM_OVERFLOW_P ((i) >> 16 >> 24)) \
2640 ? Fcons (make_fixnum ((i) >> 16 >> 24), \
2641 Fcons (make_fixnum ((i) >> 16 & 0xffffff), \
2642 make_fixnum ((i) & 0xffff))) \
2643 : make_float (i)))
2644
2645Lisp_Object
2646intbig_to_lisp (intmax_t i)
2647{
2648 return INTBIG_TO_LISP (i, INTMAX_MIN);
2649}
2650
2651Lisp_Object
2652uintbig_to_lisp (uintmax_t i)
2653{
2654 return INTBIG_TO_LISP (i, UINTMAX_MAX);
2655}
2656
2657/* Convert the cons-of-integers, integer, or float value C to an 2630/* Convert the cons-of-integers, integer, or float value C to an
2658 unsigned value with maximum value MAX, where MAX is one less than a 2631 unsigned value with maximum value MAX, where MAX is one less than a
2659 power of 2. Signal an error if C does not have a valid format or 2632 power of 2. Signal an error if C does not have a valid format or
2660 is out of range. */ 2633 is out of range.
2634
2635 Although Emacs represents large integers with bignums instead of
2636 cons-of-integers or floats, for now this function still accepts the
2637 obsolete forms in case some old Lisp code still generates them. */
2661uintmax_t 2638uintmax_t
2662cons_to_unsigned (Lisp_Object c, uintmax_t max) 2639cons_to_unsigned (Lisp_Object c, uintmax_t max)
2663{ 2640{
2664 bool valid = false; 2641 bool valid = false;
2665 uintmax_t val UNINIT; 2642 uintmax_t val UNINIT;
2666 if (FIXNUMP (c)) 2643
2667 { 2644 if (FLOATP (c))
2668 valid = XFIXNUM (c) >= 0;
2669 val = XFIXNUM (c);
2670 }
2671 else if (FLOATP (c))
2672 { 2645 {
2673 double d = XFLOAT_DATA (c); 2646 double d = XFLOAT_DATA (c);
2674 if (d >= 0 && d < 1.0 + max) 2647 if (d >= 0 && d < 1.0 + max)
@@ -2677,27 +2650,44 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max)
2677 valid = val == d; 2650 valid = val == d;
2678 } 2651 }
2679 } 2652 }
2680 else if (CONSP (c) && FIXNATP (XCAR (c))) 2653 else
2681 { 2654 {
2682 uintmax_t top = XFIXNAT (XCAR (c)); 2655 Lisp_Object hi = CONSP (c) ? XCAR (c) : c;
2683 Lisp_Object rest = XCDR (c); 2656
2684 if (top <= UINTMAX_MAX >> 24 >> 16 2657 if (FIXNUMP (hi))
2685 && CONSP (rest)
2686 && FIXNATP (XCAR (rest)) && XFIXNAT (XCAR (rest)) < 1 << 24
2687 && FIXNATP (XCDR (rest)) && XFIXNAT (XCDR (rest)) < 1 << 16)
2688 { 2658 {
2689 uintmax_t mid = XFIXNAT (XCAR (rest)); 2659 val = XFIXNUM (hi);
2690 val = top << 24 << 16 | mid << 16 | XFIXNAT (XCDR (rest)); 2660 valid = 0 <= val;
2691 valid = true;
2692 } 2661 }
2693 else if (top <= UINTMAX_MAX >> 16) 2662 else
2694 { 2663 {
2695 if (CONSP (rest)) 2664 val = bignum_to_uintmax (hi);
2696 rest = XCAR (rest); 2665 valid = val != 0;
2697 if (FIXNATP (rest) && XFIXNAT (rest) < 1 << 16) 2666 }
2667
2668 if (valid && CONSP (c))
2669 {
2670 uintmax_t top = val;
2671 Lisp_Object rest = XCDR (c);
2672 if (top <= UINTMAX_MAX >> 24 >> 16
2673 && CONSP (rest)
2674 && FIXNATP (XCAR (rest)) && XFIXNAT (XCAR (rest)) < 1 << 24
2675 && FIXNATP (XCDR (rest)) && XFIXNAT (XCDR (rest)) < 1 << 16)
2698 { 2676 {
2699 val = top << 16 | XFIXNAT (rest); 2677 uintmax_t mid = XFIXNAT (XCAR (rest));
2700 valid = true; 2678 val = top << 24 << 16 | mid << 16 | XFIXNAT (XCDR (rest));
2679 }
2680 else
2681 {
2682 valid = top <= UINTMAX_MAX >> 16;
2683 if (valid)
2684 {
2685 if (CONSP (rest))
2686 rest = XCAR (rest);
2687 valid = FIXNATP (rest) && XFIXNAT (rest) < 1 << 16;
2688 if (valid)
2689 val = top << 16 | XFIXNAT (rest);
2690 }
2701 } 2691 }
2702 } 2692 }
2703 } 2693 }
@@ -2711,18 +2701,18 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max)
2711 value with extrema MIN and MAX. MAX should be one less than a 2701 value with extrema MIN and MAX. MAX should be one less than a
2712 power of 2, and MIN should be zero or the negative of a power of 2. 2702 power of 2, and MIN should be zero or the negative of a power of 2.
2713 Signal an error if C does not have a valid format or is out of 2703 Signal an error if C does not have a valid format or is out of
2714 range. */ 2704 range.
2705
2706 Although Emacs represents large integers with bignums instead of
2707 cons-of-integers or floats, for now this function still accepts the
2708 obsolete forms in case some old Lisp code still generates them. */
2715intmax_t 2709intmax_t
2716cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) 2710cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
2717{ 2711{
2718 bool valid = false; 2712 bool valid = false;
2719 intmax_t val UNINIT; 2713 intmax_t val UNINIT;
2720 if (FIXNUMP (c)) 2714
2721 { 2715 if (FLOATP (c))
2722 val = XFIXNUM (c);
2723 valid = true;
2724 }
2725 else if (FLOATP (c))
2726 { 2716 {
2727 double d = XFLOAT_DATA (c); 2717 double d = XFLOAT_DATA (c);
2728 if (d >= min && d < 1.0 + max) 2718 if (d >= min && d < 1.0 + max)
@@ -2731,27 +2721,44 @@ cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
2731 valid = val == d; 2721 valid = val == d;
2732 } 2722 }
2733 } 2723 }
2734 else if (CONSP (c) && FIXNUMP (XCAR (c))) 2724 else
2735 { 2725 {
2736 intmax_t top = XFIXNUM (XCAR (c)); 2726 Lisp_Object hi = CONSP (c) ? XCAR (c) : c;
2737 Lisp_Object rest = XCDR (c); 2727
2738 if (top >= INTMAX_MIN >> 24 >> 16 && top <= INTMAX_MAX >> 24 >> 16 2728 if (FIXNUMP (hi))
2739 && CONSP (rest)
2740 && FIXNATP (XCAR (rest)) && XFIXNAT (XCAR (rest)) < 1 << 24
2741 && FIXNATP (XCDR (rest)) && XFIXNAT (XCDR (rest)) < 1 << 16)
2742 { 2729 {
2743 intmax_t mid = XFIXNAT (XCAR (rest)); 2730 val = XFIXNUM (hi);
2744 val = top << 24 << 16 | mid << 16 | XFIXNAT (XCDR (rest));
2745 valid = true; 2731 valid = true;
2746 } 2732 }
2747 else if (top >= INTMAX_MIN >> 16 && top <= INTMAX_MAX >> 16) 2733 else if (BIGNUMP (hi))
2748 { 2734 {
2749 if (CONSP (rest)) 2735 val = bignum_to_intmax (hi);
2750 rest = XCAR (rest); 2736 valid = val != 0;
2751 if (FIXNATP (rest) && XFIXNAT (rest) < 1 << 16) 2737 }
2738
2739 if (valid && CONSP (c))
2740 {
2741 intmax_t top = val;
2742 Lisp_Object rest = XCDR (c);
2743 if (top >= INTMAX_MIN >> 24 >> 16 && top <= INTMAX_MAX >> 24 >> 16
2744 && CONSP (rest)
2745 && FIXNATP (XCAR (rest)) && XFIXNAT (XCAR (rest)) < 1 << 24
2746 && FIXNATP (XCDR (rest)) && XFIXNAT (XCDR (rest)) < 1 << 16)
2747 {
2748 intmax_t mid = XFIXNAT (XCAR (rest));
2749 val = top << 24 << 16 | mid << 16 | XFIXNAT (XCDR (rest));
2750 }
2751 else
2752 { 2752 {
2753 val = top << 16 | XFIXNAT (rest); 2753 valid = INTMAX_MIN >> 16 <= top && top <= INTMAX_MAX >> 16;
2754 valid = true; 2754 if (valid)
2755 {
2756 if (CONSP (rest))
2757 rest = XCAR (rest);
2758 valid = FIXNATP (rest) && XFIXNAT (rest) < 1 << 16;
2759 if (valid)
2760 val = top << 16 | XFIXNAT (rest);
2761 }
2755 } 2762 }
2756 } 2763 }
2757 } 2764 }
@@ -2770,11 +2777,11 @@ NUMBER may be an integer or a floating point number. */)
2770 char buffer[max (FLOAT_TO_STRING_BUFSIZE, INT_BUFSIZE_BOUND (EMACS_INT))]; 2777 char buffer[max (FLOAT_TO_STRING_BUFSIZE, INT_BUFSIZE_BOUND (EMACS_INT))];
2771 int len; 2778 int len;
2772 2779
2780 CHECK_NUMBER (number);
2781
2773 if (BIGNUMP (number)) 2782 if (BIGNUMP (number))
2774 return bignum_to_string (number, 10); 2783 return bignum_to_string (number, 10);
2775 2784
2776 CHECK_FIXNUM_OR_FLOAT (number);
2777
2778 if (FLOATP (number)) 2785 if (FLOATP (number))
2779 len = float_to_string (buffer, XFLOAT_DATA (number)); 2786 len = float_to_string (buffer, XFLOAT_DATA (number));
2780 else 2787 else