diff options
| author | Paul Eggert | 2018-08-21 02:16:50 -0700 |
|---|---|---|
| committer | Paul Eggert | 2018-08-21 02:38:53 -0700 |
| commit | d6a497dd887cdbb35c5b4e2929e83962ba708159 (patch) | |
| tree | 9f0441f9fe88419b71e568b05ef7f7bea0a0ff06 | |
| parent | 77fc2725985b4e5ef977ae6930835c7f0771c61c (diff) | |
| download | emacs-d6a497dd887cdbb35c5b4e2929e83962ba708159.tar.gz emacs-d6a497dd887cdbb35c5b4e2929e83962ba708159.zip | |
Avoid libgmp aborts by imposing limits
libgmp calls ‘abort’ when given numbers too big for its
internal data structures. The numeric limit is large and
platform-dependent; with 64-bit GMP 6.1.2 it is around
2**2**37. Work around the problem by refusing to call libgmp
functions with arguments that would cause an abort. With luck
libgmp will have a better way to do this in the future.
Also, introduce a variable integer-width that lets the user
control how large bignums can be. This currently defaults
to 2**16, i.e., it allows bignums up to 2**2**16. This
should be enough for ordinary computation, and should
help Emacs to avoid thrashing or hanging.
Problem noted by Pip Cet (Bug#32463#71).
* doc/lispref/numbers.texi, etc/NEWS:
Document recent bignum changes, including this one.
Improve documentation for bitwise operations, in the light
of bignums.
* src/alloc.c (make_number): Enforce integer-width.
(integer_overflow): New function.
(xrealloc_for_gmp, xfree_for_gmp):
Move here from emacs.c, as it's memory allocation.
(init_alloc): Initialize GMP here, rather than in emacs.c.
(integer_width): New var.
* src/data.c (GMP_NLIMBS_MAX, NLIMBS_LIMIT): New constants.
(emacs_mpz_size, emacs_mpz_mul)
(emacs_mpz_mul_2exp, emacs_mpz_pow_ui): New functions.
(arith_driver, Fash, expt_integer): Use them.
(expt_integer): New function, containing integer code
that was out of place in floatfns.c.
(check_bignum_size, xmalloc_for_gmp): Remove.
* src/emacs.c (main): Do not initialize GMP here.
* src/floatfns.c (Fexpt): Use expt_integer, which
now contains integer code moved from here.
* src/lisp.h (GMP_NUMB_BITS): Define if gmp.h doesn’t.
| -rw-r--r-- | doc/lispref/numbers.texi | 314 | ||||
| -rw-r--r-- | etc/NEWS | 6 | ||||
| -rw-r--r-- | src/alloc.c | 73 | ||||
| -rw-r--r-- | src/data.c | 109 | ||||
| -rw-r--r-- | src/emacs.c | 34 | ||||
| -rw-r--r-- | src/floatfns.c | 24 | ||||
| -rw-r--r-- | src/lisp.h | 11 |
7 files changed, 321 insertions, 250 deletions
diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 209e9f139a5..9c16b1a64c4 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi | |||
| @@ -34,13 +34,21 @@ numbers have a fixed amount of precision. | |||
| 34 | @node Integer Basics | 34 | @node Integer Basics |
| 35 | @section Integer Basics | 35 | @section Integer Basics |
| 36 | 36 | ||
| 37 | Integers in Emacs Lisp can have arbitrary precision. | 37 | Integers in Emacs Lisp are not limited to the machine word size. |
| 38 | 38 | ||
| 39 | Under the hood, though, there are two kinds of integers: smaller | 39 | Under the hood, though, there are two kinds of integers: smaller |
| 40 | ones, called @dfn{fixnums}, and larger ones, called @dfn{bignums}. | 40 | ones, called @dfn{fixnums}, and larger ones, called @dfn{bignums}. |
| 41 | Some functions in Emacs only accept fixnums. Also, while fixnums can | 41 | Some functions in Emacs accept only fixnums. Also, while fixnums can |
| 42 | always be compared for equality with @code{eq}, bignums require the | 42 | always be compared for numeric equality with @code{eq}, bignums |
| 43 | use of @code{eql}. | 43 | require more-heavyweight equality predicates like @code{eql}. |
| 44 | |||
| 45 | The range of values for bignums is limited by the amount of main | ||
| 46 | memory, by machine characteristics such as the size of the word used | ||
| 47 | to represent a bignum's exponent, and by the @code{integer-width} | ||
| 48 | variable. These limits are typically much more generous than the | ||
| 49 | limits for fixnums. A bignum is never numerically equal to a fixnum; | ||
| 50 | if Emacs computes an integer in fixnum range, it represents the | ||
| 51 | integer as a fixnum, not a bignum. | ||
| 44 | 52 | ||
| 45 | The range of values for a fixnum depends on the machine. The | 53 | The range of values for a fixnum depends on the machine. The |
| 46 | minimum range is @minus{}536,870,912 to 536,870,911 (30 bits; i.e., | 54 | minimum range is @minus{}536,870,912 to 536,870,911 (30 bits; i.e., |
| @@ -97,33 +105,30 @@ For example: | |||
| 97 | #24r1k @result{} 44 | 105 | #24r1k @result{} 44 |
| 98 | @end example | 106 | @end example |
| 99 | 107 | ||
| 100 | An integer is read as a fixnum if it is in the correct range. | ||
| 101 | Otherwise, it will be read as a bignum. | ||
| 102 | |||
| 103 | To understand how various functions work on integers, especially the | 108 | To understand how various functions work on integers, especially the |
| 104 | bitwise operators (@pxref{Bitwise Operations}), it is often helpful to | 109 | bitwise operators (@pxref{Bitwise Operations}), it is often helpful to |
| 105 | view the numbers in their binary form. | 110 | view the numbers in their binary form. |
| 106 | 111 | ||
| 107 | In 30-bit binary, the decimal integer 5 looks like this: | 112 | In binary, the decimal integer 5 looks like this: |
| 108 | 113 | ||
| 109 | @example | 114 | @example |
| 110 | 0000...000101 (30 bits total) | 115 | ...000101 |
| 111 | @end example | 116 | @end example |
| 112 | 117 | ||
| 113 | @noindent | 118 | @noindent |
| 114 | (The @samp{...} stands for enough bits to fill out a 30-bit word; in | 119 | (The @samp{...} stands for a conceptually infinite number of bits that |
| 115 | this case, @samp{...} stands for twenty 0 bits. Later examples also | 120 | match the leading bit; here, an infinite number of 0 bits. Later |
| 116 | use the @samp{...} notation to make binary integers easier to read.) | 121 | examples also use this @samp{...} notation.) |
| 117 | 122 | ||
| 118 | The integer @minus{}1 looks like this: | 123 | The integer @minus{}1 looks like this: |
| 119 | 124 | ||
| 120 | @example | 125 | @example |
| 121 | 1111...111111 (30 bits total) | 126 | ...111111 |
| 122 | @end example | 127 | @end example |
| 123 | 128 | ||
| 124 | @noindent | 129 | @noindent |
| 125 | @cindex two's complement | 130 | @cindex two's complement |
| 126 | @minus{}1 is represented as 30 ones. (This is called @dfn{two's | 131 | @minus{}1 is represented as all ones. (This is called @dfn{two's |
| 127 | complement} notation.) | 132 | complement} notation.) |
| 128 | 133 | ||
| 129 | Subtracting 4 from @minus{}1 returns the negative integer @minus{}5. | 134 | Subtracting 4 from @minus{}1 returns the negative integer @minus{}5. |
| @@ -131,14 +136,7 @@ In binary, the decimal integer 4 is 100. Consequently, | |||
| 131 | @minus{}5 looks like this: | 136 | @minus{}5 looks like this: |
| 132 | 137 | ||
| 133 | @example | 138 | @example |
| 134 | 1111...111011 (30 bits total) | 139 | ...111011 |
| 135 | @end example | ||
| 136 | |||
| 137 | In this implementation, the largest 30-bit binary integer is | ||
| 138 | 536,870,911 in decimal. In binary, it looks like this: | ||
| 139 | |||
| 140 | @example | ||
| 141 | 0111...111111 (30 bits total) | ||
| 142 | @end example | 140 | @end example |
| 143 | 141 | ||
| 144 | Many of the functions described in this chapter accept markers for | 142 | Many of the functions described in this chapter accept markers for |
| @@ -147,10 +145,10 @@ arguments to such functions may be either numbers or markers, we often | |||
| 147 | give these arguments the name @var{number-or-marker}. When the argument | 145 | give these arguments the name @var{number-or-marker}. When the argument |
| 148 | value is a marker, its position value is used and its buffer is ignored. | 146 | value is a marker, its position value is used and its buffer is ignored. |
| 149 | 147 | ||
| 150 | @cindex largest Lisp integer | 148 | @cindex largest fixnum |
| 151 | @cindex maximum Lisp integer | 149 | @cindex maximum fixnum |
| 152 | @defvar most-positive-fixnum | 150 | @defvar most-positive-fixnum |
| 153 | The value of this variable is the largest ``small'' integer that Emacs | 151 | The value of this variable is the greatest ``small'' integer that Emacs |
| 154 | Lisp can handle. Typical values are | 152 | Lisp can handle. Typical values are |
| 155 | @ifnottex | 153 | @ifnottex |
| 156 | 2**29 @minus{} 1 | 154 | 2**29 @minus{} 1 |
| @@ -168,11 +166,11 @@ on 32-bit and | |||
| 168 | on 64-bit platforms. | 166 | on 64-bit platforms. |
| 169 | @end defvar | 167 | @end defvar |
| 170 | 168 | ||
| 171 | @cindex smallest Lisp integer | 169 | @cindex smallest fixnum |
| 172 | @cindex minimum Lisp integer | 170 | @cindex minimum fixnum |
| 173 | @defvar most-negative-fixnum | 171 | @defvar most-negative-fixnum |
| 174 | The value of this variable is the smallest small integer that Emacs | 172 | The value of this variable is the numerically least ``small'' integer |
| 175 | Lisp can handle. It is negative. Typical values are | 173 | that Emacs Lisp can handle. It is negative. Typical values are |
| 176 | @ifnottex | 174 | @ifnottex |
| 177 | @minus{}2**29 | 175 | @minus{}2**29 |
| 178 | @end ifnottex | 176 | @end ifnottex |
| @@ -189,6 +187,19 @@ on 32-bit and | |||
| 189 | on 64-bit platforms. | 187 | on 64-bit platforms. |
| 190 | @end defvar | 188 | @end defvar |
| 191 | 189 | ||
| 190 | @cindex bignum range | ||
| 191 | @cindex integer range | ||
| 192 | @defvar integer-width | ||
| 193 | The value of this variable is a nonnegative integer that is an upper | ||
| 194 | bound on the number of bits in a bignum. Integers outside the fixnum | ||
| 195 | range are limited to absolute values less than 2@sup{@var{n}}, where | ||
| 196 | @var{n} is this variable's value. Attempts to create bignums outside | ||
| 197 | this range result in integer overflow. Setting this variable to zero | ||
| 198 | disables creation of bignums; setting it to a large number can cause | ||
| 199 | Emacs to consume large quantities of memory if a computation creates | ||
| 200 | huge integers. | ||
| 201 | @end defvar | ||
| 202 | |||
| 192 | In Emacs Lisp, text characters are represented by integers. Any | 203 | In Emacs Lisp, text characters are represented by integers. Any |
| 193 | integer between zero and the value of @code{(max-char)}, inclusive, is | 204 | integer between zero and the value of @code{(max-char)}, inclusive, is |
| 194 | considered to be valid as a character. @xref{Character Codes}. | 205 | considered to be valid as a character. @xref{Character Codes}. |
| @@ -378,17 +389,17 @@ comparison, and sometimes returns @code{t} when a non-numeric | |||
| 378 | comparison would return @code{nil} and vice versa. @xref{Float | 389 | comparison would return @code{nil} and vice versa. @xref{Float |
| 379 | Basics}. | 390 | Basics}. |
| 380 | 391 | ||
| 381 | In Emacs Lisp, each small integer is a unique Lisp object. | 392 | In Emacs Lisp, if two fixnums are numerically equal, they are the |
| 382 | Therefore, @code{eq} is equivalent to @code{=} where small integers are | 393 | same Lisp object. That is, @code{eq} is equivalent to @code{=} on |
| 383 | concerned. It is sometimes convenient to use @code{eq} for comparing | 394 | fixnums. It is sometimes convenient to use @code{eq} for comparing |
| 384 | an unknown value with an integer, because @code{eq} does not report an | 395 | an unknown value with a fixnum, because @code{eq} does not report an |
| 385 | error if the unknown value is not a number---it accepts arguments of | 396 | error if the unknown value is not a number---it accepts arguments of |
| 386 | any type. By contrast, @code{=} signals an error if the arguments are | 397 | any type. By contrast, @code{=} signals an error if the arguments are |
| 387 | not numbers or markers. However, it is better programming practice to | 398 | not numbers or markers. However, it is better programming practice to |
| 388 | use @code{=} if you can, even for comparing integers. | 399 | use @code{=} if you can, even for comparing integers. |
| 389 | 400 | ||
| 390 | Sometimes it is useful to compare numbers with @code{equal}, which | 401 | Sometimes it is useful to compare numbers with @code{eql} or @code{equal}, |
| 391 | treats two numbers as equal if they have the same data type (both | 402 | which treat two numbers as equal if they have the same data type (both |
| 392 | integers, or both floating point) and the same value. By contrast, | 403 | integers, or both floating point) and the same value. By contrast, |
| 393 | @code{=} can treat an integer and a floating-point number as equal. | 404 | @code{=} can treat an integer and a floating-point number as equal. |
| 394 | @xref{Equality Predicates}. | 405 | @xref{Equality Predicates}. |
| @@ -830,142 +841,113 @@ Rounding a value equidistant between two integers returns the even integer. | |||
| 830 | @cindex logical arithmetic | 841 | @cindex logical arithmetic |
| 831 | 842 | ||
| 832 | In a computer, an integer is represented as a binary number, a | 843 | In a computer, an integer is represented as a binary number, a |
| 833 | sequence of @dfn{bits} (digits which are either zero or one). A bitwise | 844 | sequence of @dfn{bits} (digits which are either zero or one). |
| 845 | Conceptually the bit sequence is infinite on the left, with the | ||
| 846 | most-significant bits being all zeros or all ones. A bitwise | ||
| 834 | operation acts on the individual bits of such a sequence. For example, | 847 | operation acts on the individual bits of such a sequence. For example, |
| 835 | @dfn{shifting} moves the whole sequence left or right one or more places, | 848 | @dfn{shifting} moves the whole sequence left or right one or more places, |
| 836 | reproducing the same pattern moved over. | 849 | reproducing the same pattern moved over. |
| 837 | 850 | ||
| 838 | The bitwise operations in Emacs Lisp apply only to integers. | 851 | The bitwise operations in Emacs Lisp apply only to integers. |
| 839 | 852 | ||
| 840 | @defun lsh integer1 count | 853 | @defun ash integer1 count |
| 841 | @cindex logical shift | 854 | @cindex arithmetic shift |
| 842 | @code{lsh}, which is an abbreviation for @dfn{logical shift}, shifts the | 855 | @code{ash} (@dfn{arithmetic shift}) shifts the bits in @var{integer1} |
| 843 | bits in @var{integer1} to the left @var{count} places, or to the right | 856 | to the left @var{count} places, or to the right if @var{count} is |
| 844 | if @var{count} is negative, bringing zeros into the vacated bits. If | 857 | negative. Left shifts introduce zero bits on the right; right shifts |
| 845 | @var{count} is negative, @code{lsh} shifts zeros into the leftmost | 858 | discard the rightmost bits. Considered as an integer operation, |
| 846 | (most-significant) bit, producing a nonnegative result even if | 859 | @code{ash} multiplies @var{integer1} by 2@sup{@var{count}} and then |
| 847 | @var{integer1} is negative fixnum. (If @var{integer1} is a negative | 860 | converts the result to an integer by rounding downward, toward |
| 848 | bignum, @var{count} must be nonnegative.) Contrast this with | 861 | minus infinity. |
| 849 | @code{ash}, below. | 862 | |
| 850 | 863 | Here are examples of @code{ash}, shifting a pattern of bits one place | |
| 851 | Here are two examples of @code{lsh}, shifting a pattern of bits one | 864 | to the left and to the right. These examples show only the low-order |
| 852 | place to the left. We show only the low-order eight bits of the binary | 865 | bits of the binary pattern; leading bits all agree with the |
| 853 | pattern; the rest are all zero. | 866 | highest-order bit shown. As you can see, shifting left by one is |
| 867 | equivalent to multiplying by two, whereas shifting right by one is | ||
| 868 | equivalent to dividing by two and then rounding toward minus infinity. | ||
| 854 | 869 | ||
| 855 | @example | 870 | @example |
| 856 | @group | 871 | @group |
| 857 | (lsh 5 1) | 872 | (ash 7 1) @result{} 14 |
| 858 | @result{} 10 | ||
| 859 | ;; @r{Decimal 5 becomes decimal 10.} | ||
| 860 | 00000101 @result{} 00001010 | ||
| 861 | |||
| 862 | (lsh 7 1) | ||
| 863 | @result{} 14 | ||
| 864 | ;; @r{Decimal 7 becomes decimal 14.} | 873 | ;; @r{Decimal 7 becomes decimal 14.} |
| 865 | 00000111 @result{} 00001110 | 874 | ...000111 |
| 866 | @end group | 875 | @result{} |
| 867 | @end example | 876 | ...001110 |
| 868 | |||
| 869 | @noindent | ||
| 870 | As the examples illustrate, shifting the pattern of bits one place to | ||
| 871 | the left produces a number that is twice the value of the previous | ||
| 872 | number. | ||
| 873 | |||
| 874 | Shifting a pattern of bits two places to the left produces results | ||
| 875 | like this (with 8-bit binary numbers): | ||
| 876 | |||
| 877 | @example | ||
| 878 | @group | ||
| 879 | (lsh 3 2) | ||
| 880 | @result{} 12 | ||
| 881 | ;; @r{Decimal 3 becomes decimal 12.} | ||
| 882 | 00000011 @result{} 00001100 | ||
| 883 | @end group | 877 | @end group |
| 884 | @end example | ||
| 885 | |||
| 886 | On the other hand, shifting one place to the right looks like this: | ||
| 887 | 878 | ||
| 888 | @example | ||
| 889 | @group | 879 | @group |
| 890 | (lsh 6 -1) | 880 | (ash 7 -1) @result{} 3 |
| 891 | @result{} 3 | 881 | ...000111 |
| 892 | ;; @r{Decimal 6 becomes decimal 3.} | 882 | @result{} |
| 893 | 00000110 @result{} 00000011 | 883 | ...000011 |
| 894 | @end group | 884 | @end group |
| 895 | 885 | ||
| 896 | @group | 886 | @group |
| 897 | (lsh 5 -1) | 887 | (ash -7 1) @result{} -14 |
| 898 | @result{} 2 | 888 | ...111001 |
| 899 | ;; @r{Decimal 5 becomes decimal 2.} | 889 | @result{} |
| 900 | 00000101 @result{} 00000010 | 890 | ...110010 |
| 901 | @end group | 891 | @end group |
| 902 | @end example | ||
| 903 | |||
| 904 | @noindent | ||
| 905 | As the example illustrates, shifting one place to the right divides the | ||
| 906 | value of a positive integer by two, rounding downward. | ||
| 907 | @end defun | ||
| 908 | |||
| 909 | @defun ash integer1 count | ||
| 910 | @cindex arithmetic shift | ||
| 911 | @code{ash} (@dfn{arithmetic shift}) shifts the bits in @var{integer1} | ||
| 912 | to the left @var{count} places, or to the right if @var{count} | ||
| 913 | is negative. | ||
| 914 | |||
| 915 | @code{ash} gives the same results as @code{lsh} except when | ||
| 916 | @var{integer1} and @var{count} are both negative. In that case, | ||
| 917 | @code{ash} puts ones in the empty bit positions on the left, while | ||
| 918 | @code{lsh} puts zeros in those bit positions and requires | ||
| 919 | @var{integer1} to be a fixnum. | ||
| 920 | 892 | ||
| 921 | Thus, with @code{ash}, shifting the pattern of bits one place to the right | ||
| 922 | looks like this: | ||
| 923 | |||
| 924 | @example | ||
| 925 | @group | 893 | @group |
| 926 | (ash -6 -1) @result{} -3 | 894 | (ash -7 -1) @result{} -4 |
| 927 | ;; @r{Decimal @minus{}6 becomes decimal @minus{}3.} | 895 | ...111001 |
| 928 | 1111...111010 (30 bits total) | ||
| 929 | @result{} | 896 | @result{} |
| 930 | 1111...111101 (30 bits total) | 897 | ...111100 |
| 931 | @end group | 898 | @end group |
| 932 | @end example | 899 | @end example |
| 933 | 900 | ||
| 934 | Here are other examples: | 901 | Here are examples of shifting left or right by two bits: |
| 935 | 902 | ||
| 936 | @c !!! Check if lined up in smallbook format! XDVI shows problem | ||
| 937 | @c with smallbook but not with regular book! --rjc 16mar92 | ||
| 938 | @smallexample | 903 | @smallexample |
| 939 | @group | 904 | @group |
| 940 | ; @r{ 30-bit binary values} | 905 | ; @r{ binary values} |
| 941 | 906 | (ash 5 2) ; 5 = @r{...000101} | |
| 942 | (lsh 5 2) ; 5 = @r{0000...000101} | 907 | @result{} 20 ; = @r{...010100} |
| 943 | @result{} 20 ; = @r{0000...010100} | 908 | (ash -5 2) ; -5 = @r{...111011} |
| 944 | @end group | 909 | @result{} -20 ; = @r{...101100} |
| 945 | @group | ||
| 946 | (ash 5 2) | ||
| 947 | @result{} 20 | ||
| 948 | (lsh -5 2) ; -5 = @r{1111...111011} | ||
| 949 | @result{} -20 ; = @r{1111...101100} | ||
| 950 | (ash -5 2) | ||
| 951 | @result{} -20 | ||
| 952 | @end group | 910 | @end group |
| 953 | @group | 911 | @group |
| 954 | (lsh 5 -2) ; 5 = @r{0000...000101} | 912 | (ash 5 -2) |
| 955 | @result{} 1 ; = @r{0000...000001} | 913 | @result{} 1 ; = @r{...000001} |
| 956 | @end group | 914 | @end group |
| 957 | @group | 915 | @group |
| 958 | (ash 5 -2) | 916 | (ash -5 -2) |
| 959 | @result{} 1 | 917 | @result{} -2 ; = @r{...111110} |
| 960 | @end group | 918 | @end group |
| 919 | @end smallexample | ||
| 920 | @end defun | ||
| 921 | |||
| 922 | @defun lsh integer1 count | ||
| 923 | @cindex logical shift | ||
| 924 | @code{lsh}, which is an abbreviation for @dfn{logical shift}, shifts the | ||
| 925 | bits in @var{integer1} to the left @var{count} places, or to the right | ||
| 926 | if @var{count} is negative, bringing zeros into the vacated bits. If | ||
| 927 | @var{count} is negative, then @var{integer1} must be either a fixnum | ||
| 928 | or a positive bignum, and @code{lsh} treats a negative fixnum as if it | ||
| 929 | were unsigned by subtracting twice @code{most-negative-fixnum} before | ||
| 930 | shifting, producing a nonnegative result. This quirky behavior dates | ||
| 931 | back to when Emacs supported only fixnums; nowadays @code{ash} is a | ||
| 932 | better choice. | ||
| 933 | |||
| 934 | As @code{lsh} behaves like @code{ash} except when @var{integer1} and | ||
| 935 | @var{count1} are both negative, the following examples focus on these | ||
| 936 | exceptional cases. These examples assume 30-bit fixnums. | ||
| 937 | |||
| 938 | @smallexample | ||
| 961 | @group | 939 | @group |
| 962 | (lsh -5 -2) ; -5 = @r{1111...111011} | 940 | ; @r{ binary values} |
| 963 | @result{} 268435454 | 941 | (ash -7 -1) ; -7 = @r{...111111111111111111111111111001} |
| 964 | ; = @r{0011...111110} | 942 | @result{} -4 ; = @r{...111111111111111111111111111100} |
| 943 | (lsh -7 -1) | ||
| 944 | @result{} 536870908 ; = @r{...011111111111111111111111111100} | ||
| 965 | @end group | 945 | @end group |
| 966 | @group | 946 | @group |
| 967 | (ash -5 -2) ; -5 = @r{1111...111011} | 947 | (ash -5 -2) ; -5 = @r{...111111111111111111111111111011} |
| 968 | @result{} -2 ; = @r{1111...111110} | 948 | @result{} -2 ; = @r{...111111111111111111111111111110} |
| 949 | (lsh -5 -2) | ||
| 950 | @result{} 268435454 ; = @r{...001111111111111111111111111110} | ||
| 969 | @end group | 951 | @end group |
| 970 | @end smallexample | 952 | @end smallexample |
| 971 | @end defun | 953 | @end defun |
| @@ -999,23 +981,23 @@ because its binary representation consists entirely of ones. If | |||
| 999 | 981 | ||
| 1000 | @smallexample | 982 | @smallexample |
| 1001 | @group | 983 | @group |
| 1002 | ; @r{ 30-bit binary values} | 984 | ; @r{ binary values} |
| 1003 | 985 | ||
| 1004 | (logand 14 13) ; 14 = @r{0000...001110} | 986 | (logand 14 13) ; 14 = @r{...001110} |
| 1005 | ; 13 = @r{0000...001101} | 987 | ; 13 = @r{...001101} |
| 1006 | @result{} 12 ; 12 = @r{0000...001100} | 988 | @result{} 12 ; 12 = @r{...001100} |
| 1007 | @end group | 989 | @end group |
| 1008 | 990 | ||
| 1009 | @group | 991 | @group |
| 1010 | (logand 14 13 4) ; 14 = @r{0000...001110} | 992 | (logand 14 13 4) ; 14 = @r{...001110} |
| 1011 | ; 13 = @r{0000...001101} | 993 | ; 13 = @r{...001101} |
| 1012 | ; 4 = @r{0000...000100} | 994 | ; 4 = @r{...000100} |
| 1013 | @result{} 4 ; 4 = @r{0000...000100} | 995 | @result{} 4 ; 4 = @r{...000100} |
| 1014 | @end group | 996 | @end group |
| 1015 | 997 | ||
| 1016 | @group | 998 | @group |
| 1017 | (logand) | 999 | (logand) |
| 1018 | @result{} -1 ; -1 = @r{1111...111111} | 1000 | @result{} -1 ; -1 = @r{...111111} |
| 1019 | @end group | 1001 | @end group |
| 1020 | @end smallexample | 1002 | @end smallexample |
| 1021 | @end defun | 1003 | @end defun |
| @@ -1029,18 +1011,18 @@ passed just one argument, it returns that argument. | |||
| 1029 | 1011 | ||
| 1030 | @smallexample | 1012 | @smallexample |
| 1031 | @group | 1013 | @group |
| 1032 | ; @r{ 30-bit binary values} | 1014 | ; @r{ binary values} |
| 1033 | 1015 | ||
| 1034 | (logior 12 5) ; 12 = @r{0000...001100} | 1016 | (logior 12 5) ; 12 = @r{...001100} |
| 1035 | ; 5 = @r{0000...000101} | 1017 | ; 5 = @r{...000101} |
| 1036 | @result{} 13 ; 13 = @r{0000...001101} | 1018 | @result{} 13 ; 13 = @r{...001101} |
| 1037 | @end group | 1019 | @end group |
| 1038 | 1020 | ||
| 1039 | @group | 1021 | @group |
| 1040 | (logior 12 5 7) ; 12 = @r{0000...001100} | 1022 | (logior 12 5 7) ; 12 = @r{...001100} |
| 1041 | ; 5 = @r{0000...000101} | 1023 | ; 5 = @r{...000101} |
| 1042 | ; 7 = @r{0000...000111} | 1024 | ; 7 = @r{...000111} |
| 1043 | @result{} 15 ; 15 = @r{0000...001111} | 1025 | @result{} 15 ; 15 = @r{...001111} |
| 1044 | @end group | 1026 | @end group |
| 1045 | @end smallexample | 1027 | @end smallexample |
| 1046 | @end defun | 1028 | @end defun |
| @@ -1054,18 +1036,18 @@ result is 0, which is an identity element for this operation. If | |||
| 1054 | 1036 | ||
| 1055 | @smallexample | 1037 | @smallexample |
| 1056 | @group | 1038 | @group |
| 1057 | ; @r{ 30-bit binary values} | 1039 | ; @r{ binary values} |
| 1058 | 1040 | ||
| 1059 | (logxor 12 5) ; 12 = @r{0000...001100} | 1041 | (logxor 12 5) ; 12 = @r{...001100} |
| 1060 | ; 5 = @r{0000...000101} | 1042 | ; 5 = @r{...000101} |
| 1061 | @result{} 9 ; 9 = @r{0000...001001} | 1043 | @result{} 9 ; 9 = @r{...001001} |
| 1062 | @end group | 1044 | @end group |
| 1063 | 1045 | ||
| 1064 | @group | 1046 | @group |
| 1065 | (logxor 12 5 7) ; 12 = @r{0000...001100} | 1047 | (logxor 12 5 7) ; 12 = @r{...001100} |
| 1066 | ; 5 = @r{0000...000101} | 1048 | ; 5 = @r{...000101} |
| 1067 | ; 7 = @r{0000...000111} | 1049 | ; 7 = @r{...000111} |
| 1068 | @result{} 14 ; 14 = @r{0000...001110} | 1050 | @result{} 14 ; 14 = @r{...001110} |
| 1069 | @end group | 1051 | @end group |
| 1070 | @end smallexample | 1052 | @end smallexample |
| 1071 | @end defun | 1053 | @end defun |
| @@ -1078,9 +1060,9 @@ bit is one in the result if, and only if, the @var{n}th bit is zero in | |||
| 1078 | @example | 1060 | @example |
| 1079 | (lognot 5) | 1061 | (lognot 5) |
| 1080 | @result{} -6 | 1062 | @result{} -6 |
| 1081 | ;; 5 = @r{0000...000101} (30 bits total) | 1063 | ;; 5 = @r{...000101} |
| 1082 | ;; @r{becomes} | 1064 | ;; @r{becomes} |
| 1083 | ;; -6 = @r{1111...111010} (30 bits total) | 1065 | ;; -6 = @r{...111010} |
| 1084 | @end example | 1066 | @end example |
| 1085 | @end defun | 1067 | @end defun |
| 1086 | 1068 | ||
| @@ -1095,9 +1077,9 @@ its two's complement binary representation. The result is always | |||
| 1095 | nonnegative. | 1077 | nonnegative. |
| 1096 | 1078 | ||
| 1097 | @example | 1079 | @example |
| 1098 | (logcount 43) ; 43 = #b101011 | 1080 | (logcount 43) ; 43 = @r{...000101011} |
| 1099 | @result{} 4 | 1081 | @result{} 4 |
| 1100 | (logcount -43) ; -43 = #b111...1010101 | 1082 | (logcount -43) ; -43 = @r{...111010101} |
| 1101 | @result{} 3 | 1083 | @result{} 3 |
| 1102 | @end example | 1084 | @end example |
| 1103 | @end defun | 1085 | @end defun |
| @@ -871,6 +871,12 @@ bignums. However, note that unlike fixnums, bignums will not compare | |||
| 871 | equal with 'eq', you must use 'eql' instead. (Numerical comparison | 871 | equal with 'eq', you must use 'eql' instead. (Numerical comparison |
| 872 | with '=' works on both, of course.) | 872 | with '=' works on both, of course.) |
| 873 | 873 | ||
| 874 | +++ | ||
| 875 | ** New variable 'integer-width'. | ||
| 876 | It is a nonnegative integer specifying the maximum number of bits | ||
| 877 | allowed in a bignum. Integer overflow occurs if this limit is | ||
| 878 | exceeded. | ||
| 879 | |||
| 874 | ** define-minor-mode automatically documents the meaning of ARG | 880 | ** define-minor-mode automatically documents the meaning of ARG |
| 875 | 881 | ||
| 876 | +++ | 882 | +++ |
diff --git a/src/alloc.c b/src/alloc.c index ddc0696ba91..24a24aab96b 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -3746,33 +3746,33 @@ make_bignum_str (const char *num, int base) | |||
| 3746 | Lisp_Object | 3746 | Lisp_Object |
| 3747 | make_number (mpz_t value) | 3747 | make_number (mpz_t value) |
| 3748 | { | 3748 | { |
| 3749 | if (mpz_fits_slong_p (value)) | 3749 | size_t bits = mpz_sizeinbase (value, 2); |
| 3750 | { | 3750 | |
| 3751 | long l = mpz_get_si (value); | 3751 | if (bits <= FIXNUM_BITS) |
| 3752 | if (!FIXNUM_OVERFLOW_P (l)) | ||
| 3753 | return make_fixnum (l); | ||
| 3754 | } | ||
| 3755 | else if (LONG_WIDTH < FIXNUM_BITS) | ||
| 3756 | { | 3752 | { |
| 3757 | size_t bits = mpz_sizeinbase (value, 2); | 3753 | EMACS_INT v = 0; |
| 3754 | int i = 0, shift = 0; | ||
| 3758 | 3755 | ||
| 3759 | if (bits <= FIXNUM_BITS) | 3756 | do |
| 3760 | { | 3757 | { |
| 3761 | EMACS_INT v = 0; | 3758 | EMACS_INT limb = mpz_getlimbn (value, i++); |
| 3762 | int i = 0; | 3759 | v += limb << shift; |
| 3763 | for (int shift = 0; shift < bits; shift += mp_bits_per_limb) | 3760 | shift += GMP_NUMB_BITS; |
| 3764 | { | 3761 | } |
| 3765 | EMACS_INT limb = mpz_getlimbn (value, i++); | 3762 | while (shift < bits); |
| 3766 | v += limb << shift; | ||
| 3767 | } | ||
| 3768 | if (mpz_sgn (value) < 0) | ||
| 3769 | v = -v; | ||
| 3770 | 3763 | ||
| 3771 | if (!FIXNUM_OVERFLOW_P (v)) | 3764 | if (mpz_sgn (value) < 0) |
| 3772 | return make_fixnum (v); | 3765 | v = -v; |
| 3773 | } | 3766 | |
| 3767 | if (!FIXNUM_OVERFLOW_P (v)) | ||
| 3768 | return make_fixnum (v); | ||
| 3774 | } | 3769 | } |
| 3775 | 3770 | ||
| 3771 | /* The documentation says integer-width should be nonnegative, so | ||
| 3772 | a single comparison suffices even though 'bits' is unsigned. */ | ||
| 3773 | if (integer_width < bits) | ||
| 3774 | integer_overflow (); | ||
| 3775 | |||
| 3776 | struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, | 3776 | struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, |
| 3777 | PVEC_BIGNUM); | 3777 | PVEC_BIGNUM); |
| 3778 | /* We could mpz_init + mpz_swap here, to avoid a copy, but the | 3778 | /* We could mpz_init + mpz_swap here, to avoid a copy, but the |
| @@ -7200,6 +7200,26 @@ verify_alloca (void) | |||
| 7200 | 7200 | ||
| 7201 | #endif /* ENABLE_CHECKING && USE_STACK_LISP_OBJECTS */ | 7201 | #endif /* ENABLE_CHECKING && USE_STACK_LISP_OBJECTS */ |
| 7202 | 7202 | ||
| 7203 | /* Memory allocation for GMP. */ | ||
| 7204 | |||
| 7205 | void | ||
| 7206 | integer_overflow (void) | ||
| 7207 | { | ||
| 7208 | error ("Integer too large to be represented"); | ||
| 7209 | } | ||
| 7210 | |||
| 7211 | static void * | ||
| 7212 | xrealloc_for_gmp (void *ptr, size_t ignore, size_t size) | ||
| 7213 | { | ||
| 7214 | return xrealloc (ptr, size); | ||
| 7215 | } | ||
| 7216 | |||
| 7217 | static void | ||
| 7218 | xfree_for_gmp (void *ptr, size_t ignore) | ||
| 7219 | { | ||
| 7220 | xfree (ptr); | ||
| 7221 | } | ||
| 7222 | |||
| 7203 | /* Initialization. */ | 7223 | /* Initialization. */ |
| 7204 | 7224 | ||
| 7205 | void | 7225 | void |
| @@ -7233,6 +7253,10 @@ init_alloc_once (void) | |||
| 7233 | void | 7253 | void |
| 7234 | init_alloc (void) | 7254 | init_alloc (void) |
| 7235 | { | 7255 | { |
| 7256 | eassert (mp_bits_per_limb == GMP_NUMB_BITS); | ||
| 7257 | integer_width = 1 << 16; | ||
| 7258 | mp_set_memory_functions (xmalloc, xrealloc_for_gmp, xfree_for_gmp); | ||
| 7259 | |||
| 7236 | Vgc_elapsed = make_float (0.0); | 7260 | Vgc_elapsed = make_float (0.0); |
| 7237 | gcs_done = 0; | 7261 | gcs_done = 0; |
| 7238 | 7262 | ||
| @@ -7335,6 +7359,11 @@ The time is in seconds as a floating point value. */); | |||
| 7335 | DEFVAR_INT ("gcs-done", gcs_done, | 7359 | DEFVAR_INT ("gcs-done", gcs_done, |
| 7336 | doc: /* Accumulated number of garbage collections done. */); | 7360 | doc: /* Accumulated number of garbage collections done. */); |
| 7337 | 7361 | ||
| 7362 | DEFVAR_INT ("integer-width", integer_width, | ||
| 7363 | doc: /* Maximum number of bits in bignums. | ||
| 7364 | Integers outside the fixnum range are limited to absolute values less | ||
| 7365 | than 2**N, where N is this variable's value. N should be nonnegative. */); | ||
| 7366 | |||
| 7338 | defsubr (&Scons); | 7367 | defsubr (&Scons); |
| 7339 | defsubr (&Slist); | 7368 | defsubr (&Slist); |
| 7340 | defsubr (&Svector); | 7369 | defsubr (&Svector); |
diff --git a/src/data.c b/src/data.c index 8a6975da3ab..4c6d33f2940 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -2384,6 +2384,80 @@ bool-vector. IDX starts at 0. */) | |||
| 2384 | return newelt; | 2384 | return newelt; |
| 2385 | } | 2385 | } |
| 2386 | 2386 | ||
| 2387 | /* GMP tests for this value and aborts (!) if it is exceeded. | ||
| 2388 | This is as of GMP 6.1.2 (2016); perhaps future versions will differ. */ | ||
| 2389 | enum { GMP_NLIMBS_MAX = min (INT_MAX, ULONG_MAX / GMP_NUMB_BITS) }; | ||
| 2390 | |||
| 2391 | /* An upper bound on limb counts, needed to prevent libgmp and/or | ||
| 2392 | Emacs from aborting or otherwise misbehaving. This bound applies | ||
| 2393 | to estimates of mpz_t sizes before the mpz_t objects are created, | ||
| 2394 | as opposed to integer-width which operates on mpz_t values after | ||
| 2395 | creation and before conversion to Lisp bignums. */ | ||
| 2396 | enum | ||
| 2397 | { | ||
| 2398 | NLIMBS_LIMIT = min (min (/* libgmp needs to store limb counts. */ | ||
| 2399 | GMP_NLIMBS_MAX, | ||
| 2400 | |||
| 2401 | /* Size calculations need to work. */ | ||
| 2402 | min (PTRDIFF_MAX, SIZE_MAX) / sizeof (mp_limb_t)), | ||
| 2403 | |||
| 2404 | /* Emacs puts bit counts into fixnums. */ | ||
| 2405 | MOST_POSITIVE_FIXNUM / GMP_NUMB_BITS) | ||
| 2406 | }; | ||
| 2407 | |||
| 2408 | /* Like mpz_size, but tell the compiler the result is a nonnegative int. */ | ||
| 2409 | |||
| 2410 | static int | ||
| 2411 | emacs_mpz_size (mpz_t const op) | ||
| 2412 | { | ||
| 2413 | mp_size_t size = mpz_size (op); | ||
| 2414 | eassume (0 <= size && size <= INT_MAX); | ||
| 2415 | return size; | ||
| 2416 | } | ||
| 2417 | |||
| 2418 | /* Wrappers to work around GMP limitations. As of GMP 6.1.2 (2016), | ||
| 2419 | the library code aborts when a number is too large. These wrappers | ||
| 2420 | avoid the problem for functions that can return numbers much larger | ||
| 2421 | than their arguments. For slowly-growing numbers, the integer | ||
| 2422 | width check in make_number should suffice. */ | ||
| 2423 | |||
| 2424 | static void | ||
| 2425 | emacs_mpz_mul (mpz_t rop, mpz_t const op1, mpz_t const op2) | ||
| 2426 | { | ||
| 2427 | if (NLIMBS_LIMIT - emacs_mpz_size (op1) < emacs_mpz_size (op2)) | ||
| 2428 | integer_overflow (); | ||
| 2429 | mpz_mul (rop, op1, op2); | ||
| 2430 | } | ||
| 2431 | |||
| 2432 | static void | ||
| 2433 | emacs_mpz_mul_2exp (mpz_t rop, mpz_t const op1, mp_bitcnt_t op2) | ||
| 2434 | { | ||
| 2435 | /* Fudge factor derived from GMP 6.1.2, to avoid an abort in | ||
| 2436 | mpz_mul_2exp (look for the '+ 1' in its source code). */ | ||
| 2437 | enum { mul_2exp_extra_limbs = 1 }; | ||
| 2438 | enum { lim = min (NLIMBS_LIMIT, GMP_NLIMBS_MAX - mul_2exp_extra_limbs) }; | ||
| 2439 | |||
| 2440 | mp_bitcnt_t op2limbs = op2 / GMP_NUMB_BITS; | ||
| 2441 | if (lim - emacs_mpz_size (op1) < op2limbs) | ||
| 2442 | integer_overflow (); | ||
| 2443 | mpz_mul_2exp (rop, op1, op2); | ||
| 2444 | } | ||
| 2445 | |||
| 2446 | static void | ||
| 2447 | emacs_mpz_pow_ui (mpz_t rop, mpz_t const base, unsigned long exp) | ||
| 2448 | { | ||
| 2449 | /* This fudge factor is derived from GMP 6.1.2, to avoid an abort in | ||
| 2450 | mpz_n_pow_ui (look for the '5' in its source code). */ | ||
| 2451 | enum { pow_ui_extra_limbs = 5 }; | ||
| 2452 | enum { lim = min (NLIMBS_LIMIT, GMP_NLIMBS_MAX - pow_ui_extra_limbs) }; | ||
| 2453 | |||
| 2454 | int nbase = emacs_mpz_size (base), n; | ||
| 2455 | if (INT_MULTIPLY_WRAPV (nbase, exp, &n) || lim < n) | ||
| 2456 | integer_overflow (); | ||
| 2457 | mpz_pow_ui (rop, base, exp); | ||
| 2458 | } | ||
| 2459 | |||
| 2460 | |||
| 2387 | /* Arithmetic functions */ | 2461 | /* Arithmetic functions */ |
| 2388 | 2462 | ||
| 2389 | Lisp_Object | 2463 | Lisp_Object |
| @@ -2872,13 +2946,13 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args) | |||
| 2872 | break; | 2946 | break; |
| 2873 | case Amult: | 2947 | case Amult: |
| 2874 | if (BIGNUMP (val)) | 2948 | if (BIGNUMP (val)) |
| 2875 | mpz_mul (accum, accum, XBIGNUM (val)->value); | 2949 | emacs_mpz_mul (accum, accum, XBIGNUM (val)->value); |
| 2876 | else if (! FIXNUMS_FIT_IN_LONG) | 2950 | else if (! FIXNUMS_FIT_IN_LONG) |
| 2877 | { | 2951 | { |
| 2878 | mpz_t tem; | 2952 | mpz_t tem; |
| 2879 | mpz_init (tem); | 2953 | mpz_init (tem); |
| 2880 | mpz_set_intmax (tem, XFIXNUM (val)); | 2954 | mpz_set_intmax (tem, XFIXNUM (val)); |
| 2881 | mpz_mul (accum, accum, tem); | 2955 | emacs_mpz_mul (accum, accum, tem); |
| 2882 | mpz_clear (tem); | 2956 | mpz_clear (tem); |
| 2883 | } | 2957 | } |
| 2884 | else | 2958 | else |
| @@ -3293,7 +3367,7 @@ In this case, the sign bit is duplicated. */) | |||
| 3293 | mpz_t result; | 3367 | mpz_t result; |
| 3294 | mpz_init (result); | 3368 | mpz_init (result); |
| 3295 | if (XFIXNUM (count) > 0) | 3369 | if (XFIXNUM (count) > 0) |
| 3296 | mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count)); | 3370 | emacs_mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count)); |
| 3297 | else | 3371 | else |
| 3298 | mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count)); | 3372 | mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count)); |
| 3299 | val = make_number (result); | 3373 | val = make_number (result); |
| @@ -3319,7 +3393,7 @@ In this case, the sign bit is duplicated. */) | |||
| 3319 | mpz_set_intmax (result, XFIXNUM (value)); | 3393 | mpz_set_intmax (result, XFIXNUM (value)); |
| 3320 | 3394 | ||
| 3321 | if (XFIXNUM (count) >= 0) | 3395 | if (XFIXNUM (count) >= 0) |
| 3322 | mpz_mul_2exp (result, result, XFIXNUM (count)); | 3396 | emacs_mpz_mul_2exp (result, result, XFIXNUM (count)); |
| 3323 | else | 3397 | else |
| 3324 | mpz_fdiv_q_2exp (result, result, - XFIXNUM (count)); | 3398 | mpz_fdiv_q_2exp (result, result, - XFIXNUM (count)); |
| 3325 | 3399 | ||
| @@ -3330,6 +3404,33 @@ In this case, the sign bit is duplicated. */) | |||
| 3330 | return val; | 3404 | return val; |
| 3331 | } | 3405 | } |
| 3332 | 3406 | ||
| 3407 | /* Return X ** Y as an integer. X and Y must be integers, and Y must | ||
| 3408 | be nonnegative. */ | ||
| 3409 | |||
| 3410 | Lisp_Object | ||
| 3411 | expt_integer (Lisp_Object x, Lisp_Object y) | ||
| 3412 | { | ||
| 3413 | unsigned long exp; | ||
| 3414 | if (TYPE_RANGED_FIXNUMP (unsigned long, y)) | ||
| 3415 | exp = XFIXNUM (y); | ||
| 3416 | else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (y) | ||
| 3417 | && mpz_fits_ulong_p (XBIGNUM (y)->value)) | ||
| 3418 | exp = mpz_get_ui (XBIGNUM (y)->value); | ||
| 3419 | else | ||
| 3420 | integer_overflow (); | ||
| 3421 | |||
| 3422 | mpz_t val; | ||
| 3423 | mpz_init (val); | ||
| 3424 | emacs_mpz_pow_ui (val, | ||
| 3425 | (FIXNUMP (x) | ||
| 3426 | ? (mpz_set_intmax (val, XFIXNUM (x)), val) | ||
| 3427 | : XBIGNUM (x)->value), | ||
| 3428 | exp); | ||
| 3429 | Lisp_Object res = make_number (val); | ||
| 3430 | mpz_clear (val); | ||
| 3431 | return res; | ||
| 3432 | } | ||
| 3433 | |||
| 3333 | DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, | 3434 | DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, |
| 3334 | doc: /* Return NUMBER plus one. NUMBER may be a number or a marker. | 3435 | doc: /* Return NUMBER plus one. NUMBER may be a number or a marker. |
| 3335 | Markers are converted to integers. */) | 3436 | Markers are converted to integers. */) |
diff --git a/src/emacs.c b/src/emacs.c index 11ee0b81180..7d07ec85029 100644 --- a/src/emacs.c +++ b/src/emacs.c | |||
| @@ -673,38 +673,6 @@ close_output_streams (void) | |||
| 673 | _exit (EXIT_FAILURE); | 673 | _exit (EXIT_FAILURE); |
| 674 | } | 674 | } |
| 675 | 675 | ||
| 676 | /* Memory allocation functions for GMP. */ | ||
| 677 | |||
| 678 | static void | ||
| 679 | check_bignum_size (size_t size) | ||
| 680 | { | ||
| 681 | /* Do not create a bignum whose log base 2 could exceed fixnum range. | ||
| 682 | This way, functions like mpz_popcount return values in fixnum range. | ||
| 683 | It may also help to avoid other problems with outlandish bignums. */ | ||
| 684 | if (MOST_POSITIVE_FIXNUM / CHAR_BIT < size) | ||
| 685 | error ("Integer too large to be represented"); | ||
| 686 | } | ||
| 687 | |||
| 688 | static void * ATTRIBUTE_MALLOC | ||
| 689 | xmalloc_for_gmp (size_t size) | ||
| 690 | { | ||
| 691 | check_bignum_size (size); | ||
| 692 | return xmalloc (size); | ||
| 693 | } | ||
| 694 | |||
| 695 | static void * | ||
| 696 | xrealloc_for_gmp (void *ptr, size_t ignore, size_t size) | ||
| 697 | { | ||
| 698 | check_bignum_size (size); | ||
| 699 | return xrealloc (ptr, size); | ||
| 700 | } | ||
| 701 | |||
| 702 | static void | ||
| 703 | xfree_for_gmp (void *ptr, size_t ignore) | ||
| 704 | { | ||
| 705 | xfree (ptr); | ||
| 706 | } | ||
| 707 | |||
| 708 | /* ARGSUSED */ | 676 | /* ARGSUSED */ |
| 709 | int | 677 | int |
| 710 | main (int argc, char **argv) | 678 | main (int argc, char **argv) |
| @@ -803,8 +771,6 @@ main (int argc, char **argv) | |||
| 803 | init_standard_fds (); | 771 | init_standard_fds (); |
| 804 | atexit (close_output_streams); | 772 | atexit (close_output_streams); |
| 805 | 773 | ||
| 806 | mp_set_memory_functions (xmalloc_for_gmp, xrealloc_for_gmp, xfree_for_gmp); | ||
| 807 | |||
| 808 | sort_args (argc, argv); | 774 | sort_args (argc, argv); |
| 809 | argc = 0; | 775 | argc = 0; |
| 810 | while (argv[argc]) argc++; | 776 | while (argv[argc]) argc++; |
diff --git a/src/floatfns.c b/src/floatfns.c index 7c52a0a9a20..ea9000b90a0 100644 --- a/src/floatfns.c +++ b/src/floatfns.c | |||
| @@ -210,29 +210,7 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, | |||
| 210 | /* Common Lisp spec: don't promote if both are integers, and if the | 210 | /* Common Lisp spec: don't promote if both are integers, and if the |
| 211 | result is not fractional. */ | 211 | result is not fractional. */ |
| 212 | if (INTEGERP (arg1) && NATNUMP (arg2)) | 212 | if (INTEGERP (arg1) && NATNUMP (arg2)) |
| 213 | { | 213 | return expt_integer (arg1, arg2); |
| 214 | unsigned long exp; | ||
| 215 | if (TYPE_RANGED_FIXNUMP (unsigned long, arg2)) | ||
| 216 | exp = XFIXNUM (arg2); | ||
| 217 | else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (arg2) | ||
| 218 | && mpz_fits_ulong_p (XBIGNUM (arg2)->value)) | ||
| 219 | exp = mpz_get_ui (XBIGNUM (arg2)->value); | ||
| 220 | else | ||
| 221 | xsignal3 (Qrange_error, build_string ("expt"), arg1, arg2); | ||
| 222 | |||
| 223 | mpz_t val; | ||
| 224 | mpz_init (val); | ||
| 225 | if (FIXNUMP (arg1)) | ||
| 226 | { | ||
| 227 | mpz_set_intmax (val, XFIXNUM (arg1)); | ||
| 228 | mpz_pow_ui (val, val, exp); | ||
| 229 | } | ||
| 230 | else | ||
| 231 | mpz_pow_ui (val, XBIGNUM (arg1)->value, exp); | ||
| 232 | Lisp_Object res = make_number (val); | ||
| 233 | mpz_clear (val); | ||
| 234 | return res; | ||
| 235 | } | ||
| 236 | 214 | ||
| 237 | return make_float (pow (XFLOATINT (arg1), XFLOATINT (arg2))); | 215 | return make_float (pow (XFLOATINT (arg1), XFLOATINT (arg2))); |
| 238 | } | 216 | } |
diff --git a/src/lisp.h b/src/lisp.h index fe384d1844b..8f48a334844 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -996,6 +996,14 @@ enum More_Lisp_Bits | |||
| 996 | #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) | 996 | #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) |
| 997 | #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) | 997 | #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) |
| 998 | 998 | ||
| 999 | |||
| 1000 | /* GMP-related limits. */ | ||
| 1001 | |||
| 1002 | /* Number of data bits in a limb. */ | ||
| 1003 | #ifndef GMP_NUMB_BITS | ||
| 1004 | enum { GMP_NUMB_BITS = TYPE_WIDTH (mp_limb_t) }; | ||
| 1005 | #endif | ||
| 1006 | |||
| 999 | #if USE_LSB_TAG | 1007 | #if USE_LSB_TAG |
| 1000 | 1008 | ||
| 1001 | INLINE Lisp_Object | 1009 | INLINE Lisp_Object |
| @@ -3338,7 +3346,7 @@ extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, | |||
| 3338 | enum Set_Internal_Bind); | 3346 | enum Set_Internal_Bind); |
| 3339 | extern void set_default_internal (Lisp_Object, Lisp_Object, | 3347 | extern void set_default_internal (Lisp_Object, Lisp_Object, |
| 3340 | enum Set_Internal_Bind bindflag); | 3348 | enum Set_Internal_Bind bindflag); |
| 3341 | 3349 | extern Lisp_Object expt_integer (Lisp_Object, Lisp_Object); | |
| 3342 | extern void syms_of_data (void); | 3350 | extern void syms_of_data (void); |
| 3343 | extern void swap_in_global_binding (struct Lisp_Symbol *); | 3351 | extern void swap_in_global_binding (struct Lisp_Symbol *); |
| 3344 | 3352 | ||
| @@ -3700,6 +3708,7 @@ extern void display_malloc_warning (void); | |||
| 3700 | extern ptrdiff_t inhibit_garbage_collection (void); | 3708 | extern ptrdiff_t inhibit_garbage_collection (void); |
| 3701 | extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); | 3709 | extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); |
| 3702 | extern void free_cons (struct Lisp_Cons *); | 3710 | extern void free_cons (struct Lisp_Cons *); |
| 3711 | extern _Noreturn void integer_overflow (void); | ||
| 3703 | extern void init_alloc_once (void); | 3712 | extern void init_alloc_once (void); |
| 3704 | extern void init_alloc (void); | 3713 | extern void init_alloc (void); |
| 3705 | extern void syms_of_alloc (void); | 3714 | extern void syms_of_alloc (void); |