commit 74712470fcb95cd4ef6ef5c61eee73cb8e02a8bd (HEAD, refs/remotes/origin/master) Author: Noam Postavsky Date: Sun Apr 28 16:29:44 2019 -0400 Replace use of obsolete string-make-unibyte * lisp/image-file.el (insert-image-file): Use encode-coding-region instead of string-make-unibyte. * test/lisp/image-file-tests.el: New test. diff --git a/lisp/image-file.el b/lisp/image-file.el index abc4686d69..6cadc42110 100644 --- a/lisp/image-file.el +++ b/lisp/image-file.el @@ -110,11 +110,8 @@ absolute file name and number of characters inserted." (let* ((ibeg (point)) (iend (+ (point) (cadr rval))) (visitingp (and visit (= ibeg (point-min)) (= iend (point-max)))) - (data - (string-make-unibyte - (buffer-substring-no-properties ibeg iend))) - (image - (create-image data nil t)) + (image (create-image (encode-coding-region ibeg iend 'binary t) + nil t)) (props `(display ,image yank-handler diff --git a/test/lisp/image-file-tests.el b/test/lisp/image-file-tests.el new file mode 100644 index 0000000000..b3676d1f02 --- /dev/null +++ b/test/lisp/image-file-tests.el @@ -0,0 +1,44 @@ +;;; image-file-tests.el --- Test suite for image-files -*- lexical-binding: t; -*- + +;; Copyright (C) 2019 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'image-file) + +(defconst image-file-tests-data-directory + (expand-file-name "data/image" (getenv "EMACS_TEST_DIRECTORY")) + "Directory containing image test data.") + +(ert-deftest insert-image-file () + (skip-unless (image-type-available-p 'png)) + (with-temp-buffer + (set-buffer-multibyte t) + (insert-image-file (expand-file-name "blank-100x200.png" + image-file-tests-data-directory)) + (should (image--get-image))) + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-image-file (expand-file-name "blank-100x200.png" + image-file-tests-data-directory)) + (should (image--get-image)))) + +;;; image-file-tests.el ends here commit caadbd94921b66fd6820dbc95783765837b931f7 Author: Noam Postavsky Date: Sat Apr 20 15:31:51 2019 -0400 ; Add test for previous change * test/lisp/progmodes/python-tests.el (python-indent-hanging-close-paren): New test. diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index b940f45bb9..a517909717 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -260,6 +260,19 @@ foo = long_function_name( (should (eq (car (python-indent-context)) :inside-paren-newline-start)) (should (= (python-indent-calculate-indentation) 4)))) +(ert-deftest python-indent-hanging-close-paren () + "Like first pep8 case, but with hanging close paren." ;; See Bug#20742. + (python-tests-with-temp-buffer + "\ +foo = long_function_name(var_one, var_two, + var_three, var_four + ) +" + (should (= (python-indent-calculate-indentation) 0)) + (python-tests-look-at ")") + (should (eq (car (python-indent-context)) :inside-paren-at-closing-paren)) + (should (= (python-indent-calculate-indentation) 25)))) + (ert-deftest python-indent-base-case () "Check base case does not trigger errors." (python-tests-with-temp-buffer commit 3fc1d77a43818666542740fc34167c1faee30d5f Author: Tommi Komulainen Date: Fri Jun 19 18:53:52 2015 +0200 python.el: Fix close paren indentation to match pep8 (Bug#20742) * lisp/progmodes/python.el (python-indent--calculate-indentation): When opening paren is followed by newline the closing paren should follow the current indentation. Otherwise the closing paren should be aligned with the opening paren. This fixes the latter case. Copyright-paperwork-exempt: yes diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index eb3e31c4b7..188bc973d9 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1070,12 +1070,18 @@ possibilities can be narrowed to specific indentation points." (`(,(or :after-line :after-comment :inside-string - :after-backslash - :inside-paren-at-closing-paren - :inside-paren-at-closing-nested-paren) . ,start) + :after-backslash) . ,start) ;; Copy previous indentation. (goto-char start) (current-indentation)) + (`(,(or :inside-paren-at-closing-paren + :inside-paren-at-closing-nested-paren) . ,start) + (goto-char (+ 1 start)) + (if (looking-at "[ \t]*\\(?:#\\|$\\)") + ;; Copy previous indentation. + (current-indentation) + ;; Align with opening paren. + (current-column))) (`(:inside-docstring . ,start) (let* ((line-indentation (current-indentation)) (base-indent (progn commit 9469d58ebe10b280a89c77ccdc89bd2340766107 Author: Paul Eggert Date: Sun Apr 28 13:14:49 2019 -0700 Update from GMP * admin/update-copyright (updatable_files): Don’t update copyright year on files copied from GMP, so that they’re identical to upstream. * src/mini-gmp.c, src/mini-gmp.h: Copy from GMP development versions as of 2019-01-01 20:15:39 UTC. diff --git a/admin/update-copyright b/admin/update-copyright index 44cb84d8cc..9f360904ce 100755 --- a/admin/update-copyright +++ b/admin/update-copyright @@ -50,6 +50,7 @@ repo_files=$(git ls-files) && # Do not update the copyright of files that have one or more of the # following problems: # . They are license files, maintained by the FSF, with their own dates. +# . They are GMP files, maintained by the GMP project, with their own dates. # . Their format cannot withstand changing the contents of copyright strings. updatable_files=$(find $repo_files \ @@ -70,6 +71,7 @@ updatable_files=$(find $repo_files \ ! -name hand.cur \ ! -name key.pub \ ! -name key.sec \ + ! -name 'mini-gmp.[ch]' \ -print) && build-aux/update-copyright $updatable_files diff --git a/src/mini-gmp.c b/src/mini-gmp.c index 90beb6e832..88b71c3f9a 100644 --- a/src/mini-gmp.c +++ b/src/mini-gmp.c @@ -2,7 +2,7 @@ Contributed to the GNU project by Niels Möller -Copyright 1991-1997, 1999-2019 Free Software Foundation, Inc. +Copyright 1991-1997, 1999-2018 Free Software Foundation, Inc. This file is part of the GNU MP Library. @@ -58,7 +58,7 @@ see https://www.gnu.org/licenses/. */ /* Macros */ #define GMP_LIMB_BITS (sizeof(mp_limb_t) * CHAR_BIT) -#define GMP_LIMB_MAX (~ (mp_limb_t) 0) +#define GMP_LIMB_MAX ((mp_limb_t) ~ (mp_limb_t) 0) #define GMP_LIMB_HIGHBIT ((mp_limb_t) 1 << (GMP_LIMB_BITS - 1)) #define GMP_HLIMB_BIT ((mp_limb_t) 1 << (GMP_LIMB_BITS / 2)) @@ -129,6 +129,20 @@ see https://www.gnu.org/licenses/. */ #define gmp_umul_ppmm(w1, w0, u, v) \ do { \ + int LOCAL_GMP_LIMB_BITS = GMP_LIMB_BITS; \ + if (sizeof(unsigned int) * CHAR_BIT >= 2 * GMP_LIMB_BITS) \ + { \ + unsigned int __ww = (unsigned int) (u) * (v); \ + w0 = (mp_limb_t) __ww; \ + w1 = (mp_limb_t) (__ww >> LOCAL_GMP_LIMB_BITS); \ + } \ + else if (GMP_ULONG_BITS >= 2 * GMP_LIMB_BITS) \ + { \ + unsigned long int __ww = (unsigned long int) (u) * (v); \ + w0 = (mp_limb_t) __ww; \ + w1 = (mp_limb_t) (__ww >> LOCAL_GMP_LIMB_BITS); \ + } \ + else { \ mp_limb_t __x0, __x1, __x2, __x3; \ unsigned __ul, __vl, __uh, __vh; \ mp_limb_t __u = (u), __v = (v); \ @@ -150,6 +164,7 @@ see https://www.gnu.org/licenses/. */ \ (w1) = __x3 + (__x1 >> (GMP_LIMB_BITS / 2)); \ (w0) = (__x1 << (GMP_LIMB_BITS / 2)) + (__x0 & GMP_LLIMB_MASK); \ + } \ } while (0) #define gmp_udiv_qrnnd_preinv(q, r, nh, nl, d, di) \ @@ -753,6 +768,18 @@ mpn_neg (mp_ptr rp, mp_srcptr up, mp_size_t n) mp_limb_t mpn_invert_3by2 (mp_limb_t u1, mp_limb_t u0) { + int GMP_LIMB_BITS_MUL_3 = GMP_LIMB_BITS * 3; + if (sizeof (unsigned) * CHAR_BIT > GMP_LIMB_BITS * 3) + { + return (((unsigned) 1 << GMP_LIMB_BITS_MUL_3) - 1) / + (((unsigned) u1 << GMP_LIMB_BITS_MUL_3 / 3) + u0); + } + else if (GMP_ULONG_BITS > GMP_LIMB_BITS * 3) + { + return (((unsigned long) 1 << GMP_LIMB_BITS_MUL_3) - 1) / + (((unsigned long) u1 << GMP_LIMB_BITS_MUL_3 / 3) + u0); + } + else { mp_limb_t r, p, m, ql; unsigned ul, uh, qh; @@ -827,7 +854,7 @@ mpn_invert_3by2 (mp_limb_t u1, mp_limb_t u0) r -= u1; } - /* Now m is the 2/1 invers of u1. If u0 > 0, adjust it to become a + /* Now m is the 2/1 inverse of u1. If u0 > 0, adjust it to become a 3/2 inverse. */ if (u0 > 0) { @@ -854,6 +881,7 @@ mpn_invert_3by2 (mp_limb_t u1, mp_limb_t u0) } return m; + } } struct gmp_div_inverse @@ -964,36 +992,6 @@ mpn_div_qr_1_preinv (mp_ptr qp, mp_srcptr np, mp_size_t nn, return r >> inv->shift; } -static mp_limb_t -mpn_div_qr_1 (mp_ptr qp, mp_srcptr np, mp_size_t nn, mp_limb_t d) -{ - assert (d > 0); - - /* Special case for powers of two. */ - if ((d & (d-1)) == 0) - { - mp_limb_t r = np[0] & (d-1); - if (qp) - { - if (d <= 1) - mpn_copyi (qp, np, nn); - else - { - unsigned shift; - gmp_ctz (shift, d); - mpn_rshift (qp, np, nn, shift); - } - } - return r; - } - else - { - struct gmp_div_inverse inv; - mpn_div_qr_1_invert (&inv, d); - return mpn_div_qr_1_preinv (qp, np, nn, &inv); - } -} - static void mpn_div_qr_2_preinv (mp_ptr qp, mp_ptr np, mp_size_t nn, const struct gmp_div_inverse *inv) @@ -1029,7 +1027,7 @@ mpn_div_qr_2_preinv (mp_ptr qp, mp_ptr np, mp_size_t nn, if (shift > 0) { - assert ((r0 << (GMP_LIMB_BITS - shift)) == 0); + assert ((r0 & (GMP_LIMB_MAX >> (GMP_LIMB_BITS - shift))) == 0); r0 = (r0 >> shift) | (r1 << (GMP_LIMB_BITS - shift)); r1 >>= shift; } @@ -1252,7 +1250,7 @@ mpn_limb_get_str (unsigned char *sp, mp_limb_t w, l = w << binv->shift; gmp_udiv_qrnnd_preinv (w, r, h, l, binv->d1, binv->di); - assert ( (r << (GMP_LIMB_BITS - binv->shift)) == 0); + assert ((r & (GMP_LIMB_MAX >> (GMP_LIMB_BITS - binv->shift))) == 0); r >>= binv->shift; sp[i] = r; @@ -1420,7 +1418,7 @@ mpn_set_str (mp_ptr rp, const unsigned char *sp, size_t sn, int base) void mpz_init (mpz_t r) { - static const mp_limb_t dummy_limb = 0xc1a0; + static const mp_limb_t dummy_limb = GMP_LIMB_MAX & 0xc1a0; r->_mp_alloc = 0; r->_mp_size = 0; @@ -1478,6 +1476,12 @@ mpz_set_si (mpz_t r, signed long int x) if (x >= 0) mpz_set_ui (r, x); else /* (x < 0) */ + if (GMP_LIMB_BITS < GMP_ULONG_BITS) + { + mpz_set_ui (r, GMP_NEG_CAST (unsigned long int, x)); + mpz_neg (r, r); + } + else { r->_mp_size = -1; MPZ_REALLOC (r, 1)[0] = GMP_NEG_CAST (unsigned long int, x); @@ -1491,6 +1495,15 @@ mpz_set_ui (mpz_t r, unsigned long int x) { r->_mp_size = 1; MPZ_REALLOC (r, 1)[0] = x; + if (GMP_LIMB_BITS < GMP_ULONG_BITS) + { + int LOCAL_GMP_LIMB_BITS = GMP_LIMB_BITS; + while (x >>= LOCAL_GMP_LIMB_BITS) + { + ++ r->_mp_size; + MPZ_REALLOC (r, r->_mp_size)[r->_mp_size - 1] = x; + } + } } else r->_mp_size = 0; @@ -1537,14 +1550,20 @@ mpz_init_set (mpz_t r, const mpz_t x) int mpz_fits_slong_p (const mpz_t u) { - mp_size_t us = u->_mp_size; + return (LONG_MAX + LONG_MIN == 0 || mpz_cmp_ui (u, LONG_MAX) <= 0) && + mpz_cmpabs_ui (u, GMP_NEG_CAST (unsigned long int, LONG_MIN)) <= 0; +} - if (us == 1) - return u->_mp_d[0] < GMP_LIMB_HIGHBIT; - else if (us == -1) - return u->_mp_d[0] <= GMP_LIMB_HIGHBIT; - else - return (us == 0); +static int +mpn_absfits_ulong_p (mp_srcptr up, mp_size_t un) +{ + int ulongsize = GMP_ULONG_BITS / GMP_LIMB_BITS; + mp_limb_t ulongrem = 0; + + if (GMP_ULONG_BITS % GMP_LIMB_BITS != 0) + ulongrem = (mp_limb_t) (ULONG_MAX >> GMP_LIMB_BITS * ulongsize) + 1; + + return un <= ulongsize || (up[ulongsize] < ulongrem && un == ulongsize + 1); } int @@ -1552,22 +1571,36 @@ mpz_fits_ulong_p (const mpz_t u) { mp_size_t us = u->_mp_size; - return (us == (us > 0)); + return us >= 0 && mpn_absfits_ulong_p (u->_mp_d, us); } long int mpz_get_si (const mpz_t u) { + unsigned long r = mpz_get_ui (u); + unsigned long c = -LONG_MAX - LONG_MIN; + if (u->_mp_size < 0) - /* This expression is necessary to properly handle 0x80000000 */ - return -1 - (long) ((u->_mp_d[0] - 1) & ~GMP_LIMB_HIGHBIT); + /* This expression is necessary to properly handle -LONG_MIN */ + return -(long) c - (long) ((r - c) & LONG_MAX); else - return (long) (mpz_get_ui (u) & ~GMP_LIMB_HIGHBIT); + return (long) (r & LONG_MAX); } unsigned long int mpz_get_ui (const mpz_t u) { + if (GMP_LIMB_BITS < GMP_ULONG_BITS) + { + int LOCAL_GMP_LIMB_BITS = GMP_LIMB_BITS; + unsigned long r = 0; + mp_size_t n = GMP_ABS (u->_mp_size); + n = GMP_MIN (n, 1 + (GMP_ULONG_BITS - 1) / GMP_LIMB_BITS); + while (--n >= 0) + r = (r << LOCAL_GMP_LIMB_BITS) + u->_mp_d[n]; + return r; + } + return u->_mp_size == 0 ? 0 : u->_mp_d[0]; } @@ -1665,7 +1698,7 @@ mpz_set_d (mpz_t r, double x) r->_mp_size = 0; return; } - B = 2.0 * (double) GMP_LIMB_HIGHBIT; + B = 4.0 * (double) (GMP_LIMB_HIGHBIT >> 1); Bi = 1.0 / B; for (rn = 1; x >= B; rn++) x *= Bi; @@ -1703,7 +1736,7 @@ mpz_get_d (const mpz_t u) mp_limb_t l; mp_size_t un; double x; - double B = 2.0 * (double) GMP_LIMB_HIGHBIT; + double B = 4.0 * (double) (GMP_LIMB_HIGHBIT >> 1); un = GMP_ABS (u->_mp_size); @@ -1748,7 +1781,7 @@ mpz_cmpabs_d (const mpz_t x, double d) { xn = GMP_ABS (xn); - B = 2.0 * (double) GMP_LIMB_HIGHBIT; + B = 4.0 * (double) (GMP_LIMB_HIGHBIT >> 1); Bi = 1.0 / B; /* Scale d so it can be compared with the top limb. */ @@ -1807,14 +1840,12 @@ mpz_cmp_si (const mpz_t u, long v) { mp_size_t usize = u->_mp_size; - if (usize < -1) - return -1; - else if (v >= 0) + if (v >= 0) return mpz_cmp_ui (u, v); else if (usize >= 0) return 1; - else /* usize == -1 */ - return GMP_CMP (GMP_NEG_CAST (mp_limb_t, v), u->_mp_d[0]); + else + return - mpz_cmpabs_ui (u, GMP_NEG_CAST (unsigned long int, v)); } int @@ -1822,12 +1853,10 @@ mpz_cmp_ui (const mpz_t u, unsigned long v) { mp_size_t usize = u->_mp_size; - if (usize > 1) - return 1; - else if (usize < 0) + if (usize < 0) return -1; else - return GMP_CMP (mpz_get_ui (u), v); + return mpz_cmpabs_ui (u, v); } int @@ -1847,10 +1876,15 @@ mpz_cmp (const mpz_t a, const mpz_t b) int mpz_cmpabs_ui (const mpz_t u, unsigned long v) { - if (GMP_ABS (u->_mp_size) > 1) + mp_size_t un = GMP_ABS (u->_mp_size); + + if (! mpn_absfits_ulong_p (u->_mp_d, un)) return 1; else - return GMP_CMP (mpz_get_ui (u), v); + { + unsigned long uu = mpz_get_ui (u); + return GMP_CMP(uu, v); + } } int @@ -1885,81 +1919,28 @@ mpz_swap (mpz_t u, mpz_t v) /* MPZ addition and subtraction */ -/* Adds to the absolute value. Returns new size, but doesn't store it. */ -static mp_size_t -mpz_abs_add_ui (mpz_t r, const mpz_t a, unsigned long b) -{ - mp_size_t an; - mp_ptr rp; - mp_limb_t cy; - - an = GMP_ABS (a->_mp_size); - if (an == 0) - { - MPZ_REALLOC (r, 1)[0] = b; - return b > 0; - } - - rp = MPZ_REALLOC (r, an + 1); - - cy = mpn_add_1 (rp, a->_mp_d, an, b); - rp[an] = cy; - an += cy; - - return an; -} - -/* Subtract from the absolute value. Returns new size, (or -1 on underflow), - but doesn't store it. */ -static mp_size_t -mpz_abs_sub_ui (mpz_t r, const mpz_t a, unsigned long b) -{ - mp_size_t an = GMP_ABS (a->_mp_size); - mp_ptr rp; - - if (an == 0) - { - MPZ_REALLOC (r, 1)[0] = b; - return -(b > 0); - } - rp = MPZ_REALLOC (r, an); - if (an == 1 && a->_mp_d[0] < b) - { - rp[0] = b - a->_mp_d[0]; - return -1; - } - else - { - gmp_assert_nocarry (mpn_sub_1 (rp, a->_mp_d, an, b)); - return mpn_normalized_size (rp, an); - } -} void mpz_add_ui (mpz_t r, const mpz_t a, unsigned long b) { - if (a->_mp_size >= 0) - r->_mp_size = mpz_abs_add_ui (r, a, b); - else - r->_mp_size = -mpz_abs_sub_ui (r, a, b); + mpz_t bb; + mpz_init_set_ui (bb, b); + mpz_add (r, a, bb); + mpz_clear (bb); } void mpz_sub_ui (mpz_t r, const mpz_t a, unsigned long b) { - if (a->_mp_size < 0) - r->_mp_size = -mpz_abs_add_ui (r, a, b); - else - r->_mp_size = mpz_abs_sub_ui (r, a, b); + mpz_ui_sub (r, b, a); + mpz_neg (r, r); } void mpz_ui_sub (mpz_t r, unsigned long a, const mpz_t b) { - if (b->_mp_size < 0) - r->_mp_size = mpz_abs_add_ui (r, b, a); - else - r->_mp_size = -mpz_abs_sub_ui (r, b, a); + mpz_neg (r, b); + mpz_add_ui (r, r, a); } static mp_size_t @@ -2046,32 +2027,17 @@ mpz_mul_si (mpz_t r, const mpz_t u, long int v) mpz_neg (r, r); } else - mpz_mul_ui (r, u, (unsigned long int) v); + mpz_mul_ui (r, u, v); } void mpz_mul_ui (mpz_t r, const mpz_t u, unsigned long int v) { - mp_size_t un, us; - mp_ptr tp; - mp_limb_t cy; - - us = u->_mp_size; - - if (us == 0 || v == 0) - { - r->_mp_size = 0; - return; - } - - un = GMP_ABS (us); - - tp = MPZ_REALLOC (r, un + 1); - cy = mpn_mul_1 (tp, u->_mp_d, un, v); - tp[un] = cy; - - un += (cy > 0); - r->_mp_size = (us < 0) ? - un : un; + mpz_t vv; + mpz_init_set_ui (vv, v); + mpz_mul (r, u, vv); + mpz_clear (vv); + return; } void @@ -2150,8 +2116,8 @@ void mpz_addmul_ui (mpz_t r, const mpz_t u, unsigned long int v) { mpz_t t; - mpz_init (t); - mpz_mul_ui (t, u, v); + mpz_init_set_ui (t, v); + mpz_mul (t, u, t); mpz_add (r, r, t); mpz_clear (t); } @@ -2160,8 +2126,8 @@ void mpz_submul_ui (mpz_t r, const mpz_t u, unsigned long int v) { mpz_t t; - mpz_init (t); - mpz_mul_ui (t, u, v); + mpz_init_set_ui (t, v); + mpz_mul (t, u, t); mpz_sub (r, r, t); mpz_clear (t); } @@ -2557,56 +2523,20 @@ static unsigned long mpz_div_qr_ui (mpz_t q, mpz_t r, const mpz_t n, unsigned long d, enum mpz_div_round_mode mode) { - mp_size_t ns, qn; - mp_ptr qp; - mp_limb_t rl; - mp_size_t rs; - - ns = n->_mp_size; - if (ns == 0) - { - if (q) - q->_mp_size = 0; - if (r) - r->_mp_size = 0; - return 0; - } - - qn = GMP_ABS (ns); - if (q) - qp = MPZ_REALLOC (q, qn); - else - qp = NULL; + unsigned long ret; + mpz_t rr, dd; - rl = mpn_div_qr_1 (qp, n->_mp_d, qn, d); - assert (rl < d); - - rs = rl > 0; - rs = (ns < 0) ? -rs : rs; - - if (rl > 0 && ( (mode == GMP_DIV_FLOOR && ns < 0) - || (mode == GMP_DIV_CEIL && ns >= 0))) - { - if (q) - gmp_assert_nocarry (mpn_add_1 (qp, qp, qn, 1)); - rl = d - rl; - rs = -rs; - } + mpz_init (rr); + mpz_init_set_ui (dd, d); + mpz_div_qr (q, rr, n, dd, mode); + mpz_clear (dd); + ret = mpz_get_ui (rr); if (r) - { - MPZ_REALLOC (r, 1)[0] = rl; - r->_mp_size = rs; - } - if (q) - { - qn -= (qp[qn-1] == 0); - assert (qn == 0 || qp[qn-1] > 0); - - q->_mp_size = (ns < 0) ? - qn : qn; - } + mpz_swap (r, rr); + mpz_clear (rr); - return rl; + return ret; } unsigned long @@ -2745,22 +2675,16 @@ mpn_gcd_11 (mp_limb_t u, mp_limb_t v) unsigned long mpz_gcd_ui (mpz_t g, const mpz_t u, unsigned long v) { - mp_size_t un; + mpz_t t; + mpz_init_set_ui(t, v); + mpz_gcd (t, u, t); + if (v > 0) + v = mpz_get_ui (t); - if (v == 0) - { - if (g) - mpz_abs (g, u); - } - else - { - un = GMP_ABS (u->_mp_size); - if (un != 0) - v = mpn_gcd_11 (mpn_div_qr_1 (NULL, u->_mp_d, un, v), v); + if (g) + mpz_swap (t, g); - if (g) - mpz_set_ui (g, v); - } + mpz_clear (t); return v; } @@ -2854,7 +2778,7 @@ mpz_gcdext (mpz_t g, mpz_t s, mpz_t t, const mpz_t u, const mpz_t v) signed long sign = mpz_sgn (v); mpz_abs (g, v); if (s) - mpz_set_ui (s, 0); + s->_mp_size = 0; if (t) mpz_set_si (t, sign); return; @@ -2868,7 +2792,7 @@ mpz_gcdext (mpz_t g, mpz_t s, mpz_t t, const mpz_t u, const mpz_t v) if (s) mpz_set_si (s, sign); if (t) - mpz_set_ui (t, 0); + t->_mp_size = 0; return; } @@ -2993,8 +2917,9 @@ mpz_gcdext (mpz_t g, mpz_t s, mpz_t t, const mpz_t u, const mpz_t v) mpz_sub (s0, s0, s1); mpz_add (t0, t0, t1); } - mpz_divexact_ui (s0, s0, 2); - mpz_divexact_ui (t0, t0, 2); + assert (mpz_even_p (t0) && mpz_even_p (s0)); + mpz_tdiv_q_2exp (s0, s0, 1); + mpz_tdiv_q_2exp (t0, t0, 1); } /* Arrange so that |s| < |u| / 2g */ @@ -3119,7 +3044,10 @@ void mpz_ui_pow_ui (mpz_t r, unsigned long blimb, unsigned long e) { mpz_t b; - mpz_pow_ui (r, mpz_roinit_normal_n (b, &blimb, blimb != 0), e); + + mpz_init_set_ui (b, blimb); + mpz_pow_ui (r, b, e); + mpz_clear (b); } void @@ -3231,7 +3159,10 @@ void mpz_powm_ui (mpz_t r, const mpz_t b, unsigned long elimb, const mpz_t m) { mpz_t e; - mpz_powm (r, b, mpz_roinit_normal_n (e, &elimb, elimb != 0), m); + + mpz_init_set_ui (e, elimb); + mpz_powm (r, b, e, m); + mpz_clear (e); } /* x=trunc(y^(1/z)), r=y-x^z */ @@ -3409,6 +3340,177 @@ mpz_bin_uiui (mpz_t r, unsigned long n, unsigned long k) /* Primality testing */ + +/* Computes Kronecker (a/b) with odd b, a!=0 and GCD(a,b) = 1 */ +/* Adapted from JACOBI_BASE_METHOD==4 in mpn/generic/jacbase.c */ +static int +gmp_jacobi_coprime (mp_limb_t a, mp_limb_t b) +{ + int c, bit = 0; + + assert (b & 1); + assert (a != 0); + /* assert (mpn_gcd_11 (a, b) == 1); */ + + /* Below, we represent a and b shifted right so that the least + significant one bit is implicit. */ + b >>= 1; + + gmp_ctz(c, a); + a >>= 1; + + do + { + a >>= c; + /* (2/b) = -1 if b = 3 or 5 mod 8 */ + bit ^= c & (b ^ (b >> 1)); + if (a < b) + { + bit ^= a & b; + a = b - a; + b -= a; + } + else + { + a -= b; + assert (a != 0); + } + + gmp_ctz(c, a); + ++c; + } + while (b > 0); + + return bit & 1 ? -1 : 1; +} + +static void +gmp_lucas_step_k_2k (mpz_t V, mpz_t Qk, const mpz_t n) +{ + mpz_mod (Qk, Qk, n); + /* V_{2k} <- V_k ^ 2 - 2Q^k */ + mpz_mul (V, V, V); + mpz_submul_ui (V, Qk, 2); + mpz_tdiv_r (V, V, n); + /* Q^{2k} = (Q^k)^2 */ + mpz_mul (Qk, Qk, Qk); +} + +/* Computes V_k, Q^k (mod n) for the Lucas' sequence */ +/* with P=1, Q=Q; k = (n>>b0)|1. */ +/* Requires an odd n > 4; b0 > 0; -2*Q must not overflow a long */ +/* Returns (U_k == 0) and sets V=V_k and Qk=Q^k. */ +static int +gmp_lucas_mod (mpz_t V, mpz_t Qk, long Q, + mp_bitcnt_t b0, const mpz_t n) +{ + mp_bitcnt_t bs; + mpz_t U; + int res; + + assert (b0 > 0); + assert (Q <= - (LONG_MIN / 2)); + assert (Q >= - (LONG_MAX / 2)); + assert (mpz_cmp_ui (n, 4) > 0); + assert (mpz_odd_p (n)); + + mpz_init_set_ui (U, 1); /* U1 = 1 */ + mpz_set_ui (V, 1); /* V1 = 1 */ + mpz_set_si (Qk, Q); + + for (bs = mpz_sizeinbase (n, 2) - 1; --bs >= b0;) + { + /* U_{2k} <- U_k * V_k */ + mpz_mul (U, U, V); + /* V_{2k} <- V_k ^ 2 - 2Q^k */ + /* Q^{2k} = (Q^k)^2 */ + gmp_lucas_step_k_2k (V, Qk, n); + + /* A step k->k+1 is performed if the bit in $n$ is 1 */ + /* mpz_tstbit(n,bs) or the the bit is 0 in $n$ but */ + /* should be 1 in $n+1$ (bs == b0) */ + if (b0 == bs || mpz_tstbit (n, bs)) + { + /* Q^{k+1} <- Q^k * Q */ + mpz_mul_si (Qk, Qk, Q); + /* U_{k+1} <- (U_k + V_k) / 2 */ + mpz_swap (U, V); /* Keep in V the old value of U_k */ + mpz_add (U, U, V); + /* We have to compute U/2, so we need an even value, */ + /* equivalent (mod n) */ + if (mpz_odd_p (U)) + mpz_add (U, U, n); + mpz_tdiv_q_2exp (U, U, 1); + /* V_{k+1} <-(D*U_k + V_k) / 2 = + U_{k+1} + (D-1)/2*U_k = U_{k+1} - 2Q*U_k */ + mpz_mul_si (V, V, -2*Q); + mpz_add (V, U, V); + mpz_tdiv_r (V, V, n); + } + mpz_tdiv_r (U, U, n); + } + + res = U->_mp_size == 0; + mpz_clear (U); + return res; +} + +/* Performs strong Lucas' test on x, with parameters suggested */ +/* for the BPSW test. Qk is only passed to recycle a variable. */ +/* Requires GCD (x,6) = 1.*/ +static int +gmp_stronglucas (const mpz_t x, mpz_t Qk) +{ + mp_bitcnt_t b0; + mpz_t V, n; + mp_limb_t maxD, D; /* The absolute value is stored. */ + long Q; + mp_limb_t tl; + + /* Test on the absolute value. */ + mpz_roinit_normal_n (n, x->_mp_d, GMP_ABS (x->_mp_size)); + + assert (mpz_odd_p (n)); + /* assert (mpz_gcd_ui (NULL, n, 6) == 1); */ + if (mpz_root (Qk, n, 2)) + return 0; /* A square is composite. */ + + /* Check Ds up to square root (in case, n is prime) + or avoid overflows */ + maxD = (Qk->_mp_size == 1) ? Qk->_mp_d [0] - 1 : GMP_LIMB_MAX; + + D = 3; + /* Search a D such that (D/n) = -1 in the sequence 5,-7,9,-11,.. */ + /* For those Ds we have (D/n) = (n/|D|) */ + do + { + if (D >= maxD) + return 1 + (D != GMP_LIMB_MAX); /* (1 + ! ~ D) */ + D += 2; + tl = mpz_tdiv_ui (n, D); + if (tl == 0) + return 0; + } + while (gmp_jacobi_coprime (tl, D) == 1); + + mpz_init (V); + + /* n-(D/n) = n+1 = d*2^{b0}, with d = (n>>b0) | 1 */ + b0 = mpz_scan0 (n, 0); + + /* D= P^2 - 4Q; P = 1; Q = (1-D)/4 */ + Q = (D & 2) ? (D >> 2) + 1 : -(long) (D >> 2); + + if (! gmp_lucas_mod (V, Qk, Q, b0, n)) /* If Ud != 0 */ + while (V->_mp_size != 0 && --b0 != 0) /* while Vk != 0 */ + /* V <- V ^ 2 - 2Q^k */ + /* Q^{2k} = (Q^k)^2 */ + gmp_lucas_step_k_2k (V, Qk, n); + + mpz_clear (V); + return (b0 != 0); +} + static int gmp_millerrabin (const mpz_t n, const mpz_t nm1, mpz_t y, const mpz_t q, mp_bitcnt_t k) @@ -3470,21 +3572,26 @@ mpz_probab_prime_p (const mpz_t n, int reps) if (mpz_cmpabs_ui (n, 31*31) < 0) return 2; - /* Use Miller-Rabin, with a deterministic sequence of bases, a[j] = - j^2 + j + 41 using Euler's polynomial. We potentially stop early, - if a[j] >= n - 1. Since n >= 31*31, this can happen only if reps > - 30 (a[30] == 971 > 31*31 == 961). */ - mpz_init (nm1); mpz_init (q); - mpz_init (y); /* Find q and k, where q is odd and n = 1 + 2**k * q. */ - nm1->_mp_size = mpz_abs_sub_ui (nm1, n, 1); + mpz_abs (nm1, n); + nm1->_mp_d[0] -= 1; k = mpz_scan1 (nm1, 0); mpz_tdiv_q_2exp (q, nm1, k); - for (j = 0, is_prime = 1; is_prime & (j < reps); j++) + /* BPSW test */ + mpz_init_set_ui (y, 2); + is_prime = gmp_millerrabin (n, nm1, y, q, k) && gmp_stronglucas (n, y); + reps -= 24; /* skip the first 24 repetitions */ + + /* Use Miller-Rabin, with a deterministic sequence of bases, a[j] = + j^2 + j + 41 using Euler's polynomial. We potentially stop early, + if a[j] >= n - 1. Since n >= 31*31, this can happen only if reps > + 30 (a[30] == 971 > 31*31 == 961). */ + + for (j = 0; is_prime & (j < reps); j++) { mpz_set_ui (y, (unsigned long) j*j+j+41); if (mpz_cmp (y, nm1) >= 0) @@ -3552,7 +3659,7 @@ mpz_tstbit (const mpz_t d, mp_bitcnt_t bit_index) { /* d < 0. Check if any of the bits below is set: If so, our bit must be complemented. */ - if (shift > 0 && (w << (GMP_LIMB_BITS - shift)) > 0) + if (shift > 0 && (mp_limb_t) (w << (GMP_LIMB_BITS - shift)) > 0) return bit ^ 1; while (--limb_index >= 0) if (d->_mp_d[limb_index] > 0) @@ -3659,8 +3766,8 @@ mpz_combit (mpz_t d, mp_bitcnt_t bit_index) void mpz_com (mpz_t r, const mpz_t u) { - mpz_neg (r, u); - mpz_sub_ui (r, r, 1); + mpz_add_ui (r, u, 1); + mpz_neg (r, r); } void @@ -4000,7 +4107,7 @@ mpz_scan1 (const mpz_t u, mp_bitcnt_t starting_bit) } /* Mask to 0 all bits before starting_bit, thus ignoring them. */ - limb &= (GMP_LIMB_MAX << (starting_bit % GMP_LIMB_BITS)); + limb &= GMP_LIMB_MAX << (starting_bit % GMP_LIMB_BITS); } return mpn_common_scan (limb, i, up, un, ux); @@ -4030,7 +4137,7 @@ mpz_scan0 (const mpz_t u, mp_bitcnt_t starting_bit) limb -= mpn_zero_p (up, i); /* limb = ~(~limb + zero_p) */ /* Mask all bits before starting_bit, thus ignoring them. */ - limb &= (GMP_LIMB_MAX << (starting_bit % GMP_LIMB_BITS)); + limb &= GMP_LIMB_MAX << (starting_bit % GMP_LIMB_BITS); return mpn_common_scan (limb, i, up, un, ux); } diff --git a/src/mini-gmp.h b/src/mini-gmp.h index 2586d32db9..27e0c0671a 100644 --- a/src/mini-gmp.h +++ b/src/mini-gmp.h @@ -1,6 +1,6 @@ /* mini-gmp, a minimalistic implementation of a GNU GMP subset. -Copyright 2011-2015, 2017, 2019 Free Software Foundation, Inc. +Copyright 2011-2015, 2017 Free Software Foundation, Inc. This file is part of the GNU MP Library. commit 4d97e1a9ea35c3a1d9f03abb7a822d57f384c1a5 Author: Philipp Stephani Date: Wed Apr 24 10:22:18 2019 +0200 Export major version of latest Emacs supported by emacs-module.h. This is useful if module authors want to support multiple versions of emacs-module.h. * configure.ac (emacs_major_version): Define substitution. * src/emacs-module.h.in (EMACS_MAJOR_VERSION): Define macro. * doc/lispref/internals.texi (Module Initialization): Document EMACS_MAJOR_VERSION preprocessor macro. * test/data/emacs-module/mod-test.c (emacs_module_init): Verify behavior of EMACS_MAJOR_VERSION. diff --git a/configure.ac b/configure.ac index 810c3219e4..79fe0c98c6 100644 --- a/configure.ac +++ b/configure.ac @@ -3697,6 +3697,8 @@ AC_SUBST_FILE([module_env_snippet_27]) module_env_snippet_25="$srcdir/src/module-env-25.h" module_env_snippet_26="$srcdir/src/module-env-26.h" module_env_snippet_27="$srcdir/src/module-env-27.h" +emacs_major_version="${PACKAGE_VERSION%%.*}" +AC_SUBST(emacs_major_version) ### Use -lpng if available, unless '--with-png=no'. HAVE_PNG=no diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 5ae71afbef..cfeb492af4 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1191,6 +1191,17 @@ grow with new Emacs releases. Given the version of Emacs, the module can use only the parts of the module @acronym{API} that existed in that version, since those parts are identical in later versions. +@file{emacs-module.h} defines a preprocessor macro +@code{EMACS_MAJOR_VERSION}. It expands to an integer literal which is +the latest major version of Emacs supported by the header. +@xref{Version Info}. Note that the value of +@code{EMACS_MAJOR_VERSION} is a compile-time constant and does not +represent the version of Emacs that is currently running and has +loaded your module. If you want your module to be compatible with +various versions of @file{emacs-module.h} as well as various versions +of Emacs, you can use conditional compilation based on +@code{EMACS_MAJOR_VERSION}. + We recommend that modules always perform the compatibility verification, unless they do their job entirely in the initialization function, and don't access any Lisp objects or use any Emacs functions diff --git a/etc/NEWS b/etc/NEWS index cf6f4fea3e..9b32d720b6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1933,6 +1933,9 @@ convert between timespec structures and Emacs Lisp time values. 'extract_big_integer' to create and extract arbitrary-size integer values. +** emacs-module.h now defines a macro EMACS_MAJOR_VERSION that expands +to the major version of the latest Emacs supported by the header. + * Changes in Emacs 27.1 on Non-Free Operating Systems diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in index fbc62a61ef..9955e30eb7 100644 --- a/src/emacs-module.h.in +++ b/src/emacs-module.h.in @@ -32,6 +32,8 @@ along with GNU Emacs. If not, see . */ #include #endif +#define EMACS_MAJOR_VERSION @emacs_major_version@ + #if defined __cplusplus && __cplusplus >= 201103L # define EMACS_NOEXCEPT noexcept #else diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index b7007bd80f..a9154fa167 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c @@ -445,6 +445,11 @@ bind_function (emacs_env *env, const char *name, emacs_value Sfun) int emacs_module_init (struct emacs_runtime *ert) { + /* Check that EMACS_MAJOR_VERSION is defined and an integral + constant. */ + char dummy[EMACS_MAJOR_VERSION]; + assert (27 <= sizeof dummy); + if (ert->size < sizeof *ert) { fprintf (stderr, "Runtime size of runtime structure (%"pT" bytes) " commit 24f717a5d7de80fdd6aa061f35d04144fe1c4e10 Author: Philipp Stephani Date: Sun Apr 28 19:21:03 2019 +0200 Fix another compilation warning. * test/src/emacs-module-tests.el (multiply-string): Remove unused variable ‘i’. diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 51330e305f..60ba71c57b 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -147,7 +147,7 @@ changes." (defun multiply-string (s n) "Return N copies of S concatenated together." (let ((res "")) - (dotimes (i n) + (dotimes (_ n) (setq res (concat res s))) res)) commit e4406e52a75f222a63554769cee75c1dc920b93c Author: Philipp Stephani Date: Sun Apr 28 19:17:41 2019 +0200 Also regenerate emacs-module.h if module-env-*.h changes. * Makefile.in (CONFIG_STATUS_FILES_IN): Add versioned environment header fragments. diff --git a/Makefile.in b/Makefile.in index 88cbb3d46e..06da415a4a 100644 --- a/Makefile.in +++ b/Makefile.in @@ -320,7 +320,8 @@ SUBDIR_MAKEFILES = $(patsubst ${srcdir}/%,%,${SUBDIR_MAKEFILES_IN:.in=}) # Non-makefile files created by config.status. CONFIG_STATUS_FILES_IN = \ ${srcdir}/nt/emacs.rc.in ${srcdir}/nt/emacsclient.rc.in \ - ${srcdir}/doc/man/emacs.1.in ${srcdir}/src/emacs-module.h.in + ${srcdir}/doc/man/emacs.1.in ${srcdir}/src/emacs-module.h.in \ + ${srcdir}/src/module-env-*.h # Subdirectories to install, and where they'll go. lib-src's and nt's # makefiles know how to install them, so we don't do that here. commit 88c91f53dfd8d29475e2a4794da8b497b62cd53b Author: Philipp Stephani Date: Sun Apr 28 17:40:41 2019 +0200 * src/emacs-module.c (funcall_module): Add a nontrivial assertion diff --git a/src/emacs-module.c b/src/emacs-module.c index 685bdb8bb4..6b56146ca0 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -902,6 +902,11 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist) memory_full (sizeof *args[i]); } + /* The only possibility of getting an error until here is failure to + allocate memory for the arguments, but then we already should + have signaled an error before. */ + eassert (priv.pending_non_local_exit == emacs_funcall_exit_return); + emacs_value ret = func->subr (env, nargs, args, func->data); eassert (&priv == env->private_members); commit 66a2c412be0dd21e3adeb766a44cc13fd80ba73c Author: Philipp Stephani Date: Sun Apr 28 17:15:04 2019 +0200 Fix a few minor compilation and Checkdoc warnings. * test/src/emacs-module-tests.el: Add package name and standard sections. (multiply-string): Add a docstring. diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 40afd76259..51330e305f 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -1,4 +1,4 @@ -;;; Test GNU Emacs modules. -*- lexical-binding: t; -*- +;;; emacs-module-tests --- Test GNU Emacs modules. -*- lexical-binding: t; -*- ;; Copyright 2015-2019 Free Software Foundation, Inc. @@ -17,6 +17,14 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . */ +;;; Commentary: + +;; Unit tests for the dynamic module facility. See Info node `(elisp) +;; Writing Dynamic Modules'. These tests make use of a small test +;; module in test/data/emacs-module. + +;;; Code: + (require 'cl-lib) (require 'ert) (require 'help-fns) @@ -137,6 +145,7 @@ changes." ;; (defun multiply-string (s n) + "Return N copies of S concatenated together." (let ((res "")) (dotimes (i n) (setq res (concat res s))) commit cf11fac1eba8076434de345603c380c3e6894fb0 Author: Philipp Stephani Date: Sun Apr 28 16:49:13 2019 +0200 * test/src/emacs-module-tests.el: Switch to lexical binding. diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 173b63670f..40afd76259 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -1,4 +1,4 @@ -;;; Test GNU Emacs modules. +;;; Test GNU Emacs modules. -*- lexical-binding: t; -*- ;; Copyright 2015-2019 Free Software Foundation, Inc. commit 6b6a6f06b4df9d76ad50294d0b6e88978ffb27d0 Author: Eli Zaretskii Date: Sun Apr 28 17:14:39 2019 +0300 Fix names of functions in last commit * src/coding.h (build_string_from_utf8): Rename from build_utf8_string. All callers changed. * src/coding.c (make_string_from_utf8): Rename from make_utf8_string. All callers changed. diff --git a/src/coding.c b/src/coding.c index 71f687a14e..9cba6494a8 100644 --- a/src/coding.c +++ b/src/coding.c @@ -6353,22 +6353,26 @@ utf8_string_p (Lisp_Object string) return check_utf_8 (&coding) != -1; } +/* Like make_string, but always returns a multibyte Lisp string, and + avoids decoding if TEXT encoded in UTF-8. */ + Lisp_Object -make_utf8_string (const char *data, ptrdiff_t size) +make_string_from_utf8 (const char *text, ptrdiff_t nbytes) { ptrdiff_t chars, bytes; - parse_str_as_multibyte ((const unsigned char *) data, size, &chars, &bytes); - /* If DATA is a valid UTF-8 string, we can convert it to a Lisp + parse_str_as_multibyte ((const unsigned char *) text, nbytes, + &chars, &bytes); + /* If TEXT is a valid UTF-8 string, we can convert it to a Lisp string directly. Otherwise, we need to decode it. */ - if (chars == size || bytes == size) - return make_specified_string (data, chars, size, true); + if (chars == nbytes || bytes == nbytes) + return make_specified_string (text, chars, nbytes, true); else { struct coding_system coding; setup_coding_system (Qutf_8_unix, &coding); coding.mode |= CODING_MODE_LAST_BLOCK; - coding.source = (const unsigned char *) data; - decode_coding_object (&coding, Qnil, 0, 0, size, size, Qt); + coding.source = (const unsigned char *) text; + decode_coding_object (&coding, Qnil, 0, 0, nbytes, nbytes, Qt); return coding.dst_object; } } diff --git a/src/coding.h b/src/coding.h index 773df9abb9..619ca29c8e 100644 --- a/src/coding.h +++ b/src/coding.h @@ -695,7 +695,7 @@ extern Lisp_Object raw_text_coding_system (Lisp_Object); extern bool raw_text_coding_system_p (struct coding_system *); extern Lisp_Object coding_inherit_eol_type (Lisp_Object, Lisp_Object); extern Lisp_Object complement_process_encoding_system (Lisp_Object); -extern Lisp_Object make_utf8_string (const char *, ptrdiff_t); +extern Lisp_Object make_string_from_utf8 (const char *, ptrdiff_t); extern void decode_coding_gap (struct coding_system *, ptrdiff_t, ptrdiff_t); @@ -763,14 +763,13 @@ surrogates_to_codepoint (int low, int high) return 0x10000 + (low - 0xDC00) + ((high - 0xD800) * 0x400); } -/* Create a multibyte Lisp string from the NUL-terminated UTF-8 string - beginning at DATA. If the string is not a valid UTF-8 string, an - unspecified string is returned. */ +/* Like build_string, but always returns a multibyte string, and is + optimized for speed when STR is a UTF-8 encoded text string. */ INLINE Lisp_Object -build_utf8_string (const char *data) +build_string_from_utf8 (const char *str) { - return make_utf8_string (data, strlen (data)); + return make_string_from_utf8 (str, strlen (str)); } diff --git a/src/emacs-module.c b/src/emacs-module.c index b905094255..685bdb8bb4 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -530,7 +530,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, function->data = data; if (documentation) - function->documentation = build_utf8_string (documentation); + function->documentation = build_string_from_utf8 (documentation); Lisp_Object result; XSET_MODULE_FUNCTION (result, function); @@ -663,7 +663,7 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length) MODULE_FUNCTION_BEGIN (NULL); if (! (0 <= length && length <= STRING_BYTES_BOUND)) overflow_error (); - Lisp_Object lstr = make_utf8_string (str, length); + Lisp_Object lstr = make_string_from_utf8 (str, length); return lisp_to_value (env, lstr); } diff --git a/src/json.c b/src/json.c index cc98914423..e2a4424463 100644 --- a/src/json.c +++ b/src/json.c @@ -215,7 +215,7 @@ json_has_suffix (const char *string, const char *suffix) #endif -/* Note that all callers of make_utf8_string and build_utf8_string +/* Note that all callers of make_string_from_utf8 and build_string_from_utf8 below either pass only value UTF-8 strings or use the functionf for formatting error messages; in the latter case correctness isn't critical. */ @@ -267,9 +267,11 @@ json_parse_error (const json_error_t *error) symbol = Qjson_parse_error; #endif xsignal (symbol, - list5 (build_utf8_string (error->text), - build_utf8_string (error->source), INT_TO_INTEGER (error->line), - INT_TO_INTEGER (error->column), INT_TO_INTEGER (error->position))); + list5 (build_string_from_utf8 (error->text), + build_string_from_utf8 (error->source), + INT_TO_INTEGER (error->line), + INT_TO_INTEGER (error->column), + INT_TO_INTEGER (error->position))); } static void @@ -612,7 +614,7 @@ usage: (json-serialize OBJECT &rest ARGS) */) json_out_of_memory (); record_unwind_protect_ptr (json_free, string); - return unbind_to (count, build_utf8_string (string)); + return unbind_to (count, build_string_from_utf8 (string)); } struct json_buffer_and_size @@ -819,8 +821,8 @@ json_to_lisp (json_t *json, struct json_configuration *conf) case JSON_REAL: return make_float (json_real_value (json)); case JSON_STRING: - return make_utf8_string (json_string_value (json), - json_string_length (json)); + return make_string_from_utf8 (json_string_value (json), + json_string_length (json)); case JSON_ARRAY: { if (++lisp_eval_depth > max_lisp_eval_depth) @@ -879,7 +881,7 @@ json_to_lisp (json_t *json, struct json_configuration *conf) json_t *value; json_object_foreach (json, key_str, value) { - Lisp_Object key = build_utf8_string (key_str); + Lisp_Object key = build_string_from_utf8 (key_str); EMACS_UINT hash; ptrdiff_t i = hash_lookup (h, key, &hash); /* Keys in JSON objects are unique, so the key can't @@ -896,7 +898,8 @@ json_to_lisp (json_t *json, struct json_configuration *conf) json_t *value; json_object_foreach (json, key_str, value) { - Lisp_Object key = Fintern (build_utf8_string (key_str), Qnil); + Lisp_Object key + = Fintern (build_string_from_utf8 (key_str), Qnil); result = Fcons (Fcons (key, json_to_lisp (value, conf)), result); commit 75ee20364c5ed4c175b13debaa53a2ba14168999 Author: Philipp Stephani Date: Sun Apr 28 12:28:27 2019 +0200 Refactoring: move UTF-8 decoding functions into coding.h. json_make_string and json_build_string are generally useful and not JSON-specific. Move them to coding.[ch]. * src/coding.h (build_utf8_string): Move from json.c. * src/coding.c (make_utf8_string): Move from json.c. * src/json.c (json_make_string, json_build_string): Move to coding.[ch]. Split out JSON-specific comment. (json_parse_error, Fjson_serialize, json_to_lisp): Fix callers. * src/emacs-module.c (module_make_function, module_make_string): Use new functions. (module_decode, module_decode_copy): Remove. diff --git a/src/coding.c b/src/coding.c index 2c6b2c4d05..71f687a14e 100644 --- a/src/coding.c +++ b/src/coding.c @@ -6353,6 +6353,25 @@ utf8_string_p (Lisp_Object string) return check_utf_8 (&coding) != -1; } +Lisp_Object +make_utf8_string (const char *data, ptrdiff_t size) +{ + ptrdiff_t chars, bytes; + parse_str_as_multibyte ((const unsigned char *) data, size, &chars, &bytes); + /* If DATA is a valid UTF-8 string, we can convert it to a Lisp + string directly. Otherwise, we need to decode it. */ + if (chars == size || bytes == size) + return make_specified_string (data, chars, size, true); + else + { + struct coding_system coding; + setup_coding_system (Qutf_8_unix, &coding); + coding.mode |= CODING_MODE_LAST_BLOCK; + coding.source = (const unsigned char *) data; + decode_coding_object (&coding, Qnil, 0, 0, size, size, Qt); + return coding.dst_object; + } +} /* Detect how end-of-line of a text of length SRC_BYTES pointed by SOURCE is encoded. If CATEGORY is one of diff --git a/src/coding.h b/src/coding.h index 0c03d1a44e..773df9abb9 100644 --- a/src/coding.h +++ b/src/coding.h @@ -695,6 +695,7 @@ extern Lisp_Object raw_text_coding_system (Lisp_Object); extern bool raw_text_coding_system_p (struct coding_system *); extern Lisp_Object coding_inherit_eol_type (Lisp_Object, Lisp_Object); extern Lisp_Object complement_process_encoding_system (Lisp_Object); +extern Lisp_Object make_utf8_string (const char *, ptrdiff_t); extern void decode_coding_gap (struct coding_system *, ptrdiff_t, ptrdiff_t); @@ -762,6 +763,17 @@ surrogates_to_codepoint (int low, int high) return 0x10000 + (low - 0xDC00) + ((high - 0xD800) * 0x400); } +/* Create a multibyte Lisp string from the NUL-terminated UTF-8 string + beginning at DATA. If the string is not a valid UTF-8 string, an + unspecified string is returned. */ + +INLINE Lisp_Object +build_utf8_string (const char *data) +{ + return make_utf8_string (data, strlen (data)); +} + + extern Lisp_Object preferred_coding_system (void); /* Coding system to be used to encode text for terminal display when diff --git a/src/emacs-module.c b/src/emacs-module.c index 80a04bafc2..b905094255 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -223,8 +223,6 @@ static void module_reset_handlerlist (struct handler **); static bool value_storage_contains_p (const struct emacs_value_storage *, emacs_value, ptrdiff_t *); static Lisp_Object module_encode (Lisp_Object); -static Lisp_Object module_decode (Lisp_Object); -static Lisp_Object module_decode_copy (Lisp_Object); static bool module_assertions = false; @@ -532,10 +530,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, function->data = data; if (documentation) - { - AUTO_STRING (unibyte_doc, documentation); - function->documentation = module_decode_copy (unibyte_doc); - } + function->documentation = build_utf8_string (documentation); Lisp_Object result; XSET_MODULE_FUNCTION (result, function); @@ -668,8 +663,8 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length) MODULE_FUNCTION_BEGIN (NULL); if (! (0 <= length && length <= STRING_BYTES_BOUND)) overflow_error (); - Lisp_Object lstr = make_unibyte_string (str, length); - return lisp_to_value (env, module_decode (lstr)); + Lisp_Object lstr = make_utf8_string (str, length); + return lisp_to_value (env, lstr); } static emacs_value @@ -1030,18 +1025,6 @@ module_encode (Lisp_Object string) return code_convert_string (string, Qutf_8_unix, Qt, true, true, true); } -static Lisp_Object -module_decode (Lisp_Object string) -{ - return code_convert_string (string, Qutf_8_unix, Qt, false, true, true); -} - -static Lisp_Object -module_decode_copy (Lisp_Object string) -{ - return code_convert_string (string, Qutf_8_unix, Qt, false, false, true); -} - /* Value conversion. */ diff --git a/src/json.c b/src/json.c index 03468e9f33..cc98914423 100644 --- a/src/json.c +++ b/src/json.c @@ -215,47 +215,11 @@ json_has_suffix (const char *string, const char *suffix) #endif -/* Create a multibyte Lisp string from the UTF-8 string in - [DATA, DATA + SIZE). If the range [DATA, DATA + SIZE) does not - contain a valid UTF-8 string, the returned string will include raw - bytes. - Note that all callers below either pass only value UTF-8 strings or - use this function for formatting error messages; in the latter case - correctness isn't critical. */ - -static Lisp_Object -json_make_string (const char *data, ptrdiff_t size) -{ - ptrdiff_t chars, bytes; - parse_str_as_multibyte ((const unsigned char *) data, size, &chars, &bytes); - /* If DATA is a valid UTF-8 string, we can convert it to a Lisp - string directly. Otherwise, we need to decode it. */ - if (chars == size || bytes == size) - return make_specified_string (data, chars, size, true); - else - { - struct coding_system coding; - setup_coding_system (Qutf_8_unix, &coding); - coding.mode |= CODING_MODE_LAST_BLOCK; - coding.source = (const unsigned char *) data; - decode_coding_object (&coding, Qnil, 0, 0, size, size, Qt); - return coding.dst_object; - } -} - -/* Create a multibyte Lisp string from the NUL-terminated UTF-8 - string beginning at DATA. If the string is not a valid UTF-8 - string, an unspecified string is returned. Note that all callers - below either pass only value UTF-8 strings or use this function for +/* Note that all callers of make_utf8_string and build_utf8_string + below either pass only value UTF-8 strings or use the functionf for formatting error messages; in the latter case correctness isn't critical. */ -static Lisp_Object -json_build_string (const char *data) -{ - return json_make_string (data, strlen (data)); -} - /* Return a unibyte string containing the sequence of UTF-8 encoding units of the UTF-8 representation of STRING. If STRING does not represent a sequence of Unicode scalar values, return a string with @@ -303,8 +267,8 @@ json_parse_error (const json_error_t *error) symbol = Qjson_parse_error; #endif xsignal (symbol, - list5 (json_build_string (error->text), - json_build_string (error->source), INT_TO_INTEGER (error->line), + list5 (build_utf8_string (error->text), + build_utf8_string (error->source), INT_TO_INTEGER (error->line), INT_TO_INTEGER (error->column), INT_TO_INTEGER (error->position))); } @@ -648,7 +612,7 @@ usage: (json-serialize OBJECT &rest ARGS) */) json_out_of_memory (); record_unwind_protect_ptr (json_free, string); - return unbind_to (count, json_build_string (string)); + return unbind_to (count, build_utf8_string (string)); } struct json_buffer_and_size @@ -855,7 +819,7 @@ json_to_lisp (json_t *json, struct json_configuration *conf) case JSON_REAL: return make_float (json_real_value (json)); case JSON_STRING: - return json_make_string (json_string_value (json), + return make_utf8_string (json_string_value (json), json_string_length (json)); case JSON_ARRAY: { @@ -915,7 +879,7 @@ json_to_lisp (json_t *json, struct json_configuration *conf) json_t *value; json_object_foreach (json, key_str, value) { - Lisp_Object key = json_build_string (key_str); + Lisp_Object key = build_utf8_string (key_str); EMACS_UINT hash; ptrdiff_t i = hash_lookup (h, key, &hash); /* Keys in JSON objects are unique, so the key can't @@ -932,7 +896,7 @@ json_to_lisp (json_t *json, struct json_configuration *conf) json_t *value; json_object_foreach (json, key_str, value) { - Lisp_Object key = Fintern (json_build_string (key_str), Qnil); + Lisp_Object key = Fintern (build_utf8_string (key_str), Qnil); result = Fcons (Fcons (key, json_to_lisp (value, conf)), result);