aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorVibhav Pant2023-06-06 19:30:27 +0530
committerVibhav Pant2023-06-06 19:30:27 +0530
commit49ffcbf86a32a8a217538d4df3736fe069ccf35d (patch)
treea5f16157cc20fb19a844473a6fbd2b434f4c8260 /src
parentaf569fa3d90a717983b743eb97adbf869c6d1736 (diff)
parent7ca1d782f5910d0c3978c6798a45c6854ec668c7 (diff)
downloademacs-49ffcbf86a32a8a217538d4df3736fe069ccf35d.tar.gz
emacs-49ffcbf86a32a8a217538d4df3736fe069ccf35d.zip
Merge branch 'master' into scratch/comp-static-data
Diffstat (limited to 'src')
-rw-r--r--src/alloc.c27
-rw-r--r--src/bignum.c2
-rw-r--r--src/buffer.c52
-rw-r--r--src/bytecode.c2
-rw-r--r--src/callproc.c1
-rw-r--r--src/casefiddle.c4
-rw-r--r--src/ccl.c28
-rw-r--r--src/character.c16
-rw-r--r--src/cmds.c2
-rw-r--r--src/coding.c7
-rw-r--r--src/comp.c8
-rw-r--r--src/composite.c20
-rw-r--r--src/composite.h2
-rw-r--r--src/data.c77
-rw-r--r--src/dispextern.h37
-rw-r--r--src/dispnew.c28
-rw-r--r--src/doprnt.c4
-rw-r--r--src/editfns.c363
-rw-r--r--src/emacs-module.c6
-rw-r--r--src/emacs.c2
-rw-r--r--src/eval.c30
-rw-r--r--src/fileio.c3
-rw-r--r--src/floatfns.c12
-rw-r--r--src/fns.c121
-rw-r--r--src/font.c2
-rw-r--r--src/fontset.c9
-rw-r--r--src/frame.c2
-rw-r--r--src/fringe.c4
-rw-r--r--src/ftcrfont.c1
-rw-r--r--src/gnutls.c6
-rw-r--r--src/gtkutil.c4
-rw-r--r--src/haikufont.c1
-rw-r--r--src/haikuterm.c2
-rw-r--r--src/image.c45
-rw-r--r--src/indent.c9
-rw-r--r--src/itree.c6
-rw-r--r--src/keyboard.c35
-rw-r--r--src/keymap.c56
-rw-r--r--src/lisp.h92
-rw-r--r--src/lread.c320
-rw-r--r--src/macfont.m50
-rw-r--r--src/nsterm.m42
-rw-r--r--src/pdumper.c30
-rw-r--r--src/pgtkfns.c7
-rw-r--r--src/pgtkterm.c33
-rw-r--r--src/pgtkterm.h1
-rw-r--r--src/print.c4
-rw-r--r--src/profiler.c145
-rw-r--r--src/regex-emacs.c48
-rw-r--r--src/regex-emacs.h3
-rw-r--r--src/sort.c2
-rw-r--r--src/sqlite.c82
-rw-r--r--src/syntax.c157
-rw-r--r--src/syntax.h24
-rw-r--r--src/sysdep.c7
-rw-r--r--src/term.c12
-rw-r--r--src/termcap.c2
-rw-r--r--src/textconv.c6
-rw-r--r--src/thread.h9
-rw-r--r--src/timefns.c27
-rw-r--r--src/tparam.c3
-rw-r--r--src/treesit.c820
-rw-r--r--src/w32.c9
-rw-r--r--src/w32term.c2
-rw-r--r--src/window.h2
-rw-r--r--src/xdisp.c290
-rw-r--r--src/xfns.c56
-rw-r--r--src/xml.c10
-rw-r--r--src/xselect.c6
-rw-r--r--src/xsmfns.c2
-rw-r--r--src/xterm.c231
-rw-r--r--src/xterm.h11
72 files changed, 2216 insertions, 1365 deletions
diff --git a/src/alloc.c b/src/alloc.c
index 9969ace5fef..773bc03fffa 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -400,7 +400,7 @@ static ptrdiff_t pure_bytes_used_non_lisp;
400 400
401/* If positive, garbage collection is inhibited. Otherwise, zero. */ 401/* If positive, garbage collection is inhibited. Otherwise, zero. */
402 402
403static intptr_t garbage_collection_inhibited; 403intptr_t garbage_collection_inhibited;
404 404
405/* The GC threshold in bytes, the last time it was calculated 405/* The GC threshold in bytes, the last time it was calculated
406 from gc-cons-threshold and gc-cons-percentage. */ 406 from gc-cons-threshold and gc-cons-percentage. */
@@ -865,7 +865,7 @@ xnmalloc (ptrdiff_t nitems, ptrdiff_t item_size)
865{ 865{
866 eassert (0 <= nitems && 0 < item_size); 866 eassert (0 <= nitems && 0 < item_size);
867 ptrdiff_t nbytes; 867 ptrdiff_t nbytes;
868 if (INT_MULTIPLY_WRAPV (nitems, item_size, &nbytes) || SIZE_MAX < nbytes) 868 if (ckd_mul (&nbytes, nitems, item_size) || SIZE_MAX < nbytes)
869 memory_full (SIZE_MAX); 869 memory_full (SIZE_MAX);
870 return xmalloc (nbytes); 870 return xmalloc (nbytes);
871} 871}
@@ -879,7 +879,7 @@ xnrealloc (void *pa, ptrdiff_t nitems, ptrdiff_t item_size)
879{ 879{
880 eassert (0 <= nitems && 0 < item_size); 880 eassert (0 <= nitems && 0 < item_size);
881 ptrdiff_t nbytes; 881 ptrdiff_t nbytes;
882 if (INT_MULTIPLY_WRAPV (nitems, item_size, &nbytes) || SIZE_MAX < nbytes) 882 if (ckd_mul (&nbytes, nitems, item_size) || SIZE_MAX < nbytes)
883 memory_full (SIZE_MAX); 883 memory_full (SIZE_MAX);
884 return xrealloc (pa, nbytes); 884 return xrealloc (pa, nbytes);
885} 885}
@@ -926,13 +926,13 @@ xpalloc (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
926 NITEMS_MAX, and what the C language can represent safely. */ 926 NITEMS_MAX, and what the C language can represent safely. */
927 927
928 ptrdiff_t n, nbytes; 928 ptrdiff_t n, nbytes;
929 if (INT_ADD_WRAPV (n0, n0 >> 1, &n)) 929 if (ckd_add (&n, n0, n0 >> 1))
930 n = PTRDIFF_MAX; 930 n = PTRDIFF_MAX;
931 if (0 <= nitems_max && nitems_max < n) 931 if (0 <= nitems_max && nitems_max < n)
932 n = nitems_max; 932 n = nitems_max;
933 933
934 ptrdiff_t adjusted_nbytes 934 ptrdiff_t adjusted_nbytes
935 = ((INT_MULTIPLY_WRAPV (n, item_size, &nbytes) || SIZE_MAX < nbytes) 935 = ((ckd_mul (&nbytes, n, item_size) || SIZE_MAX < nbytes)
936 ? min (PTRDIFF_MAX, SIZE_MAX) 936 ? min (PTRDIFF_MAX, SIZE_MAX)
937 : nbytes < DEFAULT_MXFAST ? DEFAULT_MXFAST : 0); 937 : nbytes < DEFAULT_MXFAST ? DEFAULT_MXFAST : 0);
938 if (adjusted_nbytes) 938 if (adjusted_nbytes)
@@ -944,9 +944,9 @@ xpalloc (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
944 if (! pa) 944 if (! pa)
945 *nitems = 0; 945 *nitems = 0;
946 if (n - n0 < nitems_incr_min 946 if (n - n0 < nitems_incr_min
947 && (INT_ADD_WRAPV (n0, nitems_incr_min, &n) 947 && (ckd_add (&n, n0, nitems_incr_min)
948 || (0 <= nitems_max && nitems_max < n) 948 || (0 <= nitems_max && nitems_max < n)
949 || INT_MULTIPLY_WRAPV (n, item_size, &nbytes))) 949 || ckd_mul (&nbytes, n, item_size)))
950 memory_full (SIZE_MAX); 950 memory_full (SIZE_MAX);
951 pa = xrealloc (pa, nbytes); 951 pa = xrealloc (pa, nbytes);
952 *nitems = n; 952 *nitems = n;
@@ -2381,7 +2381,7 @@ a multibyte string even if INIT is an ASCII character. */)
2381 ptrdiff_t len = CHAR_STRING (c, str); 2381 ptrdiff_t len = CHAR_STRING (c, str);
2382 EMACS_INT string_len = XFIXNUM (length); 2382 EMACS_INT string_len = XFIXNUM (length);
2383 2383
2384 if (INT_MULTIPLY_WRAPV (len, string_len, &nbytes)) 2384 if (ckd_mul (&nbytes, len, string_len))
2385 string_overflow (); 2385 string_overflow ();
2386 val = make_clear_multibyte_string (string_len, nbytes, clearit); 2386 val = make_clear_multibyte_string (string_len, nbytes, clearit);
2387 if (!clearit) 2387 if (!clearit)
@@ -5312,7 +5312,7 @@ mark_memory (void const *start, void const *end)
5312 a Lisp_Object might be split into registers saved into 5312 a Lisp_Object might be split into registers saved into
5313 non-adjacent words and P might be the low-order word's value. */ 5313 non-adjacent words and P might be the low-order word's value. */
5314 intptr_t ip; 5314 intptr_t ip;
5315 INT_ADD_WRAPV ((intptr_t) p, (intptr_t) lispsym, &ip); 5315 ckd_add (&ip, (intptr_t) p, (intptr_t) lispsym);
5316 mark_maybe_pointer ((void *) ip, true); 5316 mark_maybe_pointer ((void *) ip, true);
5317 } 5317 }
5318} 5318}
@@ -5424,15 +5424,6 @@ typedef union
5424#endif 5424#endif
5425} stacktop_sentry; 5425} stacktop_sentry;
5426 5426
5427/* Yield an address close enough to the top of the stack that the
5428 garbage collector need not scan above it. Callers should be
5429 declared NO_INLINE. */
5430#ifdef HAVE___BUILTIN_FRAME_ADDRESS
5431# define NEAR_STACK_TOP(addr) ((void) (addr), __builtin_frame_address (0))
5432#else
5433# define NEAR_STACK_TOP(addr) (addr)
5434#endif
5435
5436/* Set *P to the address of the top of the stack. This must be a 5427/* Set *P to the address of the top of the stack. This must be a
5437 macro, not a function, so that it is executed in the caller's 5428 macro, not a function, so that it is executed in the caller's
5438 environment. It is not inside a do-while so that its storage 5429 environment. It is not inside a do-while so that its storage
diff --git a/src/bignum.c b/src/bignum.c
index e64653b2873..22ed171533f 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -354,7 +354,7 @@ emacs_mpz_pow_ui (mpz_t rop, mpz_t const base, unsigned long exp)
354 enum { lim = min (NLIMBS_LIMIT, GMP_NLIMBS_MAX - pow_ui_extra_limbs) }; 354 enum { lim = min (NLIMBS_LIMIT, GMP_NLIMBS_MAX - pow_ui_extra_limbs) };
355 355
356 int nbase = emacs_mpz_size (base), n; 356 int nbase = emacs_mpz_size (base), n;
357 if (INT_MULTIPLY_WRAPV (nbase, exp, &n) || lim < n) 357 if (ckd_mul (&n, nbase, exp) || lim < n)
358 overflow_error (); 358 overflow_error ();
359 mpz_pow_ui (rop, base, exp); 359 mpz_pow_ui (rop, base, exp);
360} 360}
diff --git a/src/buffer.c b/src/buffer.c
index df1f5206668..0c46b201586 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -50,6 +50,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
50#include "w32heap.h" /* for mmap_* */ 50#include "w32heap.h" /* for mmap_* */
51#endif 51#endif
52 52
53/* Work around GCC bug 109847
54 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109847
55 which causes GCC to mistakenly complain about
56 AUTO_STRING with "*scratch*". */
57#if GNUC_PREREQ (13, 0, 0)
58# pragma GCC diagnostic ignored "-Wanalyzer-out-of-bounds"
59#endif
60
53/* This structure holds the default values of the buffer-local variables 61/* This structure holds the default values of the buffer-local variables
54 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer. 62 defined with DEFVAR_PER_BUFFER, that have special slots in each buffer.
55 The default value occupies the same slot in this structure 63 The default value occupies the same slot in this structure
@@ -1307,7 +1315,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
1307 start: 1315 start:
1308 switch (sym->u.s.redirect) 1316 switch (sym->u.s.redirect)
1309 { 1317 {
1310 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; 1318 case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
1311 case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break; 1319 case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break;
1312 case SYMBOL_LOCALIZED: 1320 case SYMBOL_LOCALIZED:
1313 { /* Look in local_var_alist. */ 1321 { /* Look in local_var_alist. */
@@ -2386,6 +2394,7 @@ Any narrowing restriction in effect (see `narrow-to-region') is removed,
2386so the buffer is truly empty after this. */) 2394so the buffer is truly empty after this. */)
2387 (void) 2395 (void)
2388{ 2396{
2397 labeled_restrictions_remove_in_current_buffer ();
2389 Fwiden (); 2398 Fwiden ();
2390 2399
2391 del_range (BEG, Z); 2400 del_range (BEG, Z);
@@ -3334,7 +3343,7 @@ record_overlay_string (struct sortstrlist *ssl, Lisp_Object str,
3334 else 3343 else
3335 nbytes = SBYTES (str); 3344 nbytes = SBYTES (str);
3336 3345
3337 if (INT_ADD_WRAPV (ssl->bytes, nbytes, &nbytes)) 3346 if (ckd_add (&nbytes, nbytes, ssl->bytes))
3338 memory_full (SIZE_MAX); 3347 memory_full (SIZE_MAX);
3339 ssl->bytes = nbytes; 3348 ssl->bytes = nbytes;
3340 3349
@@ -3348,7 +3357,7 @@ record_overlay_string (struct sortstrlist *ssl, Lisp_Object str,
3348 else 3357 else
3349 nbytes = SBYTES (str2); 3358 nbytes = SBYTES (str2);
3350 3359
3351 if (INT_ADD_WRAPV (ssl->bytes, nbytes, &nbytes)) 3360 if (ckd_add (&nbytes, nbytes, ssl->bytes))
3352 memory_full (SIZE_MAX); 3361 memory_full (SIZE_MAX);
3353 ssl->bytes = nbytes; 3362 ssl->bytes = nbytes;
3354 } 3363 }
@@ -3420,7 +3429,7 @@ overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr)
3420 unsigned char *p; 3429 unsigned char *p;
3421 ptrdiff_t total; 3430 ptrdiff_t total;
3422 3431
3423 if (INT_ADD_WRAPV (overlay_heads.bytes, overlay_tails.bytes, &total)) 3432 if (ckd_add (&total, overlay_heads.bytes, overlay_tails.bytes))
3424 memory_full (SIZE_MAX); 3433 memory_full (SIZE_MAX);
3425 if (total > overlay_str_len) 3434 if (total > overlay_str_len)
3426 overlay_str_buf = xpalloc (overlay_str_buf, &overlay_str_len, 3435 overlay_str_buf = xpalloc (overlay_str_buf, &overlay_str_len,
@@ -5124,33 +5133,38 @@ A list whose car is an integer is processed by processing the cadr of
5124 negative) to the width specified by that number. 5133 negative) to the width specified by that number.
5125 5134
5126A string is printed verbatim in the mode line except for %-constructs: 5135A string is printed verbatim in the mode line except for %-constructs:
5127 %b -- print buffer name. %f -- print visited file name. 5136 %b -- print buffer name.
5128 %F -- print frame name.
5129 %* -- print %, * or hyphen. %+ -- print *, % or hyphen.
5130 %& is like %*, but ignore read-only-ness.
5131 % means buffer is read-only and * means it is modified.
5132 For a modified read-only buffer, %* gives % and %+ gives *.
5133 %s -- print process status. %l -- print the current line number.
5134 %c -- print the current column number (this makes editing slower). 5137 %c -- print the current column number (this makes editing slower).
5135 Columns are numbered starting from the left margin, and the 5138 Columns are numbered starting from the left margin, and the
5136 leftmost column is displayed as zero. 5139 leftmost column is displayed as zero.
5137 To make the column number update correctly in all cases, 5140 To make the column number update correctly in all cases,
5138 `column-number-mode' must be non-nil. 5141 `column-number-mode' must be non-nil.
5139 %C -- Like %c, but the leftmost column is displayed as one. 5142 %C -- Like %c, but the leftmost column is displayed as one.
5143 %e -- print error message about full memory.
5144 %f -- print visited file name.
5145 %F -- print frame name.
5140 %i -- print the size of the buffer. 5146 %i -- print the size of the buffer.
5141 %I -- like %i, but use k, M, G, etc., to abbreviate. 5147 %I -- like %i, but use k, M, G, etc., to abbreviate.
5148 %l -- print the current line number.
5149 %n -- print Narrow if appropriate.
5150 %o -- print percent of window travel through buffer, or Top, Bot or All.
5142 %p -- print percent of buffer above top of window, or Top, Bot or All. 5151 %p -- print percent of buffer above top of window, or Top, Bot or All.
5143 %P -- print percent of buffer above bottom of window, perhaps plus Top, 5152 %P -- print percent of buffer above bottom of window, perhaps plus Top,
5144 or print Bottom or All. 5153 or print Bottom or All.
5145 %n -- print Narrow if appropriate. 5154 %q -- print percent of buffer above both the top and the bottom of the
5146 %t -- visited file is text or binary (if OS supports this distinction). 5155 window, separated by ‘-’, or ‘All’.
5156 %s -- print process status.
5147 %z -- print mnemonics of keyboard, terminal, and buffer coding systems. 5157 %z -- print mnemonics of keyboard, terminal, and buffer coding systems.
5148 %Z -- like %z, but including the end-of-line format. 5158 %Z -- like %z, but including the end-of-line format.
5149 %e -- print error message about full memory. 5159 %& -- print * if the buffer is modified, otherwise hyphen.
5150 %@ -- print @ or hyphen. @ means that default-directory is on a 5160 %+ -- print *, % or hyphen (modified, read-only, neither).
5151 remote machine. 5161 %* -- print %, * or hyphen (read-only, modified, neither).
5152 %[ -- print one [ for each recursive editing level. %] similar. 5162 For a modified read-only buffer, %+ prints * and %* prints %.
5153 %% -- print %. %- -- print infinitely many dashes. 5163 %@ -- print @ if default-directory is on a remote machine, else hyphen.
5164 %[ -- print one [ for each recursive editing level.
5165 %] -- print one ] for each recursive editing level.
5166 %- -- print enough dashes to fill the mode line.
5167 %% -- print %.
5154Decimal digits after the % specify field width to which to pad. */); 5168Decimal digits after the % specify field width to which to pad. */);
5155 5169
5156 DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode), 5170 DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode),
diff --git a/src/bytecode.c b/src/bytecode.c
index 74a94859aba..4207ff0b71f 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1327,7 +1327,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
1327 Lisp_Object v1 = TOP; 1327 Lisp_Object v1 = TOP;
1328 intmax_t res; 1328 intmax_t res;
1329 if (FIXNUMP (v1) && FIXNUMP (v2) 1329 if (FIXNUMP (v1) && FIXNUMP (v2)
1330 && !INT_MULTIPLY_WRAPV (XFIXNUM (v1), XFIXNUM (v2), &res) 1330 && !ckd_mul (&res, XFIXNUM (v1), XFIXNUM (v2))
1331 && !FIXNUM_OVERFLOW_P (res)) 1331 && !FIXNUM_OVERFLOW_P (res))
1332 TOP = make_fixnum (res); 1332 TOP = make_fixnum (res);
1333 else 1333 else
diff --git a/src/callproc.c b/src/callproc.c
index 5e1e1a8cc0a..6f3d4fad9be 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -1113,6 +1113,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
1113 { 1113 {
1114 /* No need to save restrictions since we delete everything 1114 /* No need to save restrictions since we delete everything
1115 anyway. */ 1115 anyway. */
1116 labeled_restrictions_remove_in_current_buffer ();
1116 Fwiden (); 1117 Fwiden ();
1117 del_range (BEG, Z); 1118 del_range (BEG, Z);
1118 } 1119 }
diff --git a/src/casefiddle.c b/src/casefiddle.c
index 1a2b37350ec..0e3e5094301 100644
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -283,8 +283,8 @@ do_casify_multibyte_string (struct casing_context *ctx, Lisp_Object obj)
283 283
284 ptrdiff_t size = SCHARS (obj), n; 284 ptrdiff_t size = SCHARS (obj), n;
285 USE_SAFE_ALLOCA; 285 USE_SAFE_ALLOCA;
286 if (INT_MULTIPLY_WRAPV (size, MAX_MULTIBYTE_LENGTH, &n) 286 if (ckd_mul (&n, size, MAX_MULTIBYTE_LENGTH)
287 || INT_ADD_WRAPV (n, sizeof (struct casing_str_buf), &n)) 287 || ckd_add (&n, n, sizeof (struct casing_str_buf)))
288 n = PTRDIFF_MAX; 288 n = PTRDIFF_MAX;
289 unsigned char *dst = SAFE_ALLOCA (n); 289 unsigned char *dst = SAFE_ALLOCA (n);
290 unsigned char *dst_end = dst + n; 290 unsigned char *dst_end = dst + n;
diff --git a/src/ccl.c b/src/ccl.c
index c33bb434afd..013d9960c0e 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -605,6 +605,14 @@ do \
605 } \ 605 } \
606while (0) 606while (0)
607 607
608/* Work around GCC bug 109579
609 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109579
610 which causes GCC to mistakenly complain about
611 popping the mapping stack. */
612#if GNUC_PREREQ (13, 0, 0)
613# pragma GCC diagnostic ignored "-Wanalyzer-out-of-bounds"
614#endif
615
608#define POP_MAPPING_STACK(restlen, orig) \ 616#define POP_MAPPING_STACK(restlen, orig) \
609do \ 617do \
610 { \ 618 { \
@@ -1148,9 +1156,9 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
1148 ccl_expr_self: 1156 ccl_expr_self:
1149 switch (op) 1157 switch (op)
1150 { 1158 {
1151 case CCL_PLUS: INT_ADD_WRAPV (reg[rrr], i, &reg[rrr]); break; 1159 case CCL_PLUS: ckd_add (&reg[rrr], reg[rrr], i); break;
1152 case CCL_MINUS: INT_SUBTRACT_WRAPV (reg[rrr], i, &reg[rrr]); break; 1160 case CCL_MINUS: ckd_sub (&reg[rrr], reg[rrr], i); break;
1153 case CCL_MUL: INT_MULTIPLY_WRAPV (reg[rrr], i, &reg[rrr]); break; 1161 case CCL_MUL: ckd_mul (&reg[rrr], reg[rrr], i); break;
1154 case CCL_DIV: 1162 case CCL_DIV:
1155 if (!i) 1163 if (!i)
1156 CCL_INVALID_CMD; 1164 CCL_INVALID_CMD;
@@ -1186,7 +1194,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
1186 if (i == -1) 1194 if (i == -1)
1187 { 1195 {
1188 reg[7] = 0; 1196 reg[7] = 0;
1189 INT_SUBTRACT_WRAPV (0, reg[rrr], &reg[rrr]); 1197 ckd_sub (&reg[rrr], 0, reg[rrr]);
1190 } 1198 }
1191 else 1199 else
1192 { 1200 {
@@ -1243,9 +1251,9 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
1243 ccl_set_expr: 1251 ccl_set_expr:
1244 switch (op) 1252 switch (op)
1245 { 1253 {
1246 case CCL_PLUS: INT_ADD_WRAPV (i, j, &reg[rrr]); break; 1254 case CCL_PLUS: ckd_add (&reg[rrr], i, j); break;
1247 case CCL_MINUS: INT_SUBTRACT_WRAPV (i, j, &reg[rrr]); break; 1255 case CCL_MINUS: ckd_sub (&reg[rrr], i, j); break;
1248 case CCL_MUL: INT_MULTIPLY_WRAPV (i, j, &reg[rrr]); break; 1256 case CCL_MUL: ckd_mul (&reg[rrr], i, j); break;
1249 case CCL_DIV: 1257 case CCL_DIV:
1250 if (!j) 1258 if (!j)
1251 CCL_INVALID_CMD; 1259 CCL_INVALID_CMD;
@@ -1280,7 +1288,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
1280 CCL_INVALID_CMD; 1288 CCL_INVALID_CMD;
1281 if (j == -1) 1289 if (j == -1)
1282 { 1290 {
1283 INT_SUBTRACT_WRAPV (0, reg[rrr], &reg[rrr]); 1291 ckd_sub (&reg[rrr], 0, reg[rrr]);
1284 reg[7] = 0; 1292 reg[7] = 0;
1285 } 1293 }
1286 else 1294 else
@@ -2161,8 +2169,8 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY
2161 2169
2162 buf_magnification = ccl.buf_magnification ? ccl.buf_magnification : 1; 2170 buf_magnification = ccl.buf_magnification ? ccl.buf_magnification : 1;
2163 outbufsize = str_bytes; 2171 outbufsize = str_bytes;
2164 if (INT_MULTIPLY_WRAPV (buf_magnification, outbufsize, &outbufsize) 2172 if (ckd_mul (&outbufsize, outbufsize, buf_magnification)
2165 || INT_ADD_WRAPV (256, outbufsize, &outbufsize)) 2173 || ckd_add (&outbufsize, outbufsize, 256))
2166 memory_full (SIZE_MAX); 2174 memory_full (SIZE_MAX);
2167 outp = outbuf = xmalloc (outbufsize); 2175 outp = outbuf = xmalloc (outbufsize);
2168 2176
diff --git a/src/character.c b/src/character.c
index d0b18367a83..ae153a579d6 100644
--- a/src/character.c
+++ b/src/character.c
@@ -250,7 +250,7 @@ char_width (int c, struct Lisp_Char_Table *dp)
250 if (c >= 0) 250 if (c >= 0)
251 { 251 {
252 int w = CHARACTER_WIDTH (c); 252 int w = CHARACTER_WIDTH (c);
253 if (INT_ADD_WRAPV (width, w, &width)) 253 if (ckd_add (&width, width, w))
254 string_overflow (); 254 string_overflow ();
255 } 255 }
256 } 256 }
@@ -301,7 +301,7 @@ c_string_width (const unsigned char *str, ptrdiff_t len, int precision,
301 *nbytes = i_byte; 301 *nbytes = i_byte;
302 return width; 302 return width;
303 } 303 }
304 if (INT_ADD_WRAPV (thiswidth, width, &width)) 304 if (ckd_add (&width, width, thiswidth))
305 string_overflow (); 305 string_overflow ();
306 i++; 306 i++;
307 i_byte += bytes; 307 i_byte += bytes;
@@ -441,7 +441,7 @@ lisp_string_width (Lisp_Object string, ptrdiff_t from, ptrdiff_t to,
441 *nbytes = i_byte - from_byte; 441 *nbytes = i_byte - from_byte;
442 return width; 442 return width;
443 } 443 }
444 if (INT_ADD_WRAPV (thiswidth, width, &width)) 444 if (ckd_add (&width, width, thiswidth))
445 string_overflow (); 445 string_overflow ();
446 i += chars; 446 i += chars;
447 i_byte += bytes; 447 i_byte += bytes;
@@ -664,7 +664,7 @@ count_size_as_multibyte (const unsigned char *str, ptrdiff_t len)
664 for (ptrdiff_t i = 0; i < len; i++) 664 for (ptrdiff_t i = 0; i < len; i++)
665 nonascii += str[i] >> 7; 665 nonascii += str[i] >> 7;
666 ptrdiff_t bytes; 666 ptrdiff_t bytes;
667 if (INT_ADD_WRAPV (len, nonascii, &bytes)) 667 if (ckd_add (&bytes, len, nonascii))
668 string_overflow (); 668 string_overflow ();
669 return bytes; 669 return bytes;
670} 670}
@@ -780,21 +780,21 @@ string_escape_byte8 (Lisp_Object string)
780 if (byte8_count == 0) 780 if (byte8_count == 0)
781 return string; 781 return string;
782 782
783 if (INT_MULTIPLY_WRAPV (byte8_count, 3, &thrice_byte8_count)) 783 if (ckd_mul (&thrice_byte8_count, byte8_count, 3))
784 string_overflow (); 784 string_overflow ();
785 785
786 if (multibyte) 786 if (multibyte)
787 { 787 {
788 /* Convert 2-byte sequence of byte8 chars to 4-byte octal. */ 788 /* Convert 2-byte sequence of byte8 chars to 4-byte octal. */
789 if (INT_ADD_WRAPV (nchars, thrice_byte8_count, &uninit_nchars) 789 if (ckd_add (&uninit_nchars, nchars, thrice_byte8_count)
790 || INT_ADD_WRAPV (nbytes, 2 * byte8_count, &uninit_nbytes)) 790 || ckd_add (&uninit_nbytes, nbytes, 2 * byte8_count))
791 string_overflow (); 791 string_overflow ();
792 val = make_uninit_multibyte_string (uninit_nchars, uninit_nbytes); 792 val = make_uninit_multibyte_string (uninit_nchars, uninit_nbytes);
793 } 793 }
794 else 794 else
795 { 795 {
796 /* Convert 1-byte sequence of byte8 chars to 4-byte octal. */ 796 /* Convert 1-byte sequence of byte8 chars to 4-byte octal. */
797 if (INT_ADD_WRAPV (thrice_byte8_count, nbytes, &uninit_nbytes)) 797 if (ckd_add (&uninit_nbytes, thrice_byte8_count, nbytes))
798 string_overflow (); 798 string_overflow ();
799 val = make_uninit_string (uninit_nbytes); 799 val = make_uninit_string (uninit_nbytes);
800 } 800 }
diff --git a/src/cmds.c b/src/cmds.c
index 15caa4a6972..37e1779296a 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -453,7 +453,7 @@ internal_self_insert (int c, EMACS_INT n)
453 } 453 }
454 454
455 ptrdiff_t to; 455 ptrdiff_t to;
456 if (INT_ADD_WRAPV (PT, chars_to_delete, &to)) 456 if (ckd_add (&to, PT, chars_to_delete))
457 to = PTRDIFF_MAX; 457 to = PTRDIFF_MAX;
458 replace_range (PT, to, string, 1, 1, 1, 0, false); 458 replace_range (PT, to, string, 1, 1, 1, 0, false);
459 Fforward_char (make_fixnum (n)); 459 Fforward_char (make_fixnum (n));
diff --git a/src/coding.c b/src/coding.c
index a2e0d7040f8..f014749c4ea 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -989,7 +989,7 @@ static void
989coding_alloc_by_realloc (struct coding_system *coding, ptrdiff_t bytes) 989coding_alloc_by_realloc (struct coding_system *coding, ptrdiff_t bytes)
990{ 990{
991 ptrdiff_t newbytes; 991 ptrdiff_t newbytes;
992 if (INT_ADD_WRAPV (coding->dst_bytes, bytes, &newbytes) 992 if (ckd_add (&newbytes, coding->dst_bytes, bytes)
993 || SIZE_MAX < newbytes) 993 || SIZE_MAX < newbytes)
994 string_overflow (); 994 string_overflow ();
995 coding->destination = xrealloc (coding->destination, newbytes); 995 coding->destination = xrealloc (coding->destination, newbytes);
@@ -7059,9 +7059,8 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
7059 { 7059 {
7060 eassert (growable_destination (coding)); 7060 eassert (growable_destination (coding));
7061 ptrdiff_t dst_size; 7061 ptrdiff_t dst_size;
7062 if (INT_MULTIPLY_WRAPV (to_nchars, MAX_MULTIBYTE_LENGTH, 7062 if (ckd_mul (&dst_size, to_nchars, MAX_MULTIBYTE_LENGTH)
7063 &dst_size) 7063 || ckd_add (&dst_size, dst_size, buf_end - buf))
7064 || INT_ADD_WRAPV (buf_end - buf, dst_size, &dst_size))
7065 memory_full (SIZE_MAX); 7064 memory_full (SIZE_MAX);
7066 dst = alloc_destination (coding, dst_size, dst); 7065 dst = alloc_destination (coding, dst_size, dst);
7067 if (EQ (coding->src_object, coding->dst_object)) 7066 if (EQ (coding->src_object, coding->dst_object))
diff --git a/src/comp.c b/src/comp.c
index 89708fa8f68..dadd5255b72 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -8677,6 +8677,14 @@ For internal use. */);
8677 Vcomp_loaded_comp_units_h = 8677 Vcomp_loaded_comp_units_h =
8678 CALLN (Fmake_hash_table, QCweakness, Qvalue, QCtest, Qequal); 8678 CALLN (Fmake_hash_table, QCweakness, Qvalue, QCtest, Qequal);
8679 8679
8680 DEFVAR_LISP ("comp-subr-arities-h", Vcomp_subr_arities_h,
8681 doc: /* Hash table recording the arity of Lisp primitives.
8682This is in case they are redefined so the compiler still knows how to
8683compile calls to them.
8684subr-name -> arity
8685For internal use. */);
8686 Vcomp_subr_arities_h = CALLN (Fmake_hash_table, QCtest, Qequal);
8687
8680 Fprovide (intern_c_string ("native-compile"), Qnil); 8688 Fprovide (intern_c_string ("native-compile"), Qnil);
8681#endif /* #ifdef HAVE_NATIVE_COMP */ 8689#endif /* #ifdef HAVE_NATIVE_COMP */
8682 8690
diff --git a/src/composite.c b/src/composite.c
index 164eeb39598..9332c1cb9a3 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -1040,7 +1040,9 @@ inhibit_auto_composition (void)
1040 composition closest to CHARPOS is found, set cmp_it->stop_pos to 1040 composition closest to CHARPOS is found, set cmp_it->stop_pos to
1041 the last character of the composition. STRING, if non-nil, is 1041 the last character of the composition. STRING, if non-nil, is
1042 the string (as opposed to a buffer) whose characters should be 1042 the string (as opposed to a buffer) whose characters should be
1043 tested for being composable. 1043 tested for being composable. INCLUDE_STATIC non-zero means
1044 consider both static and automatic compositions; if zero, look
1045 only for potential automatic compositions.
1044 1046
1045 If no composition is found, set cmp_it->ch to -2. If a static 1047 If no composition is found, set cmp_it->ch to -2. If a static
1046 composition is found, set cmp_it->ch to -1. Otherwise, set 1048 composition is found, set cmp_it->ch to -1. Otherwise, set
@@ -1050,7 +1052,7 @@ inhibit_auto_composition (void)
1050void 1052void
1051composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, 1053composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos,
1052 ptrdiff_t bytepos, ptrdiff_t endpos, 1054 ptrdiff_t bytepos, ptrdiff_t endpos,
1053 Lisp_Object string) 1055 Lisp_Object string, bool include_static)
1054{ 1056{
1055 ptrdiff_t start, end; 1057 ptrdiff_t start, end;
1056 int c; 1058 int c;
@@ -1075,7 +1077,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos,
1075 with long lines, however, NL might be far away, so 1077 with long lines, however, NL might be far away, so
1076 pretend that the buffer is smaller. */ 1078 pretend that the buffer is smaller. */
1077 if (current_buffer->long_line_optimizations_p) 1079 if (current_buffer->long_line_optimizations_p)
1078 endpos = get_closer_narrowed_begv (cmp_it->parent_it->w, charpos); 1080 endpos = get_small_narrowing_begv (cmp_it->parent_it->w, charpos);
1079 } 1081 }
1080 } 1082 }
1081 cmp_it->id = -1; 1083 cmp_it->id = -1;
@@ -1084,8 +1086,10 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos,
1084 cmp_it->stop_pos = endpos; 1086 cmp_it->stop_pos = endpos;
1085 if (charpos == endpos) 1087 if (charpos == endpos)
1086 return; 1088 return;
1089 /* Look for static compositions. */
1087 /* FIXME: Bidi is not yet handled well in static composition. */ 1090 /* FIXME: Bidi is not yet handled well in static composition. */
1088 if (charpos < endpos 1091 if (include_static
1092 && charpos < endpos
1089 && find_composition (charpos, endpos, &start, &end, &prop, string) 1093 && find_composition (charpos, endpos, &start, &end, &prop, string)
1090 && start >= charpos 1094 && start >= charpos
1091 && composition_valid_p (start, end, prop)) 1095 && composition_valid_p (start, end, prop))
@@ -1106,6 +1110,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos,
1106 bytepos = string_char_to_byte (string, charpos); 1110 bytepos = string_char_to_byte (string, charpos);
1107 } 1111 }
1108 1112
1113 /* Look for automatic compositions. */
1109 start = charpos; 1114 start = charpos;
1110 if (charpos < endpos) 1115 if (charpos < endpos)
1111 { 1116 {
@@ -1285,7 +1290,8 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
1285{ 1290{
1286 if (cmp_it->ch == -2) 1291 if (cmp_it->ch == -2)
1287 { 1292 {
1288 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string); 1293 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string,
1294 true);
1289 if (cmp_it->ch == -2 || cmp_it->stop_pos != charpos) 1295 if (cmp_it->ch == -2 || cmp_it->stop_pos != charpos)
1290 /* The current position is not composed. */ 1296 /* The current position is not composed. */
1291 return 0; 1297 return 0;
@@ -1424,7 +1430,7 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
1424 } 1430 }
1425 if (cmp_it->reversed_p) 1431 if (cmp_it->reversed_p)
1426 endpos = -1; 1432 endpos = -1;
1427 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string); 1433 composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string, true);
1428 return 0; 1434 return 0;
1429} 1435}
1430 1436
@@ -1654,7 +1660,7 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit, ptrdiff_t backlim,
1654 { 1660 {
1655 /* In buffers with very long lines, this function becomes very 1661 /* In buffers with very long lines, this function becomes very
1656 slow. Pretend that the buffer is narrowed to make it fast. */ 1662 slow. Pretend that the buffer is narrowed to make it fast. */
1657 ptrdiff_t begv = get_closer_narrowed_begv (w, window_point (w)); 1663 ptrdiff_t begv = get_small_narrowing_begv (w, window_point (w));
1658 if (pos > begv) 1664 if (pos > begv)
1659 head = begv; 1665 head = begv;
1660 } 1666 }
diff --git a/src/composite.h b/src/composite.h
index e81465d90cc..0f791c1ea62 100644
--- a/src/composite.h
+++ b/src/composite.h
@@ -348,7 +348,7 @@ extern bool find_automatic_composition (ptrdiff_t, ptrdiff_t, ptrdiff_t,
348 348
349extern void composition_compute_stop_pos (struct composition_it *, 349extern void composition_compute_stop_pos (struct composition_it *,
350 ptrdiff_t, ptrdiff_t, ptrdiff_t, 350 ptrdiff_t, ptrdiff_t, ptrdiff_t,
351 Lisp_Object); 351 Lisp_Object, bool);
352extern bool composition_reseat_it (struct composition_it *, ptrdiff_t, 352extern bool composition_reseat_it (struct composition_it *, ptrdiff_t,
353 ptrdiff_t, ptrdiff_t, struct window *, 353 ptrdiff_t, ptrdiff_t, struct window *,
354 signed char, struct face *, Lisp_Object); 354 signed char, struct face *, Lisp_Object);
diff --git a/src/data.c b/src/data.c
index d2f4d40d7bc..9d7e7effdcd 100644
--- a/src/data.c
+++ b/src/data.c
@@ -683,7 +683,7 @@ global value outside of any lexical scope. */)
683 switch (sym->u.s.redirect) 683 switch (sym->u.s.redirect)
684 { 684 {
685 case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break; 685 case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break;
686 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; 686 case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
687 case SYMBOL_LOCALIZED: 687 case SYMBOL_LOCALIZED:
688 { 688 {
689 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); 689 struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
@@ -773,7 +773,10 @@ DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
773} 773}
774 774
775DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, 775DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
776 doc: /* Return SYMBOL's name, a string. */) 776 doc: /* Return SYMBOL's name, a string.
777
778Warning: never alter the string returned by `symbol-name'.
779Doing that might make Emacs dysfunctional, and might even crash Emacs. */)
777 (register Lisp_Object symbol) 780 (register Lisp_Object symbol)
778{ 781{
779 register Lisp_Object name; 782 register Lisp_Object name;
@@ -1246,51 +1249,20 @@ The value, if non-nil, is a list of mode name symbols. */)
1246 Getting and Setting Values of Symbols 1249 Getting and Setting Values of Symbols
1247 ***********************************************************************/ 1250 ***********************************************************************/
1248 1251
1249/* Return the symbol holding SYMBOL's value. Signal
1250 `cyclic-variable-indirection' if SYMBOL's chain of variable
1251 indirections contains a loop. */
1252
1253struct Lisp_Symbol *
1254indirect_variable (struct Lisp_Symbol *symbol)
1255{
1256 struct Lisp_Symbol *tortoise, *hare;
1257
1258 hare = tortoise = symbol;
1259
1260 while (hare->u.s.redirect == SYMBOL_VARALIAS)
1261 {
1262 hare = SYMBOL_ALIAS (hare);
1263 if (hare->u.s.redirect != SYMBOL_VARALIAS)
1264 break;
1265
1266 hare = SYMBOL_ALIAS (hare);
1267 tortoise = SYMBOL_ALIAS (tortoise);
1268
1269 if (hare == tortoise)
1270 {
1271 Lisp_Object tem;
1272 XSETSYMBOL (tem, symbol);
1273 xsignal1 (Qcyclic_variable_indirection, tem);
1274 }
1275 }
1276
1277 return hare;
1278}
1279
1280
1281DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0, 1252DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0,
1282 doc: /* Return the variable at the end of OBJECT's variable chain. 1253 doc: /* Return the variable at the end of OBJECT's variable chain.
1283If OBJECT is a symbol, follow its variable indirections (if any), and 1254If OBJECT is a symbol, follow its variable indirections (if any), and
1284return the variable at the end of the chain of aliases. See Info node 1255return the variable at the end of the chain of aliases. See Info node
1285`(elisp)Variable Aliases'. 1256`(elisp)Variable Aliases'.
1286 1257
1287If OBJECT is not a symbol, just return it. If there is a loop in the 1258If OBJECT is not a symbol, just return it. */)
1288chain of aliases, signal a `cyclic-variable-indirection' error. */)
1289 (Lisp_Object object) 1259 (Lisp_Object object)
1290{ 1260{
1291 if (SYMBOLP (object)) 1261 if (SYMBOLP (object))
1292 { 1262 {
1293 struct Lisp_Symbol *sym = indirect_variable (XSYMBOL (object)); 1263 struct Lisp_Symbol *sym = XSYMBOL (object);
1264 while (sym->u.s.redirect == SYMBOL_VARALIAS)
1265 sym = SYMBOL_ALIAS (sym);
1294 XSETSYMBOL (object, sym); 1266 XSETSYMBOL (object, sym);
1295 } 1267 }
1296 return object; 1268 return object;
@@ -1579,7 +1551,7 @@ find_symbol_value (Lisp_Object symbol)
1579 start: 1551 start:
1580 switch (sym->u.s.redirect) 1552 switch (sym->u.s.redirect)
1581 { 1553 {
1582 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; 1554 case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
1583 case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym); 1555 case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
1584 case SYMBOL_LOCALIZED: 1556 case SYMBOL_LOCALIZED:
1585 { 1557 {
@@ -1668,7 +1640,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
1668 start: 1640 start:
1669 switch (sym->u.s.redirect) 1641 switch (sym->u.s.redirect)
1670 { 1642 {
1671 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; 1643 case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
1672 case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return; 1644 case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return;
1673 case SYMBOL_LOCALIZED: 1645 case SYMBOL_LOCALIZED:
1674 { 1646 {
@@ -1922,7 +1894,7 @@ default_value (Lisp_Object symbol)
1922 start: 1894 start:
1923 switch (sym->u.s.redirect) 1895 switch (sym->u.s.redirect)
1924 { 1896 {
1925 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; 1897 case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
1926 case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym); 1898 case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
1927 case SYMBOL_LOCALIZED: 1899 case SYMBOL_LOCALIZED:
1928 { 1900 {
@@ -2016,7 +1988,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
2016 start: 1988 start:
2017 switch (sym->u.s.redirect) 1989 switch (sym->u.s.redirect)
2018 { 1990 {
2019 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; 1991 case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
2020 case SYMBOL_PLAINVAL: set_internal (symbol, value, Qnil, bindflag); return; 1992 case SYMBOL_PLAINVAL: set_internal (symbol, value, Qnil, bindflag); return;
2021 case SYMBOL_LOCALIZED: 1993 case SYMBOL_LOCALIZED:
2022 { 1994 {
@@ -2154,7 +2126,7 @@ See also `defvar-local'. */)
2154 start: 2126 start:
2155 switch (sym->u.s.redirect) 2127 switch (sym->u.s.redirect)
2156 { 2128 {
2157 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; 2129 case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
2158 case SYMBOL_PLAINVAL: 2130 case SYMBOL_PLAINVAL:
2159 forwarded = 0; valcontents.value = SYMBOL_VAL (sym); 2131 forwarded = 0; valcontents.value = SYMBOL_VAL (sym);
2160 if (BASE_EQ (valcontents.value, Qunbound)) 2132 if (BASE_EQ (valcontents.value, Qunbound))
@@ -2222,7 +2194,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
2222 start: 2194 start:
2223 switch (sym->u.s.redirect) 2195 switch (sym->u.s.redirect)
2224 { 2196 {
2225 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; 2197 case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
2226 case SYMBOL_PLAINVAL: 2198 case SYMBOL_PLAINVAL:
2227 forwarded = 0; valcontents.value = SYMBOL_VAL (sym); break; 2199 forwarded = 0; valcontents.value = SYMBOL_VAL (sym); break;
2228 case SYMBOL_LOCALIZED: 2200 case SYMBOL_LOCALIZED:
@@ -2308,7 +2280,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
2308 start: 2280 start:
2309 switch (sym->u.s.redirect) 2281 switch (sym->u.s.redirect)
2310 { 2282 {
2311 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; 2283 case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
2312 case SYMBOL_PLAINVAL: return variable; 2284 case SYMBOL_PLAINVAL: return variable;
2313 case SYMBOL_FORWARDED: 2285 case SYMBOL_FORWARDED:
2314 { 2286 {
@@ -2375,7 +2347,7 @@ Also see `buffer-local-boundp'.*/)
2375 start: 2347 start:
2376 switch (sym->u.s.redirect) 2348 switch (sym->u.s.redirect)
2377 { 2349 {
2378 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; 2350 case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
2379 case SYMBOL_PLAINVAL: return Qnil; 2351 case SYMBOL_PLAINVAL: return Qnil;
2380 case SYMBOL_LOCALIZED: 2352 case SYMBOL_LOCALIZED:
2381 { 2353 {
@@ -2425,7 +2397,7 @@ value in BUFFER, or if VARIABLE is automatically buffer-local (see
2425 start: 2397 start:
2426 switch (sym->u.s.redirect) 2398 switch (sym->u.s.redirect)
2427 { 2399 {
2428 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; 2400 case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
2429 case SYMBOL_PLAINVAL: return Qnil; 2401 case SYMBOL_PLAINVAL: return Qnil;
2430 case SYMBOL_LOCALIZED: 2402 case SYMBOL_LOCALIZED:
2431 { 2403 {
@@ -2460,7 +2432,7 @@ If the current binding is global (the default), the value is nil. */)
2460 start: 2432 start:
2461 switch (sym->u.s.redirect) 2433 switch (sym->u.s.redirect)
2462 { 2434 {
2463 case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; 2435 case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
2464 case SYMBOL_PLAINVAL: return Qnil; 2436 case SYMBOL_PLAINVAL: return Qnil;
2465 case SYMBOL_FORWARDED: 2437 case SYMBOL_FORWARDED:
2466 { 2438 {
@@ -3218,9 +3190,9 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
3218 intmax_t a; 3190 intmax_t a;
3219 switch (code) 3191 switch (code)
3220 { 3192 {
3221 case Aadd : overflow = INT_ADD_WRAPV (accum, next, &a); break; 3193 case Aadd : overflow = ckd_add (&a, accum, next); break;
3222 case Amult: overflow = INT_MULTIPLY_WRAPV (accum, next, &a); break; 3194 case Amult: overflow = ckd_mul (&a, accum, next); break;
3223 case Asub : overflow = INT_SUBTRACT_WRAPV (accum, next, &a); break; 3195 case Asub : overflow = ckd_sub (&a, accum, next); break;
3224 case Adiv: 3196 case Adiv:
3225 if (next == 0) 3197 if (next == 0)
3226 xsignal0 (Qarith_error); 3198 xsignal0 (Qarith_error);
@@ -4214,10 +4186,11 @@ syms_of_data (void)
4214 Fput (Qrecursion_error, Qerror_message, build_pure_c_string 4186 Fput (Qrecursion_error, Qerror_message, build_pure_c_string
4215 ("Excessive recursive calling error")); 4187 ("Excessive recursive calling error"));
4216 4188
4217 PUT_ERROR (Qexcessive_variable_binding, recursion_tail,
4218 "Variable binding depth exceeds max-specpdl-size");
4219 PUT_ERROR (Qexcessive_lisp_nesting, recursion_tail, 4189 PUT_ERROR (Qexcessive_lisp_nesting, recursion_tail,
4220 "Lisp nesting exceeds `max-lisp-eval-depth'"); 4190 "Lisp nesting exceeds `max-lisp-eval-depth'");
4191 /* Error obsolete (from 29.1), kept for compatibility. */
4192 PUT_ERROR (Qexcessive_variable_binding, recursion_tail,
4193 "Variable binding depth exceeds max-specpdl-size");
4221 4194
4222 /* Types that type-of returns. */ 4195 /* Types that type-of returns. */
4223 DEFSYM (Qinteger, "integer"); 4196 DEFSYM (Qinteger, "integer");
diff --git a/src/dispextern.h b/src/dispextern.h
index 4dcab113ea2..ece128949f5 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -2334,21 +2334,20 @@ struct it
2334 with which display_string was called. */ 2334 with which display_string was called. */
2335 ptrdiff_t end_charpos; 2335 ptrdiff_t end_charpos;
2336 2336
2337 /* Alternate begin position of the buffer that may be used to 2337 /* Alternate begin and end positions of the buffer that are used to
2338 optimize display (see the SET_WITH_NARROWED_BEGV macro). */ 2338 optimize display of buffers with long lines. These two fields
2339 ptrdiff_t narrowed_begv; 2339 hold the return value of the 'get_medium_narrowing_begv' and
2340 2340 'get_medium_narrowing_zv' functions. */
2341 /* Alternate end position of the buffer that may be used to 2341 ptrdiff_t medium_narrowing_begv;
2342 optimize display. */ 2342 ptrdiff_t medium_narrowing_zv;
2343 ptrdiff_t narrowed_zv; 2343
2344 2344 /* Alternate begin and end positions of the buffer that are used for
2345 /* Begin position of the buffer for the locked narrowing around 2345 labeled narrowings around low-level hooks in buffers with long
2346 low-level hooks. */ 2346 lines. These two fields hold the return value of the
2347 ptrdiff_t locked_narrowing_begv; 2347 'get_large_narrowing_begv' and 'get_large_narrowing_zv'
2348 2348 functions. */
2349 /* End position of the buffer for the locked narrowing around 2349 ptrdiff_t large_narrowing_begv;
2350 low-level hooks. */ 2350 ptrdiff_t large_narrowing_zv;
2351 ptrdiff_t locked_narrowing_zv;
2352 2351
2353 /* C string to iterate over. Non-null means get characters from 2352 /* C string to iterate over. Non-null means get characters from
2354 this string, otherwise characters are read from current_buffer 2353 this string, otherwise characters are read from current_buffer
@@ -3410,11 +3409,9 @@ void mark_window_display_accurate (Lisp_Object, bool);
3410void redisplay_preserve_echo_area (int); 3409void redisplay_preserve_echo_area (int);
3411void init_iterator (struct it *, struct window *, ptrdiff_t, 3410void init_iterator (struct it *, struct window *, ptrdiff_t,
3412 ptrdiff_t, struct glyph_row *, enum face_id); 3411 ptrdiff_t, struct glyph_row *, enum face_id);
3413ptrdiff_t get_narrowed_begv (struct window *, ptrdiff_t); 3412ptrdiff_t get_small_narrowing_begv (struct window *, ptrdiff_t);
3414ptrdiff_t get_narrowed_zv (struct window *, ptrdiff_t); 3413ptrdiff_t get_large_narrowing_begv (ptrdiff_t);
3415ptrdiff_t get_closer_narrowed_begv (struct window *, ptrdiff_t); 3414ptrdiff_t get_large_narrowing_zv (ptrdiff_t);
3416ptrdiff_t get_locked_narrowing_begv (ptrdiff_t);
3417ptrdiff_t get_locked_narrowing_zv (ptrdiff_t);
3418void init_iterator_to_row_start (struct it *, struct window *, 3415void init_iterator_to_row_start (struct it *, struct window *,
3419 struct glyph_row *); 3416 struct glyph_row *);
3420void start_display (struct it *, struct window *, struct text_pos); 3417void start_display (struct it *, struct window *, struct text_pos);
diff --git a/src/dispnew.c b/src/dispnew.c
index 43306043a0c..9133d515ca3 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -1385,7 +1385,7 @@ realloc_glyph_pool (struct glyph_pool *pool, struct dim matrix_dim)
1385 || matrix_dim.width != pool->ncolumns); 1385 || matrix_dim.width != pool->ncolumns);
1386 1386
1387 /* Enlarge the glyph pool. */ 1387 /* Enlarge the glyph pool. */
1388 if (INT_MULTIPLY_WRAPV (matrix_dim.height, matrix_dim.width, &needed)) 1388 if (ckd_mul (&needed, matrix_dim.height, matrix_dim.width))
1389 memory_full (SIZE_MAX); 1389 memory_full (SIZE_MAX);
1390 if (needed > pool->nglyphs) 1390 if (needed > pool->nglyphs)
1391 { 1391 {
@@ -2212,10 +2212,16 @@ adjust_frame_glyphs_for_window_redisplay (struct frame *f)
2212 2212
2213 w->pixel_left = 0; 2213 w->pixel_left = 0;
2214 w->left_col = 0; 2214 w->left_col = 0;
2215 w->pixel_top = FRAME_MENU_BAR_HEIGHT (f) 2215
2216 + (!NILP (Vtab_bar_position) ? FRAME_TOOL_BAR_HEIGHT (f) : 0); 2216 /* Note that tab and tool bar windows appear above the internal
2217 w->top_line = FRAME_MENU_BAR_LINES (f) 2217 border, as enforced by WINDOW_TOP_EDGE_Y. */
2218 + (!NILP (Vtab_bar_position) ? FRAME_TOOL_BAR_LINES (f) : 0); 2218
2219 w->pixel_top = (FRAME_MENU_BAR_HEIGHT (f)
2220 + (!NILP (Vtab_bar_position)
2221 ? FRAME_TOOL_BAR_HEIGHT (f) : 0));
2222 w->top_line = (FRAME_MENU_BAR_LINES (f)
2223 + (!NILP (Vtab_bar_position)
2224 ? FRAME_TOOL_BAR_LINES (f) : 0));
2219 w->total_cols = FRAME_TOTAL_COLS (f); 2225 w->total_cols = FRAME_TOTAL_COLS (f);
2220 w->pixel_width = (FRAME_PIXEL_WIDTH (f) 2226 w->pixel_width = (FRAME_PIXEL_WIDTH (f)
2221 - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); 2227 - 2 * FRAME_INTERNAL_BORDER_WIDTH (f));
@@ -3748,6 +3754,14 @@ update_window (struct window *w, bool force_p)
3748 } 3754 }
3749 } 3755 }
3750 3756
3757 /* If the window doesn't display its mode line, make sure the
3758 corresponding row of the current glyph matrix is disabled, so
3759 that if and when the mode line is displayed again, it will be
3760 cleared and completely redrawn. */
3761 if (!window_wants_mode_line (w))
3762 SET_MATRIX_ROW_ENABLED_P (w->current_matrix,
3763 w->current_matrix->nrows - 1, false);
3764
3751 /* Was display preempted? */ 3765 /* Was display preempted? */
3752 paused_p = row < end; 3766 paused_p = row < end;
3753 3767
@@ -6639,8 +6653,8 @@ init_display_interactive (void)
6639 change. It's not clear what better we could do. The rest of 6653 change. It's not clear what better we could do. The rest of
6640 the code assumes that (width + 2) * height * sizeof (struct glyph) 6654 the code assumes that (width + 2) * height * sizeof (struct glyph)
6641 does not overflow and does not exceed PTRDIFF_MAX or SIZE_MAX. */ 6655 does not overflow and does not exceed PTRDIFF_MAX or SIZE_MAX. */
6642 if (INT_ADD_WRAPV (width, 2, &area) 6656 if (ckd_add (&area, width, 2)
6643 || INT_MULTIPLY_WRAPV (height, area, &area) 6657 || ckd_mul (&area, area, height)
6644 || min (PTRDIFF_MAX, SIZE_MAX) / sizeof (struct glyph) < area) 6658 || min (PTRDIFF_MAX, SIZE_MAX) / sizeof (struct glyph) < area)
6645 fatal ("screen size %dx%d too big", width, height); 6659 fatal ("screen size %dx%d too big", width, height);
6646 } 6660 }
diff --git a/src/doprnt.c b/src/doprnt.c
index 3ebb957e9f2..e8911fad252 100644
--- a/src/doprnt.c
+++ b/src/doprnt.c
@@ -134,8 +134,8 @@ parse_format_integer (char const *fmt, int *value)
134 bool overflow = false; 134 bool overflow = false;
135 for (; '0' <= *fmt && *fmt <= '9'; fmt++) 135 for (; '0' <= *fmt && *fmt <= '9'; fmt++)
136 { 136 {
137 overflow |= INT_MULTIPLY_WRAPV (n, 10, &n); 137 overflow |= ckd_mul (&n, n, 10);
138 overflow |= INT_ADD_WRAPV (n, *fmt - '0', &n); 138 overflow |= ckd_add (&n, n, *fmt - '0');
139 } 139 }
140 if (overflow || min (PTRDIFF_MAX, SIZE_MAX) - SIZE_BOUND_EXTRA < n) 140 if (overflow || min (PTRDIFF_MAX, SIZE_MAX) - SIZE_BOUND_EXTRA < n)
141 error ("Format width or precision too large"); 141 error ("Format width or precision too large");
diff --git a/src/editfns.c b/src/editfns.c
index f83c5c7259b..44e11841faa 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2027,8 +2027,8 @@ nil. */)
2027 ptrdiff_t ins_bytes = size_b / CHAR_BIT + 1; 2027 ptrdiff_t ins_bytes = size_b / CHAR_BIT + 1;
2028 ptrdiff_t *buffer; 2028 ptrdiff_t *buffer;
2029 ptrdiff_t bytes_needed; 2029 ptrdiff_t bytes_needed;
2030 if (INT_MULTIPLY_WRAPV (diags, 2 * sizeof *buffer, &bytes_needed) 2030 if (ckd_mul (&bytes_needed, diags, 2 * sizeof *buffer)
2031 || INT_ADD_WRAPV (del_bytes + ins_bytes, bytes_needed, &bytes_needed)) 2031 || ckd_add (&bytes_needed, bytes_needed, del_bytes + ins_bytes))
2032 memory_full (SIZE_MAX); 2032 memory_full (SIZE_MAX);
2033 USE_SAFE_ALLOCA; 2033 USE_SAFE_ALLOCA;
2034 buffer = SAFE_ALLOCA (bytes_needed); 2034 buffer = SAFE_ALLOCA (bytes_needed);
@@ -2653,182 +2653,203 @@ DEFUN ("delete-and-extract-region", Fdelete_and_extract_region,
2653 return del_range_1 (XFIXNUM (start), XFIXNUM (end), 1, 1); 2653 return del_range_1 (XFIXNUM (start), XFIXNUM (end), 1, 1);
2654} 2654}
2655 2655
2656/* Alist of buffers in which locked narrowing is used. The car of 2656/* Alist of buffers in which labeled restrictions are used. The car
2657 each list element is a buffer, the cdr is a list of triplets (tag 2657 of each list element is a buffer, the cdr is a list of triplets
2658 begv-marker zv-marker). The last element of that list always uses 2658 (label begv-marker zv-marker). The last triplet of that list
2659 the (uninterned) Qoutermost_narrowing tag and records the narrowing 2659 always uses the (uninterned) Qoutermost_restriction label, and
2660 bounds that were set by the user and that are visible on display. 2660 records the restriction bounds that were current when the first
2661 This alist is used internally by narrow-to-region, widen, 2661 labeled restriction was entered (which may be a narrowing that was
2662 internal--lock-narrowing, internal--unlock-narrowing and 2662 set by the user and is visible on display). This alist is used
2663 save-restriction. For efficiency reasons, an alist is used instead 2663 internally by narrow-to-region, widen, internal--label-restriction,
2664 of a buffer-local variable: otherwise reset_outermost_narrowings, 2664 internal--unlabel-restriction and save-restriction. For efficiency
2665 which is called during each redisplay cycle, would have to loop 2665 reasons, an alist is used instead of a buffer-local variable:
2666 through all live buffers. */ 2666 otherwise reset_outermost_restrictions, which is called during each
2667static Lisp_Object narrowing_locks; 2667 redisplay cycle, would have to loop through all live buffers. */
2668 2668static Lisp_Object labeled_restrictions;
2669/* Add BUF with its LOCKS in the narrowing_locks alist. */ 2669
2670/* Add BUF with its list of labeled RESTRICTIONS in the
2671 labeled_restrictions alist. */
2670static void 2672static void
2671narrowing_locks_add (Lisp_Object buf, Lisp_Object locks) 2673labeled_restrictions_add (Lisp_Object buf, Lisp_Object restrictions)
2672{ 2674{
2673 narrowing_locks = nconc2 (list1 (list2 (buf, locks)), narrowing_locks); 2675 labeled_restrictions = nconc2 (list1 (list2 (buf, restrictions)),
2676 labeled_restrictions);
2674} 2677}
2675 2678
2676/* Remove BUF and its locks from the narrowing_locks alist. Do 2679/* Remove BUF and its list of labeled restrictions from the
2677 nothing if BUF is not present in narrowing_locks. */ 2680 labeled_restrictions alist. Do nothing if BUF is not present in
2681 labeled_restrictions. */
2678static void 2682static void
2679narrowing_locks_remove (Lisp_Object buf) 2683labeled_restrictions_remove (Lisp_Object buf)
2680{ 2684{
2681 narrowing_locks = Fdelq (Fassoc (buf, narrowing_locks, Qnil), 2685 labeled_restrictions = Fdelq (Fassoc (buf, labeled_restrictions, Qnil),
2682 narrowing_locks); 2686 labeled_restrictions);
2683} 2687}
2684 2688
2685/* Retrieve one of the BEGV/ZV bounds of a narrowing in BUF from the 2689/* Retrieve one of the labeled restriction bounds in BUF from the
2686 narrowing_locks alist, as a pointer to a struct Lisp_Marker, or 2690 labeled_restrictions alist, as a marker, or return nil if BUF is
2687 NULL if BUF is not in narrowing_locks or is a killed buffer. When 2691 not in labeled_restrictions or is a killed buffer. When OUTERMOST
2688 OUTERMOST is true, the bounds that were set by the user and that 2692 is true, the restriction bounds that were current when the first
2689 are visible on display are returned. Otherwise the innermost 2693 labeled restriction was entered are returned. Otherwise the bounds
2690 locked narrowing bounds are returned. */ 2694 of the innermost labeled restriction are returned. */
2691static struct Lisp_Marker * 2695static Lisp_Object
2692narrowing_lock_get_bound (Lisp_Object buf, bool begv, bool outermost) 2696labeled_restrictions_get_bound (Lisp_Object buf, bool begv, bool outermost)
2693{ 2697{
2694 if (NILP (Fbuffer_live_p (buf))) 2698 if (NILP (Fbuffer_live_p (buf)))
2695 return NULL; 2699 return Qnil;
2696 Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks); 2700 Lisp_Object restrictions = assq_no_quit (buf, labeled_restrictions);
2697 if (NILP (buffer_locks)) 2701 if (NILP (restrictions))
2698 return NULL; 2702 return Qnil;
2699 buffer_locks = XCAR (XCDR (buffer_locks)); 2703 restrictions = XCAR (XCDR (restrictions));
2700 Lisp_Object bounds 2704 Lisp_Object bounds
2701 = outermost 2705 = outermost
2702 ? XCDR (assq_no_quit (Qoutermost_narrowing, buffer_locks)) 2706 ? XCDR (assq_no_quit (Qoutermost_restriction, restrictions))
2703 : XCDR (XCAR (buffer_locks)); 2707 : XCDR (XCAR (restrictions));
2704 eassert (! NILP (bounds)); 2708 eassert (! NILP (bounds));
2705 Lisp_Object marker = begv ? XCAR (bounds) : XCAR (XCDR (bounds)); 2709 Lisp_Object marker = begv ? XCAR (bounds) : XCAR (XCDR (bounds));
2706 eassert (EQ (Fmarker_buffer (marker), buf)); 2710 eassert (EQ (Fmarker_buffer (marker), buf));
2707 return XMARKER (marker); 2711 return marker;
2708} 2712}
2709 2713
2710/* Retrieve the tag of the innermost narrowing in BUF. Return nil if 2714/* Retrieve the label of the innermost labeled restriction in BUF.
2711 BUF is not in narrowing_locks or is a killed buffer. */ 2715 Return nil if BUF is not in labeled_restrictions or is a killed
2716 buffer. */
2712static Lisp_Object 2717static Lisp_Object
2713narrowing_lock_peek_tag (Lisp_Object buf) 2718labeled_restrictions_peek_label (Lisp_Object buf)
2714{ 2719{
2715 if (NILP (Fbuffer_live_p (buf))) 2720 if (NILP (Fbuffer_live_p (buf)))
2716 return Qnil; 2721 return Qnil;
2717 Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks); 2722 Lisp_Object restrictions = assq_no_quit (buf, labeled_restrictions);
2718 if (NILP (buffer_locks)) 2723 if (NILP (restrictions))
2719 return Qnil; 2724 return Qnil;
2720 Lisp_Object tag = XCAR (XCAR (XCAR (XCDR (buffer_locks)))); 2725 Lisp_Object label = XCAR (XCAR (XCAR (XCDR (restrictions))));
2721 eassert (! NILP (tag)); 2726 eassert (! NILP (label));
2722 return tag; 2727 return label;
2723} 2728}
2724 2729
2725/* Add a LOCK for BUF in the narrowing_locks alist. */ 2730/* Add a labeled RESTRICTION for BUF in the labeled_restrictions
2731 alist. */
2726static void 2732static void
2727narrowing_lock_push (Lisp_Object buf, Lisp_Object lock) 2733labeled_restrictions_push (Lisp_Object buf, Lisp_Object restriction)
2728{ 2734{
2729 Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks); 2735 Lisp_Object restrictions = assq_no_quit (buf, labeled_restrictions);
2730 if (NILP (buffer_locks)) 2736 if (NILP (restrictions))
2731 narrowing_locks_add (buf, list1 (lock)); 2737 labeled_restrictions_add (buf, list1 (restriction));
2732 else 2738 else
2733 XSETCDR (buffer_locks, list1 (nconc2 (list1 (lock), 2739 XSETCDR (restrictions, list1 (nconc2 (list1 (restriction),
2734 XCAR (XCDR (buffer_locks))))); 2740 XCAR (XCDR (restrictions)))));
2735} 2741}
2736 2742
2737/* Remove the innermost lock in BUF from the narrowing_locks alist. 2743/* Remove the innermost labeled restriction in BUF from the
2738 Do nothing if BUF is not present in narrowing_locks. */ 2744 labeled_restrictions alist. Do nothing if BUF is not present in
2745 labeled_restrictions. */
2739static void 2746static void
2740narrowing_lock_pop (Lisp_Object buf) 2747labeled_restrictions_pop (Lisp_Object buf)
2741{ 2748{
2742 Lisp_Object buffer_locks = assq_no_quit (buf, narrowing_locks); 2749 Lisp_Object restrictions = assq_no_quit (buf, labeled_restrictions);
2743 if (NILP (buffer_locks)) 2750 if (NILP (restrictions))
2744 return; 2751 return;
2745 if (EQ (narrowing_lock_peek_tag (buf), Qoutermost_narrowing)) 2752 if (EQ (labeled_restrictions_peek_label (buf), Qoutermost_restriction))
2746 narrowing_locks_remove (buf); 2753 labeled_restrictions_remove (buf);
2747 else 2754 else
2748 XSETCDR (buffer_locks, list1 (XCDR (XCAR (XCDR (buffer_locks))))); 2755 XSETCDR (restrictions, list1 (XCDR (XCAR (XCDR (restrictions)))));
2756}
2757
2758/* Unconditionally remove all labeled restrictions in current_buffer. */
2759void
2760labeled_restrictions_remove_in_current_buffer (void)
2761{
2762 labeled_restrictions_remove (Fcurrent_buffer ());
2749} 2763}
2750 2764
2751static void 2765static void
2752unwind_reset_outermost_narrowing (Lisp_Object buf) 2766unwind_reset_outermost_restriction (Lisp_Object buf)
2753{ 2767{
2754 struct Lisp_Marker *begv = narrowing_lock_get_bound (buf, true, false); 2768 Lisp_Object begv = labeled_restrictions_get_bound (buf, true, false);
2755 struct Lisp_Marker *zv = narrowing_lock_get_bound (buf, false, false); 2769 Lisp_Object zv = labeled_restrictions_get_bound (buf, false, false);
2756 if (begv != NULL && zv != NULL) 2770 if (! NILP (begv) && ! NILP (zv))
2757 { 2771 {
2758 SET_BUF_BEGV_BOTH (XBUFFER (buf), begv->charpos, begv->bytepos); 2772 SET_BUF_BEGV_BOTH (XBUFFER (buf),
2759 SET_BUF_ZV_BOTH (XBUFFER (buf), zv->charpos, zv->bytepos); 2773 marker_position (begv), marker_byte_position (begv));
2774 SET_BUF_ZV_BOTH (XBUFFER (buf),
2775 marker_position (zv), marker_byte_position (zv));
2760 } 2776 }
2761 else 2777 else
2762 narrowing_locks_remove (buf); 2778 labeled_restrictions_remove (buf);
2763} 2779}
2764 2780
2765/* Restore the narrowing bounds that were set by the user, and restore 2781/* Restore the restriction bounds that were current when the first
2766 the bounds of the locked narrowing upon return. 2782 labeled restriction was entered, and restore the bounds of the
2783 innermost labeled restriction upon return.
2767 In particular, this function is called when redisplay starts, so 2784 In particular, this function is called when redisplay starts, so
2768 that if a Lisp function executed during redisplay calls (redisplay) 2785 that if a Lisp function executed during redisplay calls (redisplay)
2769 while a locked narrowing is in effect, the locked narrowing will 2786 while labeled restrictions are in effect, these restrictions will
2770 not be visible on display. 2787 not become visible on display.
2771 See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=57207#140 and 2788 See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=57207#140 and
2772 https://debbugs.gnu.org/cgi/bugreport.cgi?bug=57207#254 for example 2789 https://debbugs.gnu.org/cgi/bugreport.cgi?bug=57207#254 for example
2773 recipes that demonstrate why this is necessary. */ 2790 recipes that demonstrate why this is necessary. */
2774void 2791void
2775reset_outermost_narrowings (void) 2792reset_outermost_restrictions (void)
2776{ 2793{
2777 Lisp_Object val, buf; 2794 Lisp_Object val, buf;
2778 for (val = narrowing_locks; CONSP (val); val = XCDR (val)) 2795 for (val = labeled_restrictions; CONSP (val); val = XCDR (val))
2779 { 2796 {
2780 buf = XCAR (XCAR (val)); 2797 buf = XCAR (XCAR (val));
2781 eassert (BUFFERP (buf)); 2798 eassert (BUFFERP (buf));
2782 struct Lisp_Marker *begv = narrowing_lock_get_bound (buf, true, true); 2799 Lisp_Object begv = labeled_restrictions_get_bound (buf, true, true);
2783 struct Lisp_Marker *zv = narrowing_lock_get_bound (buf, false, true); 2800 Lisp_Object zv = labeled_restrictions_get_bound (buf, false, true);
2784 if (begv != NULL && zv != NULL) 2801 if (! NILP (begv) && ! NILP (zv))
2785 { 2802 {
2786 SET_BUF_BEGV_BOTH (XBUFFER (buf), begv->charpos, begv->bytepos); 2803 SET_BUF_BEGV_BOTH (XBUFFER (buf),
2787 SET_BUF_ZV_BOTH (XBUFFER (buf), zv->charpos, zv->bytepos); 2804 marker_position (begv), marker_byte_position (begv));
2788 record_unwind_protect (unwind_reset_outermost_narrowing, buf); 2805 SET_BUF_ZV_BOTH (XBUFFER (buf),
2806 marker_position (zv), marker_byte_position (zv));
2807 record_unwind_protect (unwind_reset_outermost_restriction, buf);
2789 } 2808 }
2790 else 2809 else
2791 narrowing_locks_remove (buf); 2810 labeled_restrictions_remove (buf);
2792 } 2811 }
2793} 2812}
2794 2813
2795/* Helper functions to save and restore the narrowing locks of the 2814/* Helper functions to save and restore the labeled restrictions of
2796 current buffer in Fsave_restriction. */ 2815 the current buffer in Fsave_restriction. */
2797static Lisp_Object 2816static Lisp_Object
2798narrowing_locks_save (void) 2817labeled_restrictions_save (void)
2799{ 2818{
2800 Lisp_Object buf = Fcurrent_buffer (); 2819 Lisp_Object buf = Fcurrent_buffer ();
2801 Lisp_Object locks = assq_no_quit (buf, narrowing_locks); 2820 Lisp_Object restrictions = assq_no_quit (buf, labeled_restrictions);
2802 if (!NILP (locks)) 2821 if (! NILP (restrictions))
2803 locks = XCAR (XCDR (locks)); 2822 restrictions = XCAR (XCDR (restrictions));
2804 return Fcons (buf, Fcopy_sequence (locks)); 2823 return Fcons (buf, Fcopy_sequence (restrictions));
2805} 2824}
2806 2825
2807static void 2826static void
2808narrowing_locks_restore (Lisp_Object buf_and_saved_locks) 2827labeled_restrictions_restore (Lisp_Object buf_and_restrictions)
2809{ 2828{
2810 Lisp_Object buf = XCAR (buf_and_saved_locks); 2829 Lisp_Object buf = XCAR (buf_and_restrictions);
2811 Lisp_Object saved_locks = XCDR (buf_and_saved_locks); 2830 Lisp_Object restrictions = XCDR (buf_and_restrictions);
2812 narrowing_locks_remove (buf); 2831 labeled_restrictions_remove (buf);
2813 if (!NILP (saved_locks)) 2832 if (! NILP (restrictions))
2814 narrowing_locks_add (buf, saved_locks); 2833 labeled_restrictions_add (buf, restrictions);
2815} 2834}
2816 2835
2817static void 2836static void
2818unwind_narrow_to_region_locked (Lisp_Object tag) 2837unwind_labeled_narrow_to_region (Lisp_Object label)
2819{ 2838{
2820 Finternal__unlock_narrowing (tag); 2839 Finternal__unlabel_restriction (label);
2821 Fwiden (); 2840 Fwiden ();
2822} 2841}
2823 2842
2824/* Narrow current_buffer to BEGV-ZV with a narrowing locked with TAG. */ 2843/* Narrow current_buffer to BEGV-ZV with a restriction labeled with
2844 LABEL. */
2825void 2845void
2826narrow_to_region_locked (Lisp_Object begv, Lisp_Object zv, Lisp_Object tag) 2846labeled_narrow_to_region (Lisp_Object begv, Lisp_Object zv,
2847 Lisp_Object label)
2827{ 2848{
2828 Fnarrow_to_region (begv, zv); 2849 Fnarrow_to_region (begv, zv);
2829 Finternal__lock_narrowing (tag); 2850 Finternal__label_restriction (label);
2830 record_unwind_protect (restore_point_unwind, Fpoint_marker ()); 2851 record_unwind_protect (restore_point_unwind, Fpoint_marker ());
2831 record_unwind_protect (unwind_narrow_to_region_locked, tag); 2852 record_unwind_protect (unwind_labeled_narrow_to_region, label);
2832} 2853}
2833 2854
2834DEFUN ("widen", Fwiden, Swiden, 0, 0, "", 2855DEFUN ("widen", Fwiden, Swiden, 0, 0, "",
@@ -2842,11 +2863,11 @@ To gain access to other portions of the buffer, use
2842`without-restriction' with the same label. */) 2863`without-restriction' with the same label. */)
2843 (void) 2864 (void)
2844{ 2865{
2845 Fset (Qoutermost_narrowing, Qnil); 2866 Fset (Qoutermost_restriction, Qnil);
2846 Lisp_Object buf = Fcurrent_buffer (); 2867 Lisp_Object buf = Fcurrent_buffer ();
2847 Lisp_Object tag = narrowing_lock_peek_tag (buf); 2868 Lisp_Object label = labeled_restrictions_peek_label (buf);
2848 2869
2849 if (NILP (tag)) 2870 if (NILP (label))
2850 { 2871 {
2851 if (BEG != BEGV || Z != ZV) 2872 if (BEG != BEGV || Z != ZV)
2852 current_buffer->clip_changed = 1; 2873 current_buffer->clip_changed = 1;
@@ -2856,19 +2877,23 @@ To gain access to other portions of the buffer, use
2856 } 2877 }
2857 else 2878 else
2858 { 2879 {
2859 struct Lisp_Marker *begv = narrowing_lock_get_bound (buf, true, false); 2880 Lisp_Object begv = labeled_restrictions_get_bound (buf, true, false);
2860 struct Lisp_Marker *zv = narrowing_lock_get_bound (buf, false, false); 2881 Lisp_Object zv = labeled_restrictions_get_bound (buf, false, false);
2861 eassert (begv != NULL && zv != NULL); 2882 eassert (! NILP (begv) && ! NILP (zv));
2862 if (begv->charpos != BEGV || zv->charpos != ZV) 2883 ptrdiff_t begv_charpos = marker_position (begv);
2884 ptrdiff_t zv_charpos = marker_position (zv);
2885 if (begv_charpos != BEGV || zv_charpos != ZV)
2863 current_buffer->clip_changed = 1; 2886 current_buffer->clip_changed = 1;
2864 SET_BUF_BEGV_BOTH (current_buffer, begv->charpos, begv->bytepos); 2887 SET_BUF_BEGV_BOTH (current_buffer,
2865 SET_BUF_ZV_BOTH (current_buffer, zv->charpos, zv->bytepos); 2888 begv_charpos, marker_byte_position (begv));
2866 /* If the only remaining bounds in narrowing_locks for 2889 SET_BUF_ZV_BOTH (current_buffer,
2890 zv_charpos, marker_byte_position (zv));
2891 /* If the only remaining bounds in labeled_restrictions for
2867 current_buffer are the bounds that were set by the user, no 2892 current_buffer are the bounds that were set by the user, no
2868 locked narrowing is in effect in current_buffer anymore: 2893 labeled restriction is in effect in current_buffer anymore:
2869 remove it from the narrowing_locks alist. */ 2894 remove it from the labeled_restrictions alist. */
2870 if (EQ (tag, Qoutermost_narrowing)) 2895 if (EQ (label, Qoutermost_restriction))
2871 narrowing_lock_pop (buf); 2896 labeled_restrictions_pop (buf);
2872 } 2897 }
2873 /* Changing the buffer bounds invalidates any recorded current column. */ 2898 /* Changing the buffer bounds invalidates any recorded current column. */
2874 invalidate_current_column (); 2899 invalidate_current_column ();
@@ -2905,25 +2930,27 @@ argument. To gain access to other portions of the buffer, use
2905 args_out_of_range (start, end); 2930 args_out_of_range (start, end);
2906 2931
2907 Lisp_Object buf = Fcurrent_buffer (); 2932 Lisp_Object buf = Fcurrent_buffer ();
2908 if (! NILP (narrowing_lock_peek_tag (buf))) 2933 if (! NILP (labeled_restrictions_peek_label (buf)))
2909 { 2934 {
2910 struct Lisp_Marker *begv = narrowing_lock_get_bound (buf, true, false); 2935 /* Limit the start and end positions to those of the innermost
2911 struct Lisp_Marker *zv = narrowing_lock_get_bound (buf, false, false); 2936 labeled restriction. */
2912 eassert (begv != NULL && zv != NULL); 2937 Lisp_Object begv = labeled_restrictions_get_bound (buf, true, false);
2913 /* Limit the start and end positions to those of the locked 2938 Lisp_Object zv = labeled_restrictions_get_bound (buf, false, false);
2914 narrowing. */ 2939 eassert (! NILP (begv) && ! NILP (zv));
2915 if (s < begv->charpos) s = begv->charpos; 2940 ptrdiff_t begv_charpos = marker_position (begv);
2916 if (s > zv->charpos) s = zv->charpos; 2941 ptrdiff_t zv_charpos = marker_position (zv);
2917 if (e < begv->charpos) e = begv->charpos; 2942 if (s < begv_charpos) s = begv_charpos;
2918 if (e > zv->charpos) e = zv->charpos; 2943 if (s > zv_charpos) s = zv_charpos;
2944 if (e < begv_charpos) e = begv_charpos;
2945 if (e > zv_charpos) e = zv_charpos;
2919 } 2946 }
2920 2947
2921 /* Record the accessible range of the buffer when narrow-to-region 2948 /* Record the accessible range of the buffer when narrow-to-region
2922 is called, that is, before applying the narrowing. It is used 2949 is called, that is, before applying the narrowing. That
2923 only by internal--lock-narrowing. */ 2950 information is used only by internal--label-restriction. */
2924 Fset (Qoutermost_narrowing, list3 (Qoutermost_narrowing, 2951 Fset (Qoutermost_restriction, list3 (Qoutermost_restriction,
2925 Fpoint_min_marker (), 2952 Fpoint_min_marker (),
2926 Fpoint_max_marker ())); 2953 Fpoint_max_marker ()));
2927 2954
2928 if (BEGV != s || ZV != e) 2955 if (BEGV != s || ZV != e)
2929 current_buffer->clip_changed = 1; 2956 current_buffer->clip_changed = 1;
@@ -2940,38 +2967,38 @@ argument. To gain access to other portions of the buffer, use
2940 return Qnil; 2967 return Qnil;
2941} 2968}
2942 2969
2943DEFUN ("internal--lock-narrowing", Finternal__lock_narrowing, 2970DEFUN ("internal--label-restriction", Finternal__label_restriction,
2944 Sinternal__lock_narrowing, 1, 1, 0, 2971 Sinternal__label_restriction, 1, 1, 0,
2945 doc: /* Lock the current narrowing with LABEL. 2972 doc: /* Label the current restriction with LABEL.
2946 2973
2947This is an internal function used by `with-restriction'. */) 2974This is an internal function used by `with-restriction'. */)
2948 (Lisp_Object tag) 2975 (Lisp_Object label)
2949{ 2976{
2950 Lisp_Object buf = Fcurrent_buffer (); 2977 Lisp_Object buf = Fcurrent_buffer ();
2951 Lisp_Object outermost_narrowing 2978 Lisp_Object outermost_restriction
2952 = buffer_local_value (Qoutermost_narrowing, buf); 2979 = buffer_local_value (Qoutermost_restriction, buf);
2953 /* If internal--lock-narrowing is ever called without being preceded 2980 /* If internal--label-restriction is ever called without being
2954 by narrow-to-region, do nothing. */ 2981 preceded by narrow-to-region, do nothing. */
2955 if (NILP (outermost_narrowing)) 2982 if (NILP (outermost_restriction))
2956 return Qnil; 2983 return Qnil;
2957 if (NILP (narrowing_lock_peek_tag (buf))) 2984 if (NILP (labeled_restrictions_peek_label (buf)))
2958 narrowing_lock_push (buf, outermost_narrowing); 2985 labeled_restrictions_push (buf, outermost_restriction);
2959 narrowing_lock_push (buf, list3 (tag, 2986 labeled_restrictions_push (buf, list3 (label,
2960 Fpoint_min_marker (), 2987 Fpoint_min_marker (),
2961 Fpoint_max_marker ())); 2988 Fpoint_max_marker ()));
2962 return Qnil; 2989 return Qnil;
2963} 2990}
2964 2991
2965DEFUN ("internal--unlock-narrowing", Finternal__unlock_narrowing, 2992DEFUN ("internal--unlabel-restriction", Finternal__unlabel_restriction,
2966 Sinternal__unlock_narrowing, 1, 1, 0, 2993 Sinternal__unlabel_restriction, 1, 1, 0,
2967 doc: /* Unlock a narrowing locked with LABEL. 2994 doc: /* If the current restriction is labeled with LABEL, remove its label.
2968 2995
2969This is an internal function used by `without-restriction'. */) 2996This is an internal function used by `without-restriction'. */)
2970 (Lisp_Object tag) 2997 (Lisp_Object label)
2971{ 2998{
2972 Lisp_Object buf = Fcurrent_buffer (); 2999 Lisp_Object buf = Fcurrent_buffer ();
2973 if (EQ (narrowing_lock_peek_tag (buf), tag)) 3000 if (EQ (labeled_restrictions_peek_label (buf), label))
2974 narrowing_lock_pop (buf); 3001 labeled_restrictions_pop (buf);
2975 return Qnil; 3002 return Qnil;
2976} 3003}
2977 3004
@@ -3071,15 +3098,15 @@ save_restriction_restore_1 (Lisp_Object data)
3071Lisp_Object 3098Lisp_Object
3072save_restriction_save (void) 3099save_restriction_save (void)
3073{ 3100{
3074 Lisp_Object restr = save_restriction_save_1 (); 3101 Lisp_Object restriction = save_restriction_save_1 ();
3075 Lisp_Object locks = narrowing_locks_save (); 3102 Lisp_Object labeled_restrictions = labeled_restrictions_save ();
3076 return Fcons (restr, locks); 3103 return Fcons (restriction, labeled_restrictions);
3077} 3104}
3078 3105
3079void 3106void
3080save_restriction_restore (Lisp_Object data) 3107save_restriction_restore (Lisp_Object data)
3081{ 3108{
3082 narrowing_locks_restore (XCDR (data)); 3109 labeled_restrictions_restore (XCDR (data));
3083 save_restriction_restore_1 (XCAR (data)); 3110 save_restriction_restore_1 (XCAR (data));
3084} 3111}
3085 3112
@@ -3269,7 +3296,7 @@ str2num (char *str, char **str_end)
3269{ 3296{
3270 ptrdiff_t n = 0; 3297 ptrdiff_t n = 0;
3271 for (; c_isdigit (*str); str++) 3298 for (; c_isdigit (*str); str++)
3272 if (INT_MULTIPLY_WRAPV (n, 10, &n) || INT_ADD_WRAPV (n, *str - '0', &n)) 3299 if (ckd_mul (&n, n, 10) || ckd_add (&n, n, *str - '0'))
3273 n = PTRDIFF_MAX; 3300 n = PTRDIFF_MAX;
3274 *str_end = str; 3301 *str_end = str;
3275 return n; 3302 return n;
@@ -3437,8 +3464,8 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
3437 3464
3438 /* Allocate the info and discarded tables. */ 3465 /* Allocate the info and discarded tables. */
3439 ptrdiff_t info_size, alloca_size; 3466 ptrdiff_t info_size, alloca_size;
3440 if (INT_MULTIPLY_WRAPV (nspec_bound, sizeof *info, &info_size) 3467 if (ckd_mul (&info_size, nspec_bound, sizeof *info)
3441 || INT_ADD_WRAPV (formatlen, info_size, &alloca_size) 3468 || ckd_add (&alloca_size, formatlen, info_size)
3442 || SIZE_MAX < alloca_size) 3469 || SIZE_MAX < alloca_size)
3443 memory_full (SIZE_MAX); 3470 memory_full (SIZE_MAX);
3444 info = SAFE_ALLOCA (alloca_size); 3471 info = SAFE_ALLOCA (alloca_size);
@@ -3985,8 +4012,8 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
3985 /* Compute the total bytes needed for this item, including 4012 /* Compute the total bytes needed for this item, including
3986 excess precision and padding. */ 4013 excess precision and padding. */
3987 ptrdiff_t numwidth; 4014 ptrdiff_t numwidth;
3988 if (INT_ADD_WRAPV (prefixlen + sprintf_bytes, excess_precision, 4015 if (ckd_add (&numwidth, prefixlen + sprintf_bytes,
3989 &numwidth)) 4016 excess_precision))
3990 numwidth = PTRDIFF_MAX; 4017 numwidth = PTRDIFF_MAX;
3991 ptrdiff_t padding 4018 ptrdiff_t padding
3992 = numwidth < field_width ? field_width - numwidth : 0; 4019 = numwidth < field_width ? field_width - numwidth : 0;
@@ -4146,7 +4173,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
4146 4173
4147 ptrdiff_t used = p - buf; 4174 ptrdiff_t used = p - buf;
4148 ptrdiff_t buflen_needed; 4175 ptrdiff_t buflen_needed;
4149 if (INT_ADD_WRAPV (used, convbytes, &buflen_needed)) 4176 if (ckd_add (&buflen_needed, used, convbytes))
4150 string_overflow (); 4177 string_overflow ();
4151 if (bufsize <= buflen_needed) 4178 if (bufsize <= buflen_needed)
4152 { 4179 {
@@ -4748,7 +4775,7 @@ syms_of_editfns (void)
4748 DEFSYM (Qwall, "wall"); 4775 DEFSYM (Qwall, "wall");
4749 DEFSYM (Qpropertize, "propertize"); 4776 DEFSYM (Qpropertize, "propertize");
4750 4777
4751 staticpro (&narrowing_locks); 4778 staticpro (&labeled_restrictions);
4752 4779
4753 DEFVAR_LISP ("inhibit-field-text-motion", Vinhibit_field_text_motion, 4780 DEFVAR_LISP ("inhibit-field-text-motion", Vinhibit_field_text_motion,
4754 doc: /* Non-nil means text motion commands don't notice fields. */); 4781 doc: /* Non-nil means text motion commands don't notice fields. */);
@@ -4809,12 +4836,12 @@ This variable is experimental; email 32252@debbugs.gnu.org if you need
4809it to be non-nil. */); 4836it to be non-nil. */);
4810 binary_as_unsigned = false; 4837 binary_as_unsigned = false;
4811 4838
4812 DEFVAR_LISP ("outermost-narrowing", Voutermost_narrowing, 4839 DEFVAR_LISP ("outermost-restriction", Voutermost_restriction,
4813 doc: /* Outermost narrowing bounds, if any. Internal use only. */); 4840 doc: /* Outermost narrowing bounds, if any. Internal use only. */);
4814 Voutermost_narrowing = Qnil; 4841 Voutermost_restriction = Qnil;
4815 Fmake_variable_buffer_local (Qoutermost_narrowing); 4842 Fmake_variable_buffer_local (Qoutermost_restriction);
4816 DEFSYM (Qoutermost_narrowing, "outermost-narrowing"); 4843 DEFSYM (Qoutermost_restriction, "outermost-restriction");
4817 Funintern (Qoutermost_narrowing, Qnil); 4844 Funintern (Qoutermost_restriction, Qnil);
4818 4845
4819 defsubr (&Spropertize); 4846 defsubr (&Spropertize);
4820 defsubr (&Schar_equal); 4847 defsubr (&Schar_equal);
@@ -4907,8 +4934,8 @@ it to be non-nil. */);
4907 defsubr (&Sdelete_and_extract_region); 4934 defsubr (&Sdelete_and_extract_region);
4908 defsubr (&Swiden); 4935 defsubr (&Swiden);
4909 defsubr (&Snarrow_to_region); 4936 defsubr (&Snarrow_to_region);
4910 defsubr (&Sinternal__lock_narrowing); 4937 defsubr (&Sinternal__label_restriction);
4911 defsubr (&Sinternal__unlock_narrowing); 4938 defsubr (&Sinternal__unlabel_restriction);
4912 defsubr (&Ssave_restriction); 4939 defsubr (&Ssave_restriction);
4913 defsubr (&Stranspose_regions); 4940 defsubr (&Stranspose_regions);
4914} 4941}
diff --git a/src/emacs-module.c b/src/emacs-module.c
index d158e243139..10699ec25d9 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -416,7 +416,7 @@ module_global_reference_p (emacs_value v, ptrdiff_t *n)
416 } 416 }
417 /* Only used for debugging, so we don't care about overflow, just 417 /* Only used for debugging, so we don't care about overflow, just
418 make sure the operation is defined. */ 418 make sure the operation is defined. */
419 INT_ADD_WRAPV (*n, h->count, n); 419 ckd_add (n, *n, h->count);
420 return false; 420 return false;
421} 421}
422 422
@@ -435,7 +435,7 @@ module_make_global_ref (emacs_env *env, emacs_value value)
435 { 435 {
436 Lisp_Object value = HASH_VALUE (h, i); 436 Lisp_Object value = HASH_VALUE (h, i);
437 struct module_global_reference *ref = XMODULE_GLOBAL_REFERENCE (value); 437 struct module_global_reference *ref = XMODULE_GLOBAL_REFERENCE (value);
438 bool overflow = INT_ADD_WRAPV (ref->refcount, 1, &ref->refcount); 438 bool overflow = ckd_add (&ref->refcount, ref->refcount, 1);
439 if (overflow) 439 if (overflow)
440 overflow_error (); 440 overflow_error ();
441 return &ref->value; 441 return &ref->value;
@@ -662,7 +662,7 @@ module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs,
662 Lisp_Object *newargs; 662 Lisp_Object *newargs;
663 USE_SAFE_ALLOCA; 663 USE_SAFE_ALLOCA;
664 ptrdiff_t nargs1; 664 ptrdiff_t nargs1;
665 if (INT_ADD_WRAPV (nargs, 1, &nargs1)) 665 if (ckd_add (&nargs1, nargs, 1))
666 overflow_error (); 666 overflow_error ();
667 SAFE_ALLOCA_LISP (newargs, nargs1); 667 SAFE_ALLOCA_LISP (newargs, nargs1);
668 newargs[0] = value_to_lisp (func); 668 newargs[0] = value_to_lisp (func);
diff --git a/src/emacs.c b/src/emacs.c
index 282e2f48100..80a013b68df 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1954,7 +1954,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
1954 /* Do less garbage collection in batch mode (since these tend to be 1954 /* Do less garbage collection in batch mode (since these tend to be
1955 more short-lived, and the memory is returned to the OS on exit 1955 more short-lived, and the memory is returned to the OS on exit
1956 anyway). */ 1956 anyway). */
1957 Vgc_cons_percentage = make_float (noninteractive? 1.0: 0.1); 1957 Vgc_cons_percentage = make_float (noninteractive && initialized ? 1.0 : 0.1);
1958 1958
1959 no_loadup 1959 no_loadup
1960 = argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args); 1960 = argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args);
diff --git a/src/eval.c b/src/eval.c
index eb40c953f96..3f4e77cd3b1 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -254,7 +254,7 @@ init_eval (void)
254static void 254static void
255max_ensure_room (intmax_t *m, intmax_t a, intmax_t b) 255max_ensure_room (intmax_t *m, intmax_t a, intmax_t b)
256{ 256{
257 intmax_t sum = INT_ADD_WRAPV (a, b, &sum) ? INTMAX_MAX : sum; 257 intmax_t sum = ckd_add (&sum, a, b) ? INTMAX_MAX : sum;
258 *m = max (*m, sum); 258 *m = max (*m, sum);
259} 259}
260 260
@@ -571,11 +571,12 @@ omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
571or of the variable at the end of the chain of aliases, if BASE-VARIABLE is 571or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
572itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not, 572itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
573then the value of BASE-VARIABLE is set to that of NEW-ALIAS. 573then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
574The return value is BASE-VARIABLE. */) 574The return value is BASE-VARIABLE.
575
576If the resulting chain of variable definitions would contain a loop,
577signal a `cyclic-variable-indirection' error. */)
575 (Lisp_Object new_alias, Lisp_Object base_variable, Lisp_Object docstring) 578 (Lisp_Object new_alias, Lisp_Object base_variable, Lisp_Object docstring)
576{ 579{
577 struct Lisp_Symbol *sym;
578
579 CHECK_SYMBOL (new_alias); 580 CHECK_SYMBOL (new_alias);
580 CHECK_SYMBOL (base_variable); 581 CHECK_SYMBOL (base_variable);
581 582
@@ -584,7 +585,18 @@ The return value is BASE-VARIABLE. */)
584 error ("Cannot make a constant an alias: %s", 585 error ("Cannot make a constant an alias: %s",
585 SDATA (SYMBOL_NAME (new_alias))); 586 SDATA (SYMBOL_NAME (new_alias)));
586 587
587 sym = XSYMBOL (new_alias); 588 struct Lisp_Symbol *sym = XSYMBOL (new_alias);
589
590 /* Ensure non-circularity. */
591 struct Lisp_Symbol *s = XSYMBOL (base_variable);
592 for (;;)
593 {
594 if (s == sym)
595 xsignal1 (Qcyclic_variable_indirection, base_variable);
596 if (s->u.s.redirect != SYMBOL_VARALIAS)
597 break;
598 s = SYMBOL_ALIAS (s);
599 }
588 600
589 switch (sym->u.s.redirect) 601 switch (sym->u.s.redirect)
590 { 602 {
@@ -2373,8 +2385,7 @@ grow_specpdl_allocation (void)
2373 union specbinding *pdlvec = specpdl - 1; 2385 union specbinding *pdlvec = specpdl - 1;
2374 ptrdiff_t size = specpdl_end - specpdl; 2386 ptrdiff_t size = specpdl_end - specpdl;
2375 ptrdiff_t pdlvecsize = size + 1; 2387 ptrdiff_t pdlvecsize = size + 1;
2376 if (max_size <= size) 2388 eassert (max_size > size);
2377 xsignal0 (Qexcessive_variable_binding); /* Can't happen, essentially. */
2378 pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); 2389 pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl);
2379 specpdl = pdlvec + 1; 2390 specpdl = pdlvec + 1;
2380 specpdl_end = specpdl + pdlvecsize - 1; 2391 specpdl_end = specpdl + pdlvecsize - 1;
@@ -3400,7 +3411,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
3400 return object; 3411 return object;
3401} 3412}
3402 3413
3403/* Return true if SYMBOL currently has a let-binding 3414/* Return true if SYMBOL's default currently has a let-binding
3404 which was made in the buffer that is now current. */ 3415 which was made in the buffer that is now current. */
3405 3416
3406bool 3417bool
@@ -3415,6 +3426,7 @@ let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
3415 struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p)); 3426 struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p));
3416 eassert (let_bound_symbol->u.s.redirect != SYMBOL_VARALIAS); 3427 eassert (let_bound_symbol->u.s.redirect != SYMBOL_VARALIAS);
3417 if (symbol == let_bound_symbol 3428 if (symbol == let_bound_symbol
3429 && p->kind != SPECPDL_LET_LOCAL /* bug#62419 */
3418 && EQ (specpdl_where (p), buf)) 3430 && EQ (specpdl_where (p), buf))
3419 return 1; 3431 return 1;
3420 } 3432 }
@@ -3476,7 +3488,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3476 switch (sym->u.s.redirect) 3488 switch (sym->u.s.redirect)
3477 { 3489 {
3478 case SYMBOL_VARALIAS: 3490 case SYMBOL_VARALIAS:
3479 sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start; 3491 sym = SYMBOL_ALIAS (sym); XSETSYMBOL (symbol, sym); goto start;
3480 case SYMBOL_PLAINVAL: 3492 case SYMBOL_PLAINVAL:
3481 /* The most common case is that of a non-constant symbol with a 3493 /* The most common case is that of a non-constant symbol with a
3482 trivial value. Make that as fast as we can. */ 3494 trivial value. Make that as fast as we can. */
diff --git a/src/fileio.c b/src/fileio.c
index b80f8d61de4..859cf57d249 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -5246,6 +5246,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
5246 } 5246 }
5247 5247
5248 record_unwind_protect (save_restriction_restore, save_restriction_save ()); 5248 record_unwind_protect (save_restriction_restore, save_restriction_save ());
5249 labeled_restrictions_remove_in_current_buffer ();
5249 5250
5250 /* Special kludge to simplify auto-saving. */ 5251 /* Special kludge to simplify auto-saving. */
5251 if (NILP (start)) 5252 if (NILP (start))
@@ -6275,7 +6276,7 @@ static Lisp_Object
6275blocks_to_bytes (uintmax_t blocksize, uintmax_t blocks, bool negate) 6276blocks_to_bytes (uintmax_t blocksize, uintmax_t blocks, bool negate)
6276{ 6277{
6277 intmax_t n; 6278 intmax_t n;
6278 if (!INT_MULTIPLY_WRAPV (blocksize, blocks, &n)) 6279 if (!ckd_mul (&n, blocksize, blocks))
6279 return make_int (negate ? -n : n); 6280 return make_int (negate ? -n : n);
6280 Lisp_Object bs = make_uint (blocksize); 6281 Lisp_Object bs = make_uint (blocksize);
6281 if (negate) 6282 if (negate)
diff --git a/src/floatfns.c b/src/floatfns.c
index 13f0ca3e129..e40364f8188 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -55,8 +55,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
55 55
56#include <math.h> 56#include <math.h>
57 57
58#include <count-leading-zeros.h>
59
60/* Emacs needs proper handling of +/-inf; correct printing as well as 58/* Emacs needs proper handling of +/-inf; correct printing as well as
61 important packages depend on it. Make sure the user didn't specify 59 important packages depend on it. Make sure the user didn't specify
62 -ffinite-math-only, either directly or implicitly with -Ofast or 60 -ffinite-math-only, either directly or implicitly with -Ofast or
@@ -304,14 +302,6 @@ DEFUN ("float", Ffloat, Sfloat, 1, 1, 0,
304 return FLOATP (arg) ? arg : make_float (XFLOATINT (arg)); 302 return FLOATP (arg) ? arg : make_float (XFLOATINT (arg));
305} 303}
306 304
307static int
308ecount_leading_zeros (EMACS_UINT x)
309{
310 return (EMACS_UINT_WIDTH == UINT_WIDTH ? count_leading_zeros (x)
311 : EMACS_UINT_WIDTH == ULONG_WIDTH ? count_leading_zeros_l (x)
312 : count_leading_zeros_ll (x));
313}
314
315DEFUN ("logb", Flogb, Slogb, 1, 1, 0, 305DEFUN ("logb", Flogb, Slogb, 1, 1, 0,
316 doc: /* Returns largest integer <= the base 2 log of the magnitude of ARG. 306 doc: /* Returns largest integer <= the base 2 log of the magnitude of ARG.
317This is the same as the exponent of a float. */) 307This is the same as the exponent of a float. */)
@@ -338,7 +328,7 @@ This is the same as the exponent of a float. */)
338 EMACS_INT i = XFIXNUM (arg); 328 EMACS_INT i = XFIXNUM (arg);
339 if (i == 0) 329 if (i == 0)
340 return make_float (-HUGE_VAL); 330 return make_float (-HUGE_VAL);
341 value = EMACS_UINT_WIDTH - 1 - ecount_leading_zeros (eabs (i)); 331 value = elogb (eabs (i));
342 } 332 }
343 333
344 return make_fixnum (value); 334 return make_fixnum (value);
diff --git a/src/fns.c b/src/fns.c
index 0af9b725c7a..602c0868c5b 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -26,6 +26,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
26#include <intprops.h> 26#include <intprops.h>
27#include <vla.h> 27#include <vla.h>
28#include <errno.h> 28#include <errno.h>
29#include <ctype.h>
29 30
30#include "lisp.h" 31#include "lisp.h"
31#include "bignum.h" 32#include "bignum.h"
@@ -439,21 +440,32 @@ If string STR1 is greater, the value is a positive number N;
439} 440}
440 441
441/* Check whether the platform allows access to unaligned addresses for 442/* Check whether the platform allows access to unaligned addresses for
442 size_t integers without trapping or undue penalty (a few cycles is OK). 443 size_t integers without trapping or undue penalty (a few cycles is OK),
444 and that a word-sized memcpy can be used to generate such an access.
443 445
444 This whitelist is incomplete but since it is only used to improve 446 This whitelist is incomplete but since it is only used to improve
445 performance, omitting cases is safe. */ 447 performance, omitting cases is safe. */
446#if defined __x86_64__|| defined __amd64__ \ 448#if (defined __x86_64__|| defined __amd64__ \
447 || defined __i386__ || defined __i386 \ 449 || defined __i386__ || defined __i386 \
448 || defined __arm64__ || defined __aarch64__ \ 450 || defined __arm64__ || defined __aarch64__ \
449 || defined __powerpc__ || defined __powerpc \ 451 || defined __powerpc__ || defined __powerpc \
450 || defined __ppc__ || defined __ppc \ 452 || defined __ppc__ || defined __ppc \
451 || defined __s390__ || defined __s390x__ 453 || defined __s390__ || defined __s390x__) \
454 && defined __OPTIMIZE__
452#define HAVE_FAST_UNALIGNED_ACCESS 1 455#define HAVE_FAST_UNALIGNED_ACCESS 1
453#else 456#else
454#define HAVE_FAST_UNALIGNED_ACCESS 0 457#define HAVE_FAST_UNALIGNED_ACCESS 0
455#endif 458#endif
456 459
460/* Load a word from a possibly unaligned address. */
461static inline size_t
462load_unaligned_size_t (const void *p)
463{
464 size_t x;
465 memcpy (&x, p, sizeof x);
466 return x;
467}
468
457DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0, 469DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
458 doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic order. 470 doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic order.
459Case is significant. 471Case is significant.
@@ -497,17 +509,12 @@ Symbols are also allowed; their print names are used instead. */)
497 if (HAVE_FAST_UNALIGNED_ACCESS) 509 if (HAVE_FAST_UNALIGNED_ACCESS)
498 { 510 {
499 /* First compare entire machine words. */ 511 /* First compare entire machine words. */
500 typedef size_t word_t; 512 int ws = sizeof (size_t);
501 int ws = sizeof (word_t); 513 const char *w1 = SSDATA (string1);
502 const word_t *w1 = (const word_t *) SDATA (string1); 514 const char *w2 = SSDATA (string2);
503 const word_t *w2 = (const word_t *) SDATA (string2); 515 while (b < nb - ws + 1 && load_unaligned_size_t (w1 + b)
504 while (b < nb - ws + 1) 516 == load_unaligned_size_t (w2 + b))
505 { 517 b += ws;
506 if (UNALIGNED_LOAD_SIZE (w1, b / ws)
507 != UNALIGNED_LOAD_SIZE (w2, b / ws))
508 break;
509 b += ws;
510 }
511 } 518 }
512 519
513 /* Scan forward to the differing byte. */ 520 /* Scan forward to the differing byte. */
@@ -1960,6 +1967,20 @@ assq_no_quit (Lisp_Object key, Lisp_Object alist)
1960 return Qnil; 1967 return Qnil;
1961} 1968}
1962 1969
1970/* Assq but doesn't signal. Unlike assq_no_quit, this function still
1971 detects circular lists; like assq_no_quit, this function does not
1972 allow quits and never signals. If anything goes wrong, it returns
1973 Qnil. */
1974Lisp_Object
1975assq_no_signal (Lisp_Object key, Lisp_Object alist)
1976{
1977 Lisp_Object tail = alist;
1978 FOR_EACH_TAIL_SAFE (tail)
1979 if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
1980 return XCAR (tail);
1981 return Qnil;
1982}
1983
1963DEFUN ("assoc", Fassoc, Sassoc, 2, 3, 0, 1984DEFUN ("assoc", Fassoc, Sassoc, 2, 3, 0,
1964 doc: /* Return non-nil if KEY is equal to the car of an element of ALIST. 1985 doc: /* Return non-nil if KEY is equal to the car of an element of ALIST.
1965The value is actually the first element of ALIST whose car equals KEY. 1986The value is actually the first element of ALIST whose car equals KEY.
@@ -2917,8 +2938,7 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
2917 else 2938 else
2918 { 2939 {
2919 ptrdiff_t product; 2940 ptrdiff_t product;
2920 if (INT_MULTIPLY_WRAPV (size, len, &product) 2941 if (ckd_mul (&product, size, len) || product != size_byte)
2921 || product != size_byte)
2922 error ("Attempt to change byte length of a string"); 2942 error ("Attempt to change byte length of a string");
2923 for (idx = 0; idx < size_byte; idx++) 2943 for (idx = 0; idx < size_byte; idx++)
2924 *p++ = str[idx % len]; 2944 *p++ = str[idx % len];
@@ -3182,7 +3202,9 @@ DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
3182Return t if answer is yes, and nil if the answer is no. 3202Return t if answer is yes, and nil if the answer is no.
3183 3203
3184PROMPT is the string to display to ask the question; `yes-or-no-p' 3204PROMPT is the string to display to ask the question; `yes-or-no-p'
3185appends `yes-or-no-prompt' (default \"(yes or no) \") to it. 3205appends `yes-or-no-prompt' (default \"(yes or no) \") to it. If
3206PROMPT is a non-empty string, and it ends with a non-space character,
3207a space character will be appended to it.
3186 3208
3187The user must confirm the answer with RET, and can edit it until it 3209The user must confirm the answer with RET, and can edit it until it
3188has been confirmed. 3210has been confirmed.
@@ -3191,16 +3213,21 @@ If the `use-short-answers' variable is non-nil, instead of asking for
3191\"yes\" or \"no\", this function will ask for \"y\" or \"n\" (and 3213\"yes\" or \"no\", this function will ask for \"y\" or \"n\" (and
3192ignore the value of `yes-or-no-prompt'). 3214ignore the value of `yes-or-no-prompt').
3193 3215
3194If dialog boxes are supported, a dialog box will be used 3216If dialog boxes are supported, this function will use a dialog box
3195if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */) 3217if `use-dialog-box' is non-nil and the last input event was produced
3218by a mouse, or by some window-system gesture, or via a menu. */)
3196 (Lisp_Object prompt) 3219 (Lisp_Object prompt)
3197{ 3220{
3198 Lisp_Object ans; 3221 Lisp_Object ans, val;
3199 3222
3200 CHECK_STRING (prompt); 3223 CHECK_STRING (prompt);
3201 3224
3202 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) 3225 if (!NILP (last_input_event)
3203 && use_dialog_box && ! NILP (last_input_event)) 3226 && (CONSP (last_nonmenu_event)
3227 || (NILP (last_nonmenu_event) && CONSP (last_input_event))
3228 || (val = find_symbol_value (Qfrom__tty_menu_p),
3229 (!NILP (val) && !EQ (val, Qunbound))))
3230 && use_dialog_box)
3204 { 3231 {
3205 Lisp_Object pane, menu, obj; 3232 Lisp_Object pane, menu, obj;
3206 redisplay_preserve_echo_area (4); 3233 redisplay_preserve_echo_area (4);
@@ -3214,6 +3241,12 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */)
3214 if (use_short_answers) 3241 if (use_short_answers)
3215 return call1 (intern ("y-or-n-p"), prompt); 3242 return call1 (intern ("y-or-n-p"), prompt);
3216 3243
3244 {
3245 char *s = SSDATA (prompt);
3246 ptrdiff_t len = strlen (s);
3247 if ((len > 0) && !isspace (s[len - 1]))
3248 prompt = CALLN (Fconcat, prompt, build_string (" "));
3249 }
3217 prompt = CALLN (Fconcat, prompt, Vyes_or_no_prompt); 3250 prompt = CALLN (Fconcat, prompt, Vyes_or_no_prompt);
3218 3251
3219 specpdl_ref count = SPECPDL_INDEX (); 3252 specpdl_ref count = SPECPDL_INDEX ();
@@ -6121,29 +6154,40 @@ second optional argument ABSOLUTE is non-nil, the value counts the lines
6121from the absolute start of the buffer, disregarding the narrowing. */) 6154from the absolute start of the buffer, disregarding the narrowing. */)
6122 (register Lisp_Object position, Lisp_Object absolute) 6155 (register Lisp_Object position, Lisp_Object absolute)
6123{ 6156{
6124 ptrdiff_t pos, start = BEGV_BYTE; 6157 ptrdiff_t pos_byte, start_byte = BEGV_BYTE;
6125 6158
6126 if (MARKERP (position)) 6159 if (MARKERP (position))
6127 pos = marker_position (position); 6160 {
6161 /* We don't trust the byte position if the marker's buffer is
6162 not the current buffer. */
6163 if (XMARKER (position)->buffer != current_buffer)
6164 pos_byte = CHAR_TO_BYTE (marker_position (position));
6165 else
6166 pos_byte = marker_byte_position (position);
6167 }
6128 else if (NILP (position)) 6168 else if (NILP (position))
6129 pos = PT; 6169 pos_byte = PT_BYTE;
6130 else 6170 else
6131 { 6171 {
6132 CHECK_FIXNUM (position); 6172 CHECK_FIXNUM (position);
6133 pos = XFIXNUM (position); 6173 ptrdiff_t pos = XFIXNUM (position);
6174 /* Check that POSITION is valid. */
6175 if (pos < BEG || pos > Z)
6176 args_out_of_range_3 (position, make_int (BEG), make_int (Z));
6177 pos_byte = CHAR_TO_BYTE (pos);
6134 } 6178 }
6135 6179
6136 if (!NILP (absolute)) 6180 if (!NILP (absolute))
6137 start = BEG_BYTE; 6181 start_byte = BEG_BYTE;
6182 else if (NILP (absolute))
6183 pos_byte = clip_to_bounds (BEGV_BYTE, pos_byte, ZV_BYTE);
6138 6184
6139 /* Check that POSITION is in the accessible range of the buffer, or, 6185 /* Check that POSITION is valid. */
6140 if we're reporting absolute positions, in the buffer. */ 6186 if (pos_byte < BEG_BYTE || pos_byte > Z_BYTE)
6141 if (NILP (absolute) && (pos < BEGV || pos > ZV)) 6187 args_out_of_range_3 (make_int (BYTE_TO_CHAR (pos_byte)),
6142 args_out_of_range_3 (make_int (pos), make_int (BEGV), make_int (ZV)); 6188 make_int (BEG), make_int (Z));
6143 else if (!NILP (absolute) && (pos < 1 || pos > Z))
6144 args_out_of_range_3 (make_int (pos), make_int (1), make_int (Z));
6145 6189
6146 return make_int (count_lines (start, CHAR_TO_BYTE (pos)) + 1); 6190 return make_int (count_lines (start_byte, pos_byte) + 1);
6147} 6191}
6148 6192
6149 6193
@@ -6358,4 +6402,5 @@ For best results this should end in a space. */);
6358 defsubr (&Sbuffer_line_statistics); 6402 defsubr (&Sbuffer_line_statistics);
6359 6403
6360 DEFSYM (Qreal_this_command, "real-this-command"); 6404 DEFSYM (Qreal_this_command, "real-this-command");
6405 DEFSYM (Qfrom__tty_menu_p, "from--tty-menu-p");
6361} 6406}
diff --git a/src/font.c b/src/font.c
index de8748dd857..e586277a5d3 100644
--- a/src/font.c
+++ b/src/font.c
@@ -279,7 +279,7 @@ font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol)
279 { 279 {
280 if (i == len) 280 if (i == len)
281 return make_fixnum (n); 281 return make_fixnum (n);
282 if (INT_MULTIPLY_WRAPV (n, 10, &n)) 282 if (ckd_mul (&n, n, 10))
283 break; 283 break;
284 } 284 }
285 285
diff --git a/src/fontset.c b/src/fontset.c
index f196dee8259..c0e00cfa346 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -967,6 +967,15 @@ face_for_char (struct frame *f, struct face *face, int c,
967#endif 967#endif
968 } 968 }
969 969
970 /* If the parent face has no fontset we could work with, and has no
971 font, just return that same face, so that the caller will
972 consider the character to have no font capable of displaying it,
973 and display it as "glyphless". That is certainly better than
974 violating the assertion below or crashing when assertions are not
975 compiled in. */
976 if (face->fontset < 0 && !face->font)
977 return face->id;
978
970 eassert (fontset_id_valid_p (face->fontset)); 979 eassert (fontset_id_valid_p (face->fontset));
971 fontset = FONTSET_FROM_ID (face->fontset); 980 fontset = FONTSET_FROM_ID (face->fontset);
972 eassert (!BASE_FONTSET_P (fontset)); 981 eassert (!BASE_FONTSET_P (fontset));
diff --git a/src/frame.c b/src/frame.c
index 2cea96d4a32..037914ac9dc 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -3729,7 +3729,7 @@ check_frame_pixels (Lisp_Object size, Lisp_Object pixelwise, int item_size)
3729 item_size = 1; 3729 item_size = 1;
3730 3730
3731 if (!integer_to_intmax (size, &sz) 3731 if (!integer_to_intmax (size, &sz)
3732 || INT_MULTIPLY_WRAPV (sz, item_size, &pixel_size)) 3732 || ckd_mul (&pixel_size, sz, item_size))
3733 args_out_of_range_3 (size, make_int (INT_MIN / item_size), 3733 args_out_of_range_3 (size, make_int (INT_MIN / item_size),
3734 make_int (INT_MAX / item_size)); 3734 make_int (INT_MAX / item_size));
3735 3735
diff --git a/src/fringe.c b/src/fringe.c
index 5fcb1b27272..ed257c073b9 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -211,14 +211,14 @@ static unsigned short right_curly_arrow_bits[] = {
211 211
212/* Large circle bitmap. */ 212/* Large circle bitmap. */
213/* 213/*
214 ........
215 ..xxxx.. 214 ..xxxx..
216 .xxxxxx. 215 .xxxxxx.
217 xxxxxxxx 216 xxxxxxxx
218 xxxxxxxx 217 xxxxxxxx
218 xxxxxxxx
219 xxxxxxxx
219 .xxxxxx. 220 .xxxxxx.
220 ..xxxx.. 221 ..xxxx..
221 ........
222*/ 222*/
223static unsigned short large_circle_bits[] = { 223static unsigned short large_circle_bits[] = {
224 0x3c, 0x7e, 0xff, 0xff, 0xff, 0xff, 0x7e, 0x3c}; 224 0x3c, 0x7e, 0xff, 0xff, 0xff, 0xff, 0x7e, 0x3c};
diff --git a/src/ftcrfont.c b/src/ftcrfont.c
index c9a4de8137b..49564692b75 100644
--- a/src/ftcrfont.c
+++ b/src/ftcrfont.c
@@ -590,7 +590,6 @@ ftcrfont_draw (struct glyph_string *s,
590 GREEN_FROM_ULONG (col) / 255.0, 590 GREEN_FROM_ULONG (col) / 255.0,
591 BLUE_FROM_ULONG (col) / 255.0); 591 BLUE_FROM_ULONG (col) / 255.0);
592#endif 592#endif
593 s->background_filled_p = 1;
594 cairo_rectangle (cr, x, y - FONT_BASE (s->font), 593 cairo_rectangle (cr, x, y - FONT_BASE (s->font),
595 s->width, FONT_HEIGHT (s->font)); 594 s->width, FONT_HEIGHT (s->font));
596 cairo_fill (cr); 595 cairo_fill (cr);
diff --git a/src/gnutls.c b/src/gnutls.c
index ca7e9fc4c73..8f0e2d01703 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -1083,8 +1083,8 @@ gnutls_hex_string (unsigned char *buf, ptrdiff_t buf_size, const char *prefix)
1083{ 1083{
1084 ptrdiff_t prefix_length = strlen (prefix); 1084 ptrdiff_t prefix_length = strlen (prefix);
1085 ptrdiff_t retlen; 1085 ptrdiff_t retlen;
1086 if (INT_MULTIPLY_WRAPV (buf_size, 3, &retlen) 1086 if (ckd_mul (&retlen, buf_size, 3)
1087 || INT_ADD_WRAPV (prefix_length - (buf_size != 0), retlen, &retlen)) 1087 || ckd_add (&retlen, retlen, prefix_length - (buf_size != 0)))
1088 string_overflow (); 1088 string_overflow ();
1089 Lisp_Object ret = make_uninit_string (retlen); 1089 Lisp_Object ret = make_uninit_string (retlen);
1090 char *string = SSDATA (ret); 1090 char *string = SSDATA (ret);
@@ -2378,7 +2378,7 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca,
2378 2378
2379 ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca); 2379 ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca);
2380 ptrdiff_t tagged_size; 2380 ptrdiff_t tagged_size;
2381 if (INT_ADD_WRAPV (isize, cipher_tag_size, &tagged_size) 2381 if (ckd_add (&tagged_size, isize, cipher_tag_size)
2382 || SIZE_MAX < tagged_size) 2382 || SIZE_MAX < tagged_size)
2383 memory_full (SIZE_MAX); 2383 memory_full (SIZE_MAX);
2384 size_t storage_length = tagged_size; 2384 size_t storage_length = tagged_size;
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 4cc0f9f15b4..22b2a70f279 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -694,8 +694,8 @@ get_utf8_string (const char *str)
694 694
695 len = strlen (str); 695 len = strlen (str);
696 ptrdiff_t alloc; 696 ptrdiff_t alloc;
697 if (INT_MULTIPLY_WRAPV (nr_bad, 4, &alloc) 697 if (ckd_mul (&alloc, nr_bad, 4)
698 || INT_ADD_WRAPV (len + 1, alloc, &alloc) 698 || ckd_add (&alloc, alloc, len + 1)
699 || SIZE_MAX < alloc) 699 || SIZE_MAX < alloc)
700 memory_full (SIZE_MAX); 700 memory_full (SIZE_MAX);
701 up = utf8_str = xmalloc (alloc); 701 up = utf8_str = xmalloc (alloc);
diff --git a/src/haikufont.c b/src/haikufont.c
index b4c2e547247..b6a9cb34c4d 100644
--- a/src/haikufont.c
+++ b/src/haikufont.c
@@ -1127,7 +1127,6 @@ haikufont_draw (struct glyph_string *s, int from, int to,
1127 1127
1128 haiku_draw_background_rect (s, s->face, x, y - ascent, 1128 haiku_draw_background_rect (s, s->face, x, y - ascent,
1129 s->width, height); 1129 s->width, height);
1130 s->background_filled_p = 1;
1131 } 1130 }
1132 1131
1133 BView_SetHighColor (view, foreground); 1132 BView_SetHighColor (view, foreground);
diff --git a/src/haikuterm.c b/src/haikuterm.c
index 8733b82fb2b..212870064e8 100644
--- a/src/haikuterm.c
+++ b/src/haikuterm.c
@@ -4420,7 +4420,7 @@ haiku_term_init (void)
4420 { 4420 {
4421 nbytes = sizeof "GNU Emacs" + sizeof " at "; 4421 nbytes = sizeof "GNU Emacs" + sizeof " at ";
4422 4422
4423 if (INT_ADD_WRAPV (nbytes, SBYTES (system_name), &nbytes)) 4423 if (ckd_add (&nbytes, nbytes, SBYTES (system_name)))
4424 memory_full (SIZE_MAX); 4424 memory_full (SIZE_MAX);
4425 4425
4426 name_buffer = alloca (nbytes); 4426 name_buffer = alloca (nbytes);
diff --git a/src/image.c b/src/image.c
index e78c0abb0db..c9420b48f4a 100644
--- a/src/image.c
+++ b/src/image.c
@@ -479,7 +479,8 @@ image_create_bitmap_from_data (struct frame *f, char *bits,
479 479
480#ifdef HAVE_X_WINDOWS 480#ifdef HAVE_X_WINDOWS
481 Pixmap bitmap; 481 Pixmap bitmap;
482 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), 482 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
483 dpyinfo->root_window,
483 bits, width, height); 484 bits, width, height);
484 if (! bitmap) 485 if (! bitmap)
485 return -1; 486 return -1;
@@ -729,8 +730,10 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file)
729 730
730 filename = SSDATA (found); 731 filename = SSDATA (found);
731 732
732 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), 733 result = XReadBitmapFile (FRAME_X_DISPLAY (f),
733 filename, &width, &height, &bitmap, &xhot, &yhot); 734 dpyinfo->root_window,
735 filename, &width, &height, &bitmap,
736 &xhot, &yhot);
734 if (result != BitmapSuccess) 737 if (result != BitmapSuccess)
735 return -1; 738 return -1;
736 739
@@ -839,9 +842,17 @@ static void
839free_bitmap_record (Display_Info *dpyinfo, Bitmap_Record *bm) 842free_bitmap_record (Display_Info *dpyinfo, Bitmap_Record *bm)
840{ 843{
841#ifdef HAVE_X_WINDOWS 844#ifdef HAVE_X_WINDOWS
842 XFreePixmap (dpyinfo->display, bm->pixmap); 845 /* Free the pixmap and mask. Only do this if DPYINFO->display is
843 if (bm->have_mask) 846 still set, which may not be the case if the connection has
844 XFreePixmap (dpyinfo->display, bm->mask); 847 already been closed in response to an IO error. */
848
849 if (dpyinfo->display)
850 {
851 XFreePixmap (dpyinfo->display, bm->pixmap);
852 if (bm->have_mask)
853 XFreePixmap (dpyinfo->display, bm->mask);
854 }
855
845#ifdef USE_CAIRO 856#ifdef USE_CAIRO
846 if (bm->stipple) 857 if (bm->stipple)
847 cairo_pattern_destroy (bm->stipple); 858 cairo_pattern_destroy (bm->stipple);
@@ -4000,7 +4011,7 @@ xbm_scan (char **s, char *end, char *sval, int *ival)
4000 digit = char_hexdigit (c); 4011 digit = char_hexdigit (c);
4001 if (digit < 0) 4012 if (digit < 0)
4002 break; 4013 break;
4003 overflow |= INT_MULTIPLY_WRAPV (value, 16, &value); 4014 overflow |= ckd_mul (&value, value, 16);
4004 value += digit; 4015 value += digit;
4005 } 4016 }
4006 } 4017 }
@@ -4010,7 +4021,7 @@ xbm_scan (char **s, char *end, char *sval, int *ival)
4010 while (*s < end 4021 while (*s < end
4011 && (c = *(*s)++, '0' <= c && c <= '7')) 4022 && (c = *(*s)++, '0' <= c && c <= '7'))
4012 { 4023 {
4013 overflow |= INT_MULTIPLY_WRAPV (value, 8, &value); 4024 overflow |= ckd_mul (&value, value, 8);
4014 value += c - '0'; 4025 value += c - '0';
4015 } 4026 }
4016 } 4027 }
@@ -4021,8 +4032,8 @@ xbm_scan (char **s, char *end, char *sval, int *ival)
4021 while (*s < end 4032 while (*s < end
4022 && (c = *(*s)++, c_isdigit (c))) 4033 && (c = *(*s)++, c_isdigit (c)))
4023 { 4034 {
4024 overflow |= INT_MULTIPLY_WRAPV (value, 10, &value); 4035 overflow |= ckd_mul (&value, value, 10);
4025 overflow |= INT_ADD_WRAPV (value, c - '0', &value); 4036 overflow |= ckd_add (&value, value, c - '0');
4026 } 4037 }
4027 } 4038 }
4028 4039
@@ -4066,7 +4077,7 @@ xbm_scan (char **s, char *end, char *sval, int *ival)
4066 if (digit < 0) 4077 if (digit < 0)
4067 return 0; 4078 return 0;
4068 4079
4069 overflow |= INT_MULTIPLY_WRAPV (value, 16, &value); 4080 overflow |= ckd_mul (&value, value, 16);
4070 value += digit; 4081 value += digit;
4071 } 4082 }
4072 } 4083 }
@@ -6133,8 +6144,8 @@ image_to_emacs_colors (struct frame *f, struct image *img, bool rgb_p)
6133 HGDIOBJ prev; 6144 HGDIOBJ prev;
6134#endif /* HAVE_NTGUI */ 6145#endif /* HAVE_NTGUI */
6135 6146
6136 if (INT_MULTIPLY_WRAPV (sizeof *colors, img->width, &nbytes) 6147 if (ckd_mul (&nbytes, sizeof *colors, img->width)
6137 || INT_MULTIPLY_WRAPV (img->height, nbytes, &nbytes) 6148 || ckd_mul (&nbytes, nbytes, img->height)
6138 || SIZE_MAX < nbytes) 6149 || SIZE_MAX < nbytes)
6139 memory_full (SIZE_MAX); 6150 memory_full (SIZE_MAX);
6140 colors = xmalloc (nbytes); 6151 colors = xmalloc (nbytes);
@@ -6279,8 +6290,8 @@ image_detect_edges (struct frame *f, struct image *img,
6279 6290
6280#define COLOR(A, X, Y) ((A) + (Y) * img->width + (X)) 6291#define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
6281 6292
6282 if (INT_MULTIPLY_WRAPV (sizeof *new, img->width, &nbytes) 6293 if (ckd_mul (&nbytes, sizeof *new, img->width)
6283 || INT_MULTIPLY_WRAPV (img->height, nbytes, &nbytes)) 6294 || ckd_mul (&nbytes, nbytes, img->height))
6284 memory_full (SIZE_MAX); 6295 memory_full (SIZE_MAX);
6285 new = xmalloc (nbytes); 6296 new = xmalloc (nbytes);
6286 6297
@@ -7652,8 +7663,8 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
7652 row_bytes = png_get_rowbytes (png_ptr, info_ptr); 7663 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
7653 7664
7654 /* Allocate memory for the image. */ 7665 /* Allocate memory for the image. */
7655 if (INT_MULTIPLY_WRAPV (row_bytes, sizeof *pixels, &nbytes) 7666 if (ckd_mul (&nbytes, row_bytes, sizeof *pixels)
7656 || INT_MULTIPLY_WRAPV (nbytes, height, &nbytes)) 7667 || ckd_mul (&nbytes, nbytes, height))
7657 memory_full (SIZE_MAX); 7668 memory_full (SIZE_MAX);
7658 c->pixels = pixels = xmalloc (nbytes); 7669 c->pixels = pixels = xmalloc (nbytes);
7659 c->rows = rows = xmalloc (height * sizeof *rows); 7670 c->rows = rows = xmalloc (height * sizeof *rows);
diff --git a/src/indent.c b/src/indent.c
index 6a84472fd2f..81157fc2494 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -616,7 +616,7 @@ scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol,
616 616
617 memset (&cmp_it, 0, sizeof cmp_it); 617 memset (&cmp_it, 0, sizeof cmp_it);
618 cmp_it.id = -1; 618 cmp_it.id = -1;
619 composition_compute_stop_pos (&cmp_it, scan, scan_byte, end, Qnil); 619 composition_compute_stop_pos (&cmp_it, scan, scan_byte, end, Qnil, true);
620 620
621 /* Scan forward to the target position. */ 621 /* Scan forward to the target position. */
622 while (scan < end) 622 while (scan < end)
@@ -681,7 +681,7 @@ scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol,
681 { 681 {
682 cmp_it.id = -1; 682 cmp_it.id = -1;
683 composition_compute_stop_pos (&cmp_it, scan, scan_byte, end, 683 composition_compute_stop_pos (&cmp_it, scan, scan_byte, end,
684 Qnil); 684 Qnil, true);
685 } 685 }
686 else 686 else
687 cmp_it.from = cmp_it.to; 687 cmp_it.from = cmp_it.to;
@@ -1290,7 +1290,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1290 prev_tab_offset = tab_offset; 1290 prev_tab_offset = tab_offset;
1291 memset (&cmp_it, 0, sizeof cmp_it); 1291 memset (&cmp_it, 0, sizeof cmp_it);
1292 cmp_it.id = -1; 1292 cmp_it.id = -1;
1293 composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil); 1293 composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil, true);
1294 1294
1295 unsigned short int quit_count = 0; 1295 unsigned short int quit_count = 0;
1296 1296
@@ -1600,7 +1600,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1600 { 1600 {
1601 cmp_it.id = -1; 1601 cmp_it.id = -1;
1602 composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, 1602 composition_compute_stop_pos (&cmp_it, pos, pos_byte, to,
1603 Qnil); 1603 Qnil, true);
1604 } 1604 }
1605 else 1605 else
1606 cmp_it.from = cmp_it.to; 1606 cmp_it.from = cmp_it.to;
@@ -2065,6 +2065,7 @@ line_number_display_width (struct window *w, int *width, int *pixel_width)
2065 { 2065 {
2066 record_unwind_protect (save_restriction_restore, 2066 record_unwind_protect (save_restriction_restore,
2067 save_restriction_save ()); 2067 save_restriction_save ());
2068 labeled_restrictions_remove_in_current_buffer ();
2068 Fwiden (); 2069 Fwiden ();
2069 saved_restriction = true; 2070 saved_restriction = true;
2070 } 2071 }
diff --git a/src/itree.c b/src/itree.c
index bd3e62a374a..ecf7d67422a 100644
--- a/src/itree.c
+++ b/src/itree.c
@@ -817,14 +817,13 @@ itree_remove_fix (struct itree_tree *tree,
817 { 817 {
818 struct itree_node *other = parent->right; 818 struct itree_node *other = parent->right;
819 819
820 if (null_safe_is_red (other)) /* case 1.a */ 820 if (other->red) /* case 1.a */
821 { 821 {
822 other->red = false; 822 other->red = false;
823 parent->red = true; 823 parent->red = true;
824 itree_rotate_left (tree, parent); 824 itree_rotate_left (tree, parent);
825 other = parent->right; 825 other = parent->right;
826 } 826 }
827 eassume (other != NULL);
828 827
829 if (null_safe_is_black (other->left) /* 2.a */ 828 if (null_safe_is_black (other->left) /* 2.a */
830 && null_safe_is_black (other->right)) 829 && null_safe_is_black (other->right))
@@ -855,14 +854,13 @@ itree_remove_fix (struct itree_tree *tree,
855 { 854 {
856 struct itree_node *other = parent->left; 855 struct itree_node *other = parent->left;
857 856
858 if (null_safe_is_red (other)) /* 1.b */ 857 if (other->red) /* 1.b */
859 { 858 {
860 other->red = false; 859 other->red = false;
861 parent->red = true; 860 parent->red = true;
862 itree_rotate_right (tree, parent); 861 itree_rotate_right (tree, parent);
863 other = parent->left; 862 other = parent->left;
864 } 863 }
865 eassume (other != NULL);
866 864
867 if (null_safe_is_black (other->right) /* 2.b */ 865 if (null_safe_is_black (other->right) /* 2.b */
868 && null_safe_is_black (other->left)) 866 && null_safe_is_black (other->left))
diff --git a/src/keyboard.c b/src/keyboard.c
index b2816f8270b..a1cddf9d145 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -105,6 +105,13 @@ static bool single_kboard;
105/* Minimum allowed size of the recent_keys vector. */ 105/* Minimum allowed size of the recent_keys vector. */
106#define MIN_NUM_RECENT_KEYS (100) 106#define MIN_NUM_RECENT_KEYS (100)
107 107
108/* Maximum allowed size of the recent_keys vector. */
109#if INTPTR_MAX <= INT_MAX
110# define MAX_NUM_RECENT_KEYS (INT_MAX / EMACS_INT_WIDTH / 10)
111#else
112# define MAX_NUM_RECENT_KEYS (INT_MAX / EMACS_INT_WIDTH)
113#endif
114
108/* Index for storing next element into recent_keys. */ 115/* Index for storing next element into recent_keys. */
109static int recent_keys_index; 116static int recent_keys_index;
110 117
@@ -311,6 +318,8 @@ static Lisp_Object command_loop (void);
311static void echo_now (void); 318static void echo_now (void);
312static ptrdiff_t echo_length (void); 319static ptrdiff_t echo_length (void);
313 320
321static void safe_run_hooks_maybe_narrowed (Lisp_Object, struct window *);
322
314/* Incremented whenever a timer is run. */ 323/* Incremented whenever a timer is run. */
315unsigned timers_run; 324unsigned timers_run;
316 325
@@ -1427,6 +1436,7 @@ command_loop_1 (void)
1427 prev_buffer = current_buffer; 1436 prev_buffer = current_buffer;
1428 prev_modiff = MODIFF; 1437 prev_modiff = MODIFF;
1429 last_point_position = PT; 1438 last_point_position = PT;
1439 ptrdiff_t last_pt = PT;
1430 1440
1431 /* By default, we adjust point to a boundary of a region that 1441 /* By default, we adjust point to a boundary of a region that
1432 has such a property that should be treated intangible 1442 has such a property that should be treated intangible
@@ -1504,6 +1514,9 @@ command_loop_1 (void)
1504 unbind_to (scount, Qnil); 1514 unbind_to (scount, Qnil);
1505#endif 1515#endif
1506 } 1516 }
1517 /* Restore last PT position value, possibly clobbered by
1518 recursive-edit invoked by the command we just executed. */
1519 last_point_position = last_pt;
1507 kset_last_prefix_arg (current_kboard, Vcurrent_prefix_arg); 1520 kset_last_prefix_arg (current_kboard, Vcurrent_prefix_arg);
1508 1521
1509 safe_run_hooks_maybe_narrowed (Qpost_command_hook, 1522 safe_run_hooks_maybe_narrowed (Qpost_command_hook,
@@ -1902,7 +1915,7 @@ safe_run_hooks (Lisp_Object hook)
1902 unbind_to (count, Qnil); 1915 unbind_to (count, Qnil);
1903} 1916}
1904 1917
1905void 1918static void
1906safe_run_hooks_maybe_narrowed (Lisp_Object hook, struct window *w) 1919safe_run_hooks_maybe_narrowed (Lisp_Object hook, struct window *w)
1907{ 1920{
1908 specpdl_ref count = SPECPDL_INDEX (); 1921 specpdl_ref count = SPECPDL_INDEX ();
@@ -1912,11 +1925,11 @@ safe_run_hooks_maybe_narrowed (Lisp_Object hook, struct window *w)
1912 if (current_buffer->long_line_optimizations_p 1925 if (current_buffer->long_line_optimizations_p
1913 && long_line_optimizations_region_size > 0) 1926 && long_line_optimizations_region_size > 0)
1914 { 1927 {
1915 ptrdiff_t begv = get_locked_narrowing_begv (PT); 1928 ptrdiff_t begv = get_large_narrowing_begv (PT);
1916 ptrdiff_t zv = get_locked_narrowing_zv (PT); 1929 ptrdiff_t zv = get_large_narrowing_zv (PT);
1917 if (begv != BEG || zv != Z) 1930 if (begv != BEG || zv != Z)
1918 narrow_to_region_locked (make_fixnum (begv), make_fixnum (zv), 1931 labeled_narrow_to_region (make_fixnum (begv), make_fixnum (zv),
1919 Qlong_line_optimizations_in_command_hooks); 1932 Qlong_line_optimizations_in_command_hooks);
1920 } 1933 }
1921 1934
1922 run_hook_with_args (2, ((Lisp_Object []) {hook, hook}), 1935 run_hook_with_args (2, ((Lisp_Object []) {hook, hook}),
@@ -10984,10 +10997,10 @@ The saved keystrokes are shown by `view-lossage'. */)
10984 10997
10985 if (!FIXNATP (arg)) 10998 if (!FIXNATP (arg))
10986 user_error ("Value must be a positive integer"); 10999 user_error ("Value must be a positive integer");
10987 int osize = ASIZE (recent_keys); 11000 ptrdiff_t osize = ASIZE (recent_keys);
10988 eassert (lossage_limit == osize); 11001 eassert (lossage_limit == osize);
10989 int min_size = MIN_NUM_RECENT_KEYS; 11002 int min_size = MIN_NUM_RECENT_KEYS;
10990 int new_size = XFIXNAT (arg); 11003 EMACS_INT new_size = XFIXNAT (arg);
10991 11004
10992 if (new_size == osize) 11005 if (new_size == osize)
10993 return make_fixnum (lossage_limit); 11006 return make_fixnum (lossage_limit);
@@ -10997,6 +11010,12 @@ The saved keystrokes are shown by `view-lossage'. */)
10997 AUTO_STRING (fmt, "Value must be >= %d"); 11010 AUTO_STRING (fmt, "Value must be >= %d");
10998 Fsignal (Quser_error, list1 (CALLN (Fformat, fmt, make_fixnum (min_size)))); 11011 Fsignal (Quser_error, list1 (CALLN (Fformat, fmt, make_fixnum (min_size))));
10999 } 11012 }
11013 if (new_size > MAX_NUM_RECENT_KEYS)
11014 {
11015 AUTO_STRING (fmt, "Value must be <= %d");
11016 Fsignal (Quser_error, list1 (CALLN (Fformat, fmt,
11017 make_fixnum (MAX_NUM_RECENT_KEYS))));
11018 }
11000 11019
11001 int kept_keys = new_size > osize ? total_keys : min (new_size, total_keys); 11020 int kept_keys = new_size > osize ? total_keys : min (new_size, total_keys);
11002 update_recent_keys (new_size, kept_keys); 11021 update_recent_keys (new_size, kept_keys);
@@ -11146,7 +11165,7 @@ DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
11146 (void) 11165 (void)
11147{ 11166{
11148 EMACS_INT sum; 11167 EMACS_INT sum;
11149 INT_ADD_WRAPV (command_loop_level, minibuf_level, &sum); 11168 ckd_add (&sum, command_loop_level, minibuf_level);
11150 return make_fixnum (sum); 11169 return make_fixnum (sum);
11151} 11170}
11152 11171
diff --git a/src/keymap.c b/src/keymap.c
index 23453eaa9a6..da2af98c2d6 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -887,22 +887,23 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx,
887 keymap_end: 887 keymap_end:
888 /* We have scanned the entire keymap, and not found a binding for 888 /* We have scanned the entire keymap, and not found a binding for
889 IDX. Let's add one. */ 889 IDX. Let's add one. */
890 { 890 if (!remove)
891 Lisp_Object elt; 891 {
892 Lisp_Object elt;
892 893
893 if (CONSP (idx) && CHARACTERP (XCAR (idx))) 894 if (CONSP (idx) && CHARACTERP (XCAR (idx)))
894 { 895 {
895 /* IDX specifies a range of characters, and not all of them 896 /* IDX specifies a range of characters, and not all of them
896 were handled yet, which means this keymap doesn't have a 897 were handled yet, which means this keymap doesn't have a
897 char-table. So, we insert a char-table now. */ 898 char-table. So, we insert a char-table now. */
898 elt = Fmake_char_table (Qkeymap, Qnil); 899 elt = Fmake_char_table (Qkeymap, Qnil);
899 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def); 900 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
900 } 901 }
901 else 902 else
902 elt = Fcons (idx, def); 903 elt = Fcons (idx, def);
903 CHECK_IMPURE (insertion_point, XCONS (insertion_point)); 904 CHECK_IMPURE (insertion_point, XCONS (insertion_point));
904 XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point))); 905 XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
905 } 906 }
906 } 907 }
907 908
908 return def; 909 return def;
@@ -1362,7 +1363,7 @@ recognize the default bindings, just as `read-key-sequence' does. */)
1362 { 1363 {
1363 USE_SAFE_ALLOCA; 1364 USE_SAFE_ALLOCA;
1364 ptrdiff_t size = SCHARS (key_item), n; 1365 ptrdiff_t size = SCHARS (key_item), n;
1365 if (INT_MULTIPLY_WRAPV (size, MAX_MULTIBYTE_LENGTH, &n)) 1366 if (ckd_mul (&n, size, MAX_MULTIBYTE_LENGTH))
1366 n = PTRDIFF_MAX; 1367 n = PTRDIFF_MAX;
1367 unsigned char *dst = SAFE_ALLOCA (n); 1368 unsigned char *dst = SAFE_ALLOCA (n);
1368 unsigned char *p = dst; 1369 unsigned char *p = dst;
@@ -1410,7 +1411,7 @@ recognize the default bindings, just as `read-key-sequence' does. */)
1410 1411
1411 USE_SAFE_ALLOCA; 1412 USE_SAFE_ALLOCA;
1412 ptrdiff_t size = SCHARS (lc_key), n; 1413 ptrdiff_t size = SCHARS (lc_key), n;
1413 if (INT_MULTIPLY_WRAPV (size, MAX_MULTIBYTE_LENGTH, &n)) 1414 if (ckd_mul (&n, size, MAX_MULTIBYTE_LENGTH))
1414 n = PTRDIFF_MAX; 1415 n = PTRDIFF_MAX;
1415 unsigned char *dst = SAFE_ALLOCA (n); 1416 unsigned char *dst = SAFE_ALLOCA (n);
1416 1417
@@ -2096,7 +2097,7 @@ For an approximate inverse of this, see `kbd'. */)
2096 2097
2097 /* This has one extra element at the end that we don't pass to Fconcat. */ 2098 /* This has one extra element at the end that we don't pass to Fconcat. */
2098 ptrdiff_t size4; 2099 ptrdiff_t size4;
2099 if (INT_MULTIPLY_WRAPV (nkeys + nprefix, 4, &size4)) 2100 if (ckd_mul (&size4, nkeys + nprefix, 4))
2100 memory_full (SIZE_MAX); 2101 memory_full (SIZE_MAX);
2101 SAFE_ALLOCA_LISP (args, size4); 2102 SAFE_ALLOCA_LISP (args, size4);
2102 2103
@@ -3307,13 +3308,18 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
3307 if (this_shadowed) 3308 if (this_shadowed)
3308 { 3309 {
3309 SET_PT (PT - 1); 3310 SET_PT (PT - 1);
3310 static char const fmt[] = " (currently shadowed by `%s')"; 3311 if (SYMBOLP (shadowed_by))
3311 USE_SAFE_ALLOCA; 3312 {
3312 char *buffer = SAFE_ALLOCA (sizeof fmt + 3313 static char const fmt[] = " (currently shadowed by `%s')";
3313 SBYTES (SYMBOL_NAME (shadowed_by))); 3314 USE_SAFE_ALLOCA;
3314 esprintf (buffer, fmt, SDATA (SYMBOL_NAME (shadowed_by))); 3315 char *buffer =
3315 insert_string (buffer); 3316 SAFE_ALLOCA (sizeof fmt + SBYTES (SYMBOL_NAME (shadowed_by)));
3316 SAFE_FREE(); 3317 esprintf (buffer, fmt, SDATA (SYMBOL_NAME (shadowed_by)));
3318 insert_string (buffer);
3319 SAFE_FREE();
3320 }
3321 else /* Could be a keymap, a lambda, or a keyboard macro. */
3322 insert_string (" (currently shadowed)");
3317 SET_PT (PT + 1); 3323 SET_PT (PT + 1);
3318 } 3324 }
3319 } 3325 }
diff --git a/src/lisp.h b/src/lisp.h
index bea2d29f3e9..2feb39b7f60 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -23,6 +23,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
23#include <alloca.h> 23#include <alloca.h>
24#include <setjmp.h> 24#include <setjmp.h>
25#include <stdarg.h> 25#include <stdarg.h>
26#include <stdckdint.h>
26#include <stddef.h> 27#include <stddef.h>
27#include <string.h> 28#include <string.h>
28#include <float.h> 29#include <float.h>
@@ -30,6 +31,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
30#include <limits.h> 31#include <limits.h>
31 32
32#include <attribute.h> 33#include <attribute.h>
34#include <count-leading-zeros.h>
33#include <intprops.h> 35#include <intprops.h>
34#include <verify.h> 36#include <verify.h>
35 37
@@ -812,24 +814,24 @@ typedef struct { void const *fwdptr; } lispfwd;
812 814
813enum symbol_interned 815enum symbol_interned
814{ 816{
815 SYMBOL_UNINTERNED = 0, 817 SYMBOL_UNINTERNED, /* not interned anywhere */
816 SYMBOL_INTERNED = 1, 818 SYMBOL_INTERNED, /* interned but not in initial obarray */
817 SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2 819 SYMBOL_INTERNED_IN_INITIAL_OBARRAY /* interned in initial obarray */
818}; 820};
819 821
820enum symbol_redirect 822enum symbol_redirect
821{ 823{
822 SYMBOL_PLAINVAL = 4, 824 SYMBOL_PLAINVAL, /* plain var, value is in the `value' field */
823 SYMBOL_VARALIAS = 1, 825 SYMBOL_VARALIAS, /* var alias, value is really in the `alias' symbol */
824 SYMBOL_LOCALIZED = 2, 826 SYMBOL_LOCALIZED, /* localized var, value is in the `blv' object */
825 SYMBOL_FORWARDED = 3 827 SYMBOL_FORWARDED /* forwarding var, value is in `forward' */
826}; 828};
827 829
828enum symbol_trapped_write 830enum symbol_trapped_write
829{ 831{
830 SYMBOL_UNTRAPPED_WRITE = 0, 832 SYMBOL_UNTRAPPED_WRITE, /* normal case, just set the value */
831 SYMBOL_NOWRITE = 1, 833 SYMBOL_NOWRITE, /* constant, cannot set, e.g. nil, t, :keyword */
832 SYMBOL_TRAPPED_WRITE = 2 834 SYMBOL_TRAPPED_WRITE /* trap the write, call watcher functions */
833}; 835};
834 836
835struct Lisp_Symbol 837struct Lisp_Symbol
@@ -840,21 +842,13 @@ struct Lisp_Symbol
840 { 842 {
841 bool_bf gcmarkbit : 1; 843 bool_bf gcmarkbit : 1;
842 844
843 /* Indicates where the value can be found: 845 /* Indicates where the value can be found. */
844 0 : it's a plain var, the value is in the `value' field. 846 ENUM_BF (symbol_redirect) redirect : 2;
845 1 : it's a varalias, the value is really in the `alias' symbol.
846 2 : it's a localized var, the value is in the `blv' object.
847 3 : it's a forwarding variable, the value is in `forward'. */
848 ENUM_BF (symbol_redirect) redirect : 3;
849 847
850 /* 0 : normal case, just set the value
851 1 : constant, cannot set, e.g. nil, t, :keywords.
852 2 : trap the write, call watcher functions. */
853 ENUM_BF (symbol_trapped_write) trapped_write : 2; 848 ENUM_BF (symbol_trapped_write) trapped_write : 2;
854 849
855 /* Interned state of the symbol. This is an enumerator from 850 /* Interned state of the symbol. */
856 enum symbol_interned. */ 851 ENUM_BF (symbol_interned) interned : 2;
857 unsigned interned : 2;
858 852
859 /* True means that this variable has been explicitly declared 853 /* True means that this variable has been explicitly declared
860 special (with `defvar' etc), and shouldn't be lexically bound. */ 854 special (with `defvar' etc), and shouldn't be lexically bound. */
@@ -3965,6 +3959,13 @@ integer_to_uintmax (Lisp_Object num, uintmax_t *n)
3965 } 3959 }
3966} 3960}
3967 3961
3962/* Return floor (log2 (N)) as an int, where 0 < N <= ULLONG_MAX. */
3963INLINE int
3964elogb (unsigned long long int n)
3965{
3966 return ULLONG_WIDTH - 1 - count_leading_zeros_ll (n);
3967}
3968
3968/* A modification count. These are wide enough, and incremented 3969/* A modification count. These are wide enough, and incremented
3969 rarely enough, so that they should never overflow a 60-bit counter 3970 rarely enough, so that they should never overflow a 60-bit counter
3970 in practice, and the code below assumes this so a compiler can 3971 in practice, and the code below assumes this so a compiler can
@@ -3974,12 +3975,13 @@ typedef intmax_t modiff_count;
3974INLINE modiff_count 3975INLINE modiff_count
3975modiff_incr (modiff_count *a, ptrdiff_t len) 3976modiff_incr (modiff_count *a, ptrdiff_t len)
3976{ 3977{
3977 modiff_count a0 = *a; int incr = len ? 1 : 0; 3978 modiff_count a0 = *a;
3978 /* Increase the counter more for a large modification and less for a 3979 /* Increase the counter more for a large modification and less for a
3979 small modification. Increase it logarithmically to avoid 3980 small modification. Increase it logarithmically to avoid
3980 increasing it too much. */ 3981 increasing it too much. */
3981 while (len >>= 1) incr++; 3982 verify (PTRDIFF_MAX <= ULLONG_MAX);
3982 bool modiff_overflow = INT_ADD_WRAPV (a0, incr, a); 3983 int incr = len == 0 ? 1 : elogb (len) + 1;
3984 bool modiff_overflow = ckd_add (a, a0, incr);
3983 eassert (!modiff_overflow && *a >> 30 >> 30 == 0); 3985 eassert (!modiff_overflow && *a >> 30 >> 30 == 0);
3984 return a0; 3986 return a0;
3985} 3987}
@@ -4018,7 +4020,6 @@ extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2,
4018extern intmax_t cons_to_signed (Lisp_Object, intmax_t, intmax_t); 4020extern intmax_t cons_to_signed (Lisp_Object, intmax_t, intmax_t);
4019extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t); 4021extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t);
4020 4022
4021extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
4022extern AVOID args_out_of_range (Lisp_Object, Lisp_Object); 4023extern AVOID args_out_of_range (Lisp_Object, Lisp_Object);
4023extern AVOID circular_list (Lisp_Object); 4024extern AVOID circular_list (Lisp_Object);
4024extern Lisp_Object do_symval_forwarding (lispfwd); 4025extern Lisp_Object do_symval_forwarding (lispfwd);
@@ -4093,6 +4094,7 @@ extern Lisp_Object concat3 (Lisp_Object, Lisp_Object, Lisp_Object);
4093extern bool equal_no_quit (Lisp_Object, Lisp_Object); 4094extern bool equal_no_quit (Lisp_Object, Lisp_Object);
4094extern Lisp_Object nconc2 (Lisp_Object, Lisp_Object); 4095extern Lisp_Object nconc2 (Lisp_Object, Lisp_Object);
4095extern Lisp_Object assq_no_quit (Lisp_Object, Lisp_Object); 4096extern Lisp_Object assq_no_quit (Lisp_Object, Lisp_Object);
4097extern Lisp_Object assq_no_signal (Lisp_Object, Lisp_Object);
4096extern Lisp_Object assoc_no_quit (Lisp_Object, Lisp_Object); 4098extern Lisp_Object assoc_no_quit (Lisp_Object, Lisp_Object);
4097extern void clear_string_char_byte_cache (void); 4099extern void clear_string_char_byte_cache (void);
4098extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t); 4100extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t);
@@ -4762,8 +4764,9 @@ extern void save_restriction_restore (Lisp_Object);
4762extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool); 4764extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
4763extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, 4765extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
4764 ptrdiff_t, bool); 4766 ptrdiff_t, bool);
4765extern void narrow_to_region_locked (Lisp_Object, Lisp_Object, Lisp_Object); 4767extern void labeled_narrow_to_region (Lisp_Object, Lisp_Object, Lisp_Object);
4766extern void reset_outermost_narrowings (void); 4768extern void reset_outermost_restrictions (void);
4769extern void labeled_restrictions_remove_in_current_buffer (void);
4767extern void init_editfns (void); 4770extern void init_editfns (void);
4768extern void syms_of_editfns (void); 4771extern void syms_of_editfns (void);
4769 4772
@@ -4932,7 +4935,6 @@ extern bool detect_input_pending (void);
4932extern bool detect_input_pending_ignore_squeezables (void); 4935extern bool detect_input_pending_ignore_squeezables (void);
4933extern bool detect_input_pending_run_timers (bool); 4936extern bool detect_input_pending_run_timers (bool);
4934extern void safe_run_hooks (Lisp_Object); 4937extern void safe_run_hooks (Lisp_Object);
4935extern void safe_run_hooks_maybe_narrowed (Lisp_Object, struct window *);
4936extern void safe_run_hooks_2 (Lisp_Object, Lisp_Object, Lisp_Object); 4938extern void safe_run_hooks_2 (Lisp_Object, Lisp_Object, Lisp_Object);
4937extern void cmd_error_internal (Lisp_Object, const char *); 4939extern void cmd_error_internal (Lisp_Object, const char *);
4938extern Lisp_Object command_loop_2 (Lisp_Object); 4940extern Lisp_Object command_loop_2 (Lisp_Object);
@@ -5379,26 +5381,6 @@ __lsan_ignore_object (void const *p)
5379} 5381}
5380#endif 5382#endif
5381 5383
5382/* If built with USE_SANITIZER_UNALIGNED_LOAD defined, use compiler
5383 provided ASan functions to perform unaligned loads, allowing ASan
5384 to catch bugs which it might otherwise miss. */
5385#if defined HAVE_SANITIZER_COMMON_INTERFACE_DEFS_H \
5386 && defined ADDRESS_SANITIZER \
5387 && defined USE_SANITIZER_UNALIGNED_LOAD
5388# include <sanitizer/common_interface_defs.h>
5389# if (SIZE_MAX == UINT64_MAX)
5390# define UNALIGNED_LOAD_SIZE(a, i) \
5391 (size_t) __sanitizer_unaligned_load64 ((void *) ((a) + (i)))
5392# elif (SIZE_MAX == UINT32_MAX)
5393# define UNALIGNED_LOAD_SIZE(a, i) \
5394 (size_t) __sanitizer_unaligned_load32 ((void *) ((a) + (i)))
5395# else
5396# define UNALIGNED_LOAD_SIZE(a, i) *((a) + (i))
5397# endif
5398#else
5399# define UNALIGNED_LOAD_SIZE(a, i) *((a) + (i))
5400#endif
5401
5402extern void xputenv (const char *); 5384extern void xputenv (const char *);
5403 5385
5404extern char *egetenv_internal (const char *, ptrdiff_t); 5386extern char *egetenv_internal (const char *, ptrdiff_t);
@@ -5501,14 +5483,22 @@ safe_free_unbind_to (specpdl_ref count, specpdl_ref sa_count, Lisp_Object val)
5501 return unbind_to (count, val); 5483 return unbind_to (count, val);
5502} 5484}
5503 5485
5486/* Work around GCC bug 109577
5487 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=109577
5488 which causes GCC to mistakenly complain about the
5489 memory allocation in SAFE_ALLOCA_LISP_EXTRA. */
5490#if GNUC_PREREQ (13, 0, 0)
5491# pragma GCC diagnostic ignored "-Wanalyzer-allocation-size"
5492#endif
5493
5504/* Set BUF to point to an allocated array of NELT Lisp_Objects, 5494/* Set BUF to point to an allocated array of NELT Lisp_Objects,
5505 immediately followed by EXTRA spare bytes. */ 5495 immediately followed by EXTRA spare bytes. */
5506 5496
5507#define SAFE_ALLOCA_LISP_EXTRA(buf, nelt, extra) \ 5497#define SAFE_ALLOCA_LISP_EXTRA(buf, nelt, extra) \
5508 do { \ 5498 do { \
5509 ptrdiff_t alloca_nbytes; \ 5499 ptrdiff_t alloca_nbytes; \
5510 if (INT_MULTIPLY_WRAPV (nelt, word_size, &alloca_nbytes) \ 5500 if (ckd_mul (&alloca_nbytes, nelt, word_size) \
5511 || INT_ADD_WRAPV (alloca_nbytes, extra, &alloca_nbytes) \ 5501 || ckd_add (&alloca_nbytes, alloca_nbytes, extra) \
5512 || SIZE_MAX < alloca_nbytes) \ 5502 || SIZE_MAX < alloca_nbytes) \
5513 memory_full (SIZE_MAX); \ 5503 memory_full (SIZE_MAX); \
5514 else if (alloca_nbytes <= sa_avail) \ 5504 else if (alloca_nbytes <= sa_avail) \
diff --git a/src/lread.c b/src/lread.c
index d0dc85f51c8..0ee208b7cba 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -2255,6 +2255,7 @@ readevalloop (Lisp_Object readcharfun,
2255 record_unwind_protect_excursion (); 2255 record_unwind_protect_excursion ();
2256 /* Save ZV in it. */ 2256 /* Save ZV in it. */
2257 record_unwind_protect (save_restriction_restore, save_restriction_save ()); 2257 record_unwind_protect (save_restriction_restore, save_restriction_save ());
2258 labeled_restrictions_remove_in_current_buffer ();
2258 /* Those get unbound after we read one expression. */ 2259 /* Those get unbound after we read one expression. */
2259 2260
2260 /* Set point and ZV around stuff to be read. */ 2261 /* Set point and ZV around stuff to be read. */
@@ -2639,154 +2640,131 @@ character_name_to_code (char const *name, ptrdiff_t name_len,
2639 Unicode 9.0.0 the maximum is 83, so this should be safe. */ 2640 Unicode 9.0.0 the maximum is 83, so this should be safe. */
2640enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND = 200 }; 2641enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND = 200 };
2641 2642
2642/* Read a \-escape sequence, assuming we already read the `\'. 2643/* Read a character escape sequence, assuming we just read a backslash
2643 If the escape sequence forces unibyte, return eight-bit char. */ 2644 and one more character (next_char). */
2644
2645static int 2645static int
2646read_escape (Lisp_Object readcharfun) 2646read_char_escape (Lisp_Object readcharfun, int next_char)
2647{ 2647{
2648 int c = READCHAR; 2648 int modifiers = 0;
2649 /* \u allows up to four hex digits, \U up to eight. Default to the 2649 ptrdiff_t ncontrol = 0;
2650 behavior for \u, and change this value in the case that \U is seen. */ 2650 int chr;
2651 int unicode_hex_count = 4; 2651
2652 again: ;
2653 int c = next_char;
2654 int unicode_hex_count;
2655 int mod;
2652 2656
2653 switch (c) 2657 switch (c)
2654 { 2658 {
2655 case -1: 2659 case -1:
2656 end_of_file_error (); 2660 end_of_file_error ();
2657 2661
2658 case 'a': 2662 case 'a': chr = '\a'; break;
2659 return '\007'; 2663 case 'b': chr = '\b'; break;
2660 case 'b': 2664 case 'd': chr = 127; break;
2661 return '\b'; 2665 case 'e': chr = 27; break;
2662 case 'd': 2666 case 'f': chr = '\f'; break;
2663 return 0177; 2667 case 'n': chr = '\n'; break;
2664 case 'e': 2668 case 'r': chr = '\r'; break;
2665 return 033; 2669 case 't': chr = '\t'; break;
2666 case 'f': 2670 case 'v': chr = '\v'; break;
2667 return '\f';
2668 case 'n':
2669 return '\n';
2670 case 'r':
2671 return '\r';
2672 case 't':
2673 return '\t';
2674 case 'v':
2675 return '\v';
2676 2671
2677 case '\n': 2672 case '\n':
2678 /* ?\LF is an error; it's probably a user mistake. */ 2673 /* ?\LF is an error; it's probably a user mistake. */
2679 error ("Invalid escape character syntax"); 2674 error ("Invalid escape char syntax: \\<newline>");
2680
2681 case 'M':
2682 c = READCHAR;
2683 if (c != '-')
2684 error ("Invalid escape character syntax");
2685 c = READCHAR;
2686 if (c == '\\')
2687 c = read_escape (readcharfun);
2688 return c | meta_modifier;
2689 2675
2690 case 'S': 2676 /* \M-x etc: set modifier bit and parse the char to which it applies,
2691 c = READCHAR; 2677 allowing for chains such as \M-\S-\A-\H-\s-\C-q. */
2692 if (c != '-') 2678 case 'M': mod = meta_modifier; goto mod_key;
2693 error ("Invalid escape character syntax"); 2679 case 'S': mod = shift_modifier; goto mod_key;
2694 c = READCHAR; 2680 case 'H': mod = hyper_modifier; goto mod_key;
2695 if (c == '\\') 2681 case 'A': mod = alt_modifier; goto mod_key;
2696 c = read_escape (readcharfun); 2682 case 's': mod = super_modifier; goto mod_key;
2697 return c | shift_modifier;
2698 2683
2699 case 'H': 2684 mod_key:
2700 c = READCHAR; 2685 {
2701 if (c != '-') 2686 int c1 = READCHAR;
2702 error ("Invalid escape character syntax"); 2687 if (c1 != '-')
2703 c = READCHAR; 2688 {
2704 if (c == '\\') 2689 if (c == 's')
2705 c = read_escape (readcharfun); 2690 {
2706 return c | hyper_modifier; 2691 /* \s not followed by a hyphen is SPC. */
2707 2692 UNREAD (c1);
2708 case 'A': 2693 chr = ' ';
2709 c = READCHAR; 2694 break;
2710 if (c != '-') 2695 }
2711 error ("Invalid escape character syntax"); 2696 else
2712 c = READCHAR; 2697 /* \M, \S, \H, \A not followed by a hyphen is an error. */
2713 if (c == '\\') 2698 error ("Invalid escape char syntax: \\%c not followed by -", c);
2714 c = read_escape (readcharfun); 2699 }
2715 return c | alt_modifier; 2700 modifiers |= mod;
2716 2701 c1 = READCHAR;
2717 case 's': 2702 if (c1 == '\\')
2718 c = READCHAR; 2703 {
2719 if (c != '-') 2704 next_char = READCHAR;
2720 { 2705 goto again;
2721 UNREAD (c); 2706 }
2722 return ' '; 2707 chr = c1;
2723 } 2708 break;
2724 c = READCHAR; 2709 }
2725 if (c == '\\')
2726 c = read_escape (readcharfun);
2727 return c | super_modifier;
2728 2710
2711 /* Control modifiers (\C-x or \^x) are messy and not actually idempotent.
2712 For example, ?\C-\C-a = ?\C-\001 = 0x4000001.
2713 Keep a count of them and apply them separately. */
2729 case 'C': 2714 case 'C':
2730 c = READCHAR; 2715 {
2731 if (c != '-') 2716 int c1 = READCHAR;
2732 error ("Invalid escape character syntax"); 2717 if (c1 != '-')
2718 error ("Invalid escape char syntax: \\%c not followed by -", c);
2719 }
2733 FALLTHROUGH; 2720 FALLTHROUGH;
2721 /* The prefixes \C- and \^ are equivalent. */
2734 case '^': 2722 case '^':
2735 c = READCHAR;
2736 if (c == '\\')
2737 c = read_escape (readcharfun);
2738 if ((c & ~CHAR_MODIFIER_MASK) == '?')
2739 return 0177 | (c & CHAR_MODIFIER_MASK);
2740 else if (! ASCII_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
2741 return c | ctrl_modifier;
2742 /* ASCII control chars are made from letters (both cases),
2743 as well as the non-letters within 0100...0137. */
2744 else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
2745 return (c & (037 | ~0177));
2746 else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
2747 return (c & (037 | ~0177));
2748 else
2749 return c | ctrl_modifier;
2750
2751 case '0':
2752 case '1':
2753 case '2':
2754 case '3':
2755 case '4':
2756 case '5':
2757 case '6':
2758 case '7':
2759 /* An octal escape, as in ANSI C. */
2760 { 2723 {
2761 register int i = c - '0'; 2724 ncontrol++;
2762 register int count = 0; 2725 int c1 = READCHAR;
2763 while (++count < 3) 2726 if (c1 == '\\')
2764 { 2727 {
2765 if ((c = READCHAR) >= '0' && c <= '7') 2728 next_char = READCHAR;
2766 { 2729 goto again;
2767 i *= 8; 2730 }
2768 i += c - '0'; 2731 chr = c1;
2769 } 2732 break;
2770 else 2733 }
2734
2735 /* 1-3 octal digits. Values in 0x80..0xff are encoded as raw bytes. */
2736 case '0': case '1': case '2': case '3':
2737 case '4': case '5': case '6': case '7':
2738 {
2739 int i = c - '0';
2740 int count = 0;
2741 while (count < 2)
2742 {
2743 int c = READCHAR;
2744 if (c < '0' || c > '7')
2771 { 2745 {
2772 UNREAD (c); 2746 UNREAD (c);
2773 break; 2747 break;
2774 } 2748 }
2749 i = (i << 3) + (c - '0');
2750 count++;
2775 } 2751 }
2776 2752
2777 if (i >= 0x80 && i < 0x100) 2753 if (i >= 0x80 && i < 0x100)
2778 i = BYTE8_TO_CHAR (i); 2754 i = BYTE8_TO_CHAR (i);
2779 return i; 2755 chr = i;
2756 break;
2780 } 2757 }
2781 2758
2759 /* 1 or more hex digits. Values may encode modifiers.
2760 Values in 0x80..0xff using 2 hex digits are encoded as raw bytes. */
2782 case 'x': 2761 case 'x':
2783 /* A hex escape, as in ANSI C. */
2784 { 2762 {
2785 unsigned int i = 0; 2763 unsigned int i = 0;
2786 int count = 0; 2764 int count = 0;
2787 while (1) 2765 while (1)
2788 { 2766 {
2789 c = READCHAR; 2767 int c = READCHAR;
2790 int digit = char_hexdigit (c); 2768 int digit = char_hexdigit (c);
2791 if (digit < 0) 2769 if (digit < 0)
2792 { 2770 {
@@ -2796,40 +2774,37 @@ read_escape (Lisp_Object readcharfun)
2796 i = (i << 4) + digit; 2774 i = (i << 4) + digit;
2797 /* Allow hex escapes as large as ?\xfffffff, because some 2775 /* Allow hex escapes as large as ?\xfffffff, because some
2798 packages use them to denote characters with modifiers. */ 2776 packages use them to denote characters with modifiers. */
2799 if ((CHAR_META | (CHAR_META - 1)) < i) 2777 if (i > (CHAR_META | (CHAR_META - 1)))
2800 error ("Hex character out of range: \\x%x...", i); 2778 error ("Hex character out of range: \\x%x...", i);
2801 count += count < 3; 2779 count += count < 3;
2802 } 2780 }
2803 2781
2782 if (count == 0)
2783 error ("Invalid escape char syntax: \\x not followed by hex digit");
2804 if (count < 3 && i >= 0x80) 2784 if (count < 3 && i >= 0x80)
2805 return BYTE8_TO_CHAR (i); 2785 i = BYTE8_TO_CHAR (i);
2806 return i; 2786 modifiers |= i & CHAR_MODIFIER_MASK;
2787 chr = i & ~CHAR_MODIFIER_MASK;
2788 break;
2807 } 2789 }
2808 2790
2791 /* 8-digit Unicode hex escape: \UHHHHHHHH */
2809 case 'U': 2792 case 'U':
2810 /* Post-Unicode-2.0: Up to eight hex chars. */
2811 unicode_hex_count = 8; 2793 unicode_hex_count = 8;
2812 FALLTHROUGH; 2794 goto unicode_hex;
2813 case 'u':
2814 2795
2815 /* A Unicode escape. We only permit them in strings and characters, 2796 /* 4-digit Unicode hex escape: \uHHHH */
2816 not arbitrarily in the source code, as in some other languages. */ 2797 case 'u':
2798 unicode_hex_count = 4;
2799 unicode_hex:
2817 { 2800 {
2818 unsigned int i = 0; 2801 unsigned int i = 0;
2819 int count = 0; 2802 for (int count = 0; count < unicode_hex_count; count++)
2820
2821 while (++count <= unicode_hex_count)
2822 { 2803 {
2823 c = READCHAR; 2804 int c = READCHAR;
2824 if (c < 0) 2805 if (c < 0)
2825 { 2806 error ("Malformed Unicode escape: \\%c%x",
2826 if (unicode_hex_count > 4) 2807 unicode_hex_count == 4 ? 'u' : 'U', i);
2827 error ("Malformed Unicode escape: \\U%x", i);
2828 else
2829 error ("Malformed Unicode escape: \\u%x", i);
2830 }
2831 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2832 want. */
2833 int digit = char_hexdigit (c); 2808 int digit = char_hexdigit (c);
2834 if (digit < 0) 2809 if (digit < 0)
2835 error ("Non-hex character used for Unicode escape: %c (%d)", 2810 error ("Non-hex character used for Unicode escape: %c (%d)",
@@ -2838,13 +2813,14 @@ read_escape (Lisp_Object readcharfun)
2838 } 2813 }
2839 if (i > 0x10FFFF) 2814 if (i > 0x10FFFF)
2840 error ("Non-Unicode character: 0x%x", i); 2815 error ("Non-Unicode character: 0x%x", i);
2841 return i; 2816 chr = i;
2817 break;
2842 } 2818 }
2843 2819
2820 /* Named character: \N{name} */
2844 case 'N': 2821 case 'N':
2845 /* Named character. */
2846 { 2822 {
2847 c = READCHAR; 2823 int c = READCHAR;
2848 if (c != '{') 2824 if (c != '{')
2849 invalid_syntax ("Expected opening brace after \\N", readcharfun); 2825 invalid_syntax ("Expected opening brace after \\N", readcharfun);
2850 char name[UNICODE_CHARACTER_NAME_LENGTH_BOUND + 1]; 2826 char name[UNICODE_CHARACTER_NAME_LENGTH_BOUND + 1];
@@ -2852,12 +2828,12 @@ read_escape (Lisp_Object readcharfun)
2852 ptrdiff_t length = 0; 2828 ptrdiff_t length = 0;
2853 while (true) 2829 while (true)
2854 { 2830 {
2855 c = READCHAR; 2831 int c = READCHAR;
2856 if (c < 0) 2832 if (c < 0)
2857 end_of_file_error (); 2833 end_of_file_error ();
2858 if (c == '}') 2834 if (c == '}')
2859 break; 2835 break;
2860 if (! (0 < c && c < 0x80)) 2836 if (c >= 0x80)
2861 { 2837 {
2862 AUTO_STRING (format, 2838 AUTO_STRING (format,
2863 "Invalid character U+%04X in character name"); 2839 "Invalid character U+%04X in character name");
@@ -2886,13 +2862,41 @@ read_escape (Lisp_Object readcharfun)
2886 name[length] = '\0'; 2862 name[length] = '\0';
2887 2863
2888 /* character_name_to_code can invoke read0, recursively. 2864 /* character_name_to_code can invoke read0, recursively.
2889 This is why read0's buffer is not static. */ 2865 This is why read0 needs to be re-entrant. */
2890 return character_name_to_code (name, length, readcharfun); 2866 chr = character_name_to_code (name, length, readcharfun);
2867 break;
2891 } 2868 }
2892 2869
2893 default: 2870 default:
2894 return c; 2871 chr = c;
2872 break;
2873 }
2874 eassert (chr >= 0 && chr < (1 << CHARACTERBITS));
2875
2876 /* Apply Control modifiers, using the rules:
2877 \C-X = ascii_ctrl(nomod(X)) | mods(X) if nomod(X) is one of:
2878 A-Z a-z ? @ [ \ ] ^ _
2879
2880 X | ctrl_modifier otherwise
2881
2882 where
2883 nomod(c) = c without modifiers
2884 mods(c) = the modifiers of c
2885 ascii_ctrl(c) = 127 if c = '?'
2886 c & 0x1f otherwise
2887 */
2888 while (ncontrol > 0)
2889 {
2890 if ((chr >= '@' && chr <= '_') || (chr >= 'a' && chr <= 'z'))
2891 chr &= 0x1f;
2892 else if (chr == '?')
2893 chr = 127;
2894 else
2895 modifiers |= ctrl_modifier;
2896 ncontrol--;
2895 } 2897 }
2898
2899 return chr | modifiers;
2896} 2900}
2897 2901
2898/* Return the digit that CHARACTER stands for in the given BASE. 2902/* Return the digit that CHARACTER stands for in the given BASE.
@@ -3014,7 +3018,7 @@ read_char_literal (Lisp_Object readcharfun)
3014 } 3018 }
3015 3019
3016 if (ch == '\\') 3020 if (ch == '\\')
3017 ch = read_escape (readcharfun); 3021 ch = read_char_escape (readcharfun, READCHAR);
3018 3022
3019 int modifiers = ch & CHAR_MODIFIER_MASK; 3023 int modifiers = ch & CHAR_MODIFIER_MASK;
3020 ch &= ~CHAR_MODIFIER_MASK; 3024 ch &= ~CHAR_MODIFIER_MASK;
@@ -3080,8 +3084,7 @@ read_string_literal (Lisp_Object readcharfun)
3080 /* `\SPC' and `\LF' generate no characters at all. */ 3084 /* `\SPC' and `\LF' generate no characters at all. */
3081 continue; 3085 continue;
3082 default: 3086 default:
3083 UNREAD (ch); 3087 ch = read_char_escape (readcharfun, ch);
3084 ch = read_escape (readcharfun);
3085 break; 3088 break;
3086 } 3089 }
3087 3090
@@ -3374,8 +3377,8 @@ read_bool_vector (Lisp_Object readcharfun)
3374 invalid_syntax ("#&", readcharfun); 3377 invalid_syntax ("#&", readcharfun);
3375 break; 3378 break;
3376 } 3379 }
3377 if (INT_MULTIPLY_WRAPV (length, 10, &length) 3380 if (ckd_mul (&length, length, 10)
3378 || INT_ADD_WRAPV (length, c - '0', &length)) 3381 || ckd_add (&length, length, c - '0'))
3379 invalid_syntax ("#&", readcharfun); 3382 invalid_syntax ("#&", readcharfun);
3380 } 3383 }
3381 3384
@@ -3399,8 +3402,9 @@ read_bool_vector (Lisp_Object readcharfun)
3399} 3402}
3400 3403
3401/* Skip (and optionally remember) a lazily-loaded string 3404/* Skip (and optionally remember) a lazily-loaded string
3402 preceded by "#@". */ 3405 preceded by "#@". Return true if this was a normal skip,
3403static void 3406 false if we read #@00 (which skips to EOB/EOF). */
3407static bool
3404skip_lazy_string (Lisp_Object readcharfun) 3408skip_lazy_string (Lisp_Object readcharfun)
3405{ 3409{
3406 ptrdiff_t nskip = 0; 3410 ptrdiff_t nskip = 0;
@@ -3420,15 +3424,15 @@ skip_lazy_string (Lisp_Object readcharfun)
3420 UNREAD (c); 3424 UNREAD (c);
3421 break; 3425 break;
3422 } 3426 }
3423 if (INT_MULTIPLY_WRAPV (nskip, 10, &nskip) 3427 if (ckd_mul (&nskip, nskip, 10)
3424 || INT_ADD_WRAPV (nskip, c - '0', &nskip)) 3428 || ckd_add (&nskip, nskip, c - '0'))
3425 invalid_syntax ("#@", readcharfun); 3429 invalid_syntax ("#@", readcharfun);
3426 digits++; 3430 digits++;
3427 if (digits == 2 && nskip == 0) 3431 if (digits == 2 && nskip == 0)
3428 { 3432 {
3429 /* #@00 means "skip to end" */ 3433 /* #@00 means "read nil and skip to end" */
3430 skip_dyn_eof (readcharfun); 3434 skip_dyn_eof (readcharfun);
3431 return; 3435 return false;
3432 } 3436 }
3433 } 3437 }
3434 3438
@@ -3475,6 +3479,8 @@ skip_lazy_string (Lisp_Object readcharfun)
3475 else 3479 else
3476 /* Skip that many bytes. */ 3480 /* Skip that many bytes. */
3477 skip_dyn_bytes (readcharfun, nskip); 3481 skip_dyn_bytes (readcharfun, nskip);
3482
3483 return true;
3478} 3484}
3479 3485
3480/* Given a lazy-loaded string designator VAL, return the actual string. 3486/* Given a lazy-loaded string designator VAL, return the actual string.
@@ -3932,8 +3938,10 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
3932 /* #@NUMBER is used to skip NUMBER following bytes. 3938 /* #@NUMBER is used to skip NUMBER following bytes.
3933 That's used in .elc files to skip over doc strings 3939 That's used in .elc files to skip over doc strings
3934 and function definitions that can be loaded lazily. */ 3940 and function definitions that can be loaded lazily. */
3935 skip_lazy_string (readcharfun); 3941 if (skip_lazy_string (readcharfun))
3936 goto read_obj; 3942 goto read_obj;
3943 obj = Qnil; /* #@00 skips to EOB/EOF and yields nil. */
3944 break;
3937 3945
3938 case '$': 3946 case '$':
3939 /* #$ -- reference to lazy-loaded string */ 3947 /* #$ -- reference to lazy-loaded string */
@@ -3985,8 +3993,8 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
3985 c = READCHAR; 3993 c = READCHAR;
3986 if (c < '0' || c > '9') 3994 if (c < '0' || c > '9')
3987 break; 3995 break;
3988 if (INT_MULTIPLY_WRAPV (n, 10, &n) 3996 if (ckd_mul (&n, n, 10)
3989 || INT_ADD_WRAPV (n, c - '0', &n)) 3997 || ckd_add (&n, n, c - '0'))
3990 invalid_syntax ("#", readcharfun); 3998 invalid_syntax ("#", readcharfun);
3991 } 3999 }
3992 if (c == 'r' || c == 'R') 4000 if (c == 'r' || c == 'R')
diff --git a/src/macfont.m b/src/macfont.m
index d0cdbcd08c7..9f9f6f4efaf 100644
--- a/src/macfont.m
+++ b/src/macfont.m
@@ -632,21 +632,35 @@ get_cgcolor_from_nscolor (NSColor *nsColor, struct frame *f)
632 632
633#define CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND(context, face) \ 633#define CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND(context, face) \
634 do { \ 634 do { \
635 CGColorRef refcol_ = get_cgcolor (NS_FACE_FOREGROUND (face)); \ 635 CGColorRef refcol = get_cgcolor (NS_FACE_FOREGROUND (face)); \
636 CGContextSetFillColorWithColor (context, refcol_) ; \ 636 CGContextSetFillColorWithColor (context, refcol); \
637 CGColorRelease (refcol_); \ 637 CGColorRelease (refcol); \
638 } while (0) 638 } while (0)
639#define CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND(context, face) \ 639#define CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND(context, face) \
640 do { \ 640 do { \
641 CGColorRef refcol_ = get_cgcolor (NS_FACE_BACKGROUND (face)); \ 641 CGColorRef refcol = get_cgcolor (NS_FACE_BACKGROUND (face)); \
642 CGContextSetFillColorWithColor (context, refcol_); \ 642 CGContextSetFillColorWithColor (context, refcol); \
643 CGColorRelease (refcol_); \ 643 CGColorRelease (refcol); \
644 } while (0)
645#define CG_SET_FILL_COLOR_WITH_FRAME_CURSOR(context, frame) \
646 do { \
647 CGColorRef refcol \
648 = get_cgcolor_from_nscolor (FRAME_CURSOR_COLOR (frame), frame); \
649 CGContextSetFillColorWithColor (context, refcol); \
650 CGColorRelease (refcol); \
651 } while (0)
652#define CG_SET_FILL_COLOR_WITH_FRAME_BACKGROUND(context, frame) \
653 do { \
654 CGColorRef refcol \
655 = get_cgcolor_from_nscolor (FRAME_BACKGROUND_COLOR (frame), frame); \
656 CGContextSetFillColorWithColor (context, refcol); \
657 CGColorRelease (refcol); \
644 } while (0) 658 } while (0)
645#define CG_SET_STROKE_COLOR_WITH_FACE_FOREGROUND(context, face) \ 659#define CG_SET_STROKE_COLOR_WITH_FACE_FOREGROUND(context, face) \
646 do { \ 660 do { \
647 CGColorRef refcol_ = get_cgcolor (NS_FACE_FOREGROUND (face)); \ 661 CGColorRef refcol = get_cgcolor (NS_FACE_FOREGROUND (face)); \
648 CGContextSetStrokeColorWithColor (context, refcol_); \ 662 CGContextSetStrokeColorWithColor (context, refcol); \
649 CGColorRelease (refcol_); \ 663 CGColorRelease (refcol); \
650 } while (0) 664 } while (0)
651 665
652 666
@@ -2933,9 +2947,12 @@ macfont_draw (struct glyph_string *s, int from, int to, int x, int y,
2933 { 2947 {
2934 if (s->hl == DRAW_CURSOR) 2948 if (s->hl == DRAW_CURSOR)
2935 { 2949 {
2936 CGColorRef colorref = get_cgcolor_from_nscolor (FRAME_CURSOR_COLOR (f), f); 2950 if (face && (NS_FACE_BACKGROUND (face)
2937 CGContextSetFillColorWithColor (context, colorref); 2951 == [(NSColor *) FRAME_CURSOR_COLOR (f)
2938 CGColorRelease (colorref); 2952 unsignedLong]))
2953 CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND (context, face);
2954 else
2955 CG_SET_FILL_COLOR_WITH_FRAME_CURSOR (context, f);
2939 } 2956 }
2940 else 2957 else
2941 CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND (context, face); 2958 CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND (context, face);
@@ -2949,9 +2966,12 @@ macfont_draw (struct glyph_string *s, int from, int to, int x, int y,
2949 CGContextScaleCTM (context, 1, -1); 2966 CGContextScaleCTM (context, 1, -1);
2950 if (s->hl == DRAW_CURSOR) 2967 if (s->hl == DRAW_CURSOR)
2951 { 2968 {
2952 CGColorRef colorref = get_cgcolor_from_nscolor (FRAME_BACKGROUND_COLOR (f), f); 2969 if (face && (NS_FACE_BACKGROUND (face)
2953 CGContextSetFillColorWithColor (context, colorref); 2970 == [(NSColor *) FRAME_CURSOR_COLOR (f)
2954 CGColorRelease (colorref); 2971 unsignedLong]))
2972 CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND (context, face);
2973 else
2974 CG_SET_FILL_COLOR_WITH_FRAME_BACKGROUND (context, f);
2955 } 2975 }
2956 else 2976 else
2957 CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND (context, face); 2977 CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND (context, face);
diff --git a/src/nsterm.m b/src/nsterm.m
index 0e75cbf3f0f..3e089cc1ff1 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -2704,11 +2704,12 @@ ns_scroll_run (struct window *w, struct run *run)
2704 { 2704 {
2705 NSRect srcRect = NSMakeRect (x, from_y, width, height); 2705 NSRect srcRect = NSMakeRect (x, from_y, width, height);
2706 NSPoint dest = NSMakePoint (x, to_y); 2706 NSPoint dest = NSMakePoint (x, to_y);
2707 NSRect destRect = NSMakeRect (x, from_y, width, height);
2707 EmacsView *view = FRAME_NS_VIEW (f); 2708 EmacsView *view = FRAME_NS_VIEW (f);
2708 2709
2709 [view copyRect:srcRect to:dest]; 2710 [view copyRect:srcRect to:dest];
2710#ifdef NS_IMPL_COCOA 2711#ifdef NS_IMPL_COCOA
2711 [view setNeedsDisplayInRect:srcRect]; 2712 [view setNeedsDisplayInRect:destRect];
2712#endif 2713#endif
2713 } 2714 }
2714 2715
@@ -3750,14 +3751,18 @@ ns_maybe_dumpglyphs_background (struct glyph_string *s, char force_p)
3750 { 3751 {
3751 struct face *face = s->face; 3752 struct face *face = s->face;
3752 if (!face->stipple) 3753 if (!face->stipple)
3753 { 3754 {
3754 if (s->hl != DRAW_CURSOR) 3755 if (s->hl != DRAW_CURSOR)
3755 [(NS_FACE_BACKGROUND (face) != 0 3756 [(NS_FACE_BACKGROUND (face) != 0
3756 ? [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)] 3757 ? [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)]
3757 : FRAME_BACKGROUND_COLOR (s->f)) set]; 3758 : FRAME_BACKGROUND_COLOR (s->f)) set];
3758 else 3759 else if (face && (NS_FACE_BACKGROUND (face)
3759 [FRAME_CURSOR_COLOR (s->f) set]; 3760 == [(NSColor *) FRAME_CURSOR_COLOR (s->f)
3760 } 3761 unsignedLong]))
3762 [[NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (face)] set];
3763 else
3764 [FRAME_CURSOR_COLOR (s->f) set];
3765 }
3761 else 3766 else
3762 { 3767 {
3763 struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f); 3768 struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f);
@@ -4603,7 +4608,7 @@ ns_send_appdefined (int value)
4603 4608
4604#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 4609#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
4605static void 4610static void
4606check_native_fs () 4611check_native_fs (void)
4607{ 4612{
4608 Lisp_Object frame, tail; 4613 Lisp_Object frame, tail;
4609 4614
@@ -7926,6 +7931,10 @@ ns_in_echo_area (void)
7926 [self setLayerContentsRedrawPolicy: 7931 [self setLayerContentsRedrawPolicy:
7927 NSViewLayerContentsRedrawOnSetNeedsDisplay]; 7932 NSViewLayerContentsRedrawOnSetNeedsDisplay];
7928 [self setLayerContentsPlacement:NSViewLayerContentsPlacementTopLeft]; 7933 [self setLayerContentsPlacement:NSViewLayerContentsPlacementTopLeft];
7934
7935 /* initWithEmacsFrame can't create the toolbar before the layer is
7936 set, so have another go at creating the toolbar here. */
7937 [(EmacsWindow*)[self window] createToolbar:f];
7929#endif 7938#endif
7930 7939
7931 if (ns_drag_types) 7940 if (ns_drag_types)
@@ -8573,6 +8582,10 @@ ns_in_echo_area (void)
8573 return self; 8582 return self;
8574} 8583}
8575 8584
8585- (BOOL) validateToolbarItem: (NSToolbarItem *) toolbarItem
8586{
8587 return [toolbarItem isEnabled];
8588}
8576 8589
8577- (instancetype)toggleToolbar: (id)sender 8590- (instancetype)toggleToolbar: (id)sender
8578{ 8591{
@@ -9166,11 +9179,18 @@ ns_in_echo_area (void)
9166 9179
9167- (void)createToolbar: (struct frame *)f 9180- (void)createToolbar: (struct frame *)f
9168{ 9181{
9169 if (FRAME_UNDECORATED (f) || !FRAME_EXTERNAL_TOOL_BAR (f)) 9182 if (FRAME_UNDECORATED (f) || !FRAME_EXTERNAL_TOOL_BAR (f) || [self toolbar] != nil)
9170 return; 9183 return;
9171 9184
9172 EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); 9185 EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
9173 9186
9187#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED >= 101400
9188 /* If the view's layer isn't an EmacsLayer then we can't create the
9189 toolbar yet. */
9190 if (! [[view layer] isKindOfClass:[EmacsLayer class]])
9191 return;
9192#endif
9193
9174 EmacsToolbar *toolbar = [[EmacsToolbar alloc] 9194 EmacsToolbar *toolbar = [[EmacsToolbar alloc]
9175 initForView:view 9195 initForView:view
9176 withIdentifier:[NSString stringWithFormat:@"%p", f]]; 9196 withIdentifier:[NSString stringWithFormat:@"%p", f]];
diff --git a/src/pdumper.c b/src/pdumper.c
index c79e32b971b..5ef077e09f2 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -103,7 +103,6 @@ verify (sizeof (intptr_t) == sizeof (ptrdiff_t));
103verify (sizeof (void (*) (void)) == sizeof (void *)); 103verify (sizeof (void (*) (void)) == sizeof (void *));
104verify (sizeof (ptrdiff_t) <= sizeof (Lisp_Object)); 104verify (sizeof (ptrdiff_t) <= sizeof (Lisp_Object));
105verify (sizeof (ptrdiff_t) <= sizeof (EMACS_INT)); 105verify (sizeof (ptrdiff_t) <= sizeof (EMACS_INT));
106verify (CHAR_BIT == 8);
107 106
108static size_t 107static size_t
109divide_round_up (size_t x, size_t y) 108divide_round_up (size_t x, size_t y)
@@ -133,6 +132,7 @@ static int nr_remembered_data = 0;
133typedef int_least32_t dump_off; 132typedef int_least32_t dump_off;
134#define DUMP_OFF_MIN INT_LEAST32_MIN 133#define DUMP_OFF_MIN INT_LEAST32_MIN
135#define DUMP_OFF_MAX INT_LEAST32_MAX 134#define DUMP_OFF_MAX INT_LEAST32_MAX
135#define DUMP_OFF_WIDTH INT_LEAST32_WIDTH
136#define PRIdDUMP_OFF PRIdLEAST32 136#define PRIdDUMP_OFF PRIdLEAST32
137 137
138enum { EMACS_INT_XDIGITS = (EMACS_INT_WIDTH + 3) / 4 }; 138enum { EMACS_INT_XDIGITS = (EMACS_INT_WIDTH + 3) / 4 };
@@ -222,8 +222,7 @@ enum emacs_reloc_type
222enum 222enum
223 { 223 {
224 EMACS_RELOC_TYPE_BITS = 3, 224 EMACS_RELOC_TYPE_BITS = 3,
225 EMACS_RELOC_LENGTH_BITS = (sizeof (dump_off) * CHAR_BIT 225 EMACS_RELOC_LENGTH_BITS = DUMP_OFF_WIDTH - EMACS_RELOC_TYPE_BITS
226 - EMACS_RELOC_TYPE_BITS)
227 }; 226 };
228 227
229struct emacs_reloc 228struct emacs_reloc
@@ -273,7 +272,7 @@ enum
273 dump. Always suitable for heap objects; may be more aligned. */ 272 dump. Always suitable for heap objects; may be more aligned. */
274 DUMP_ALIGNMENT = max (GCALIGNMENT, DUMP_RELOCATION_ALIGNMENT), 273 DUMP_ALIGNMENT = max (GCALIGNMENT, DUMP_RELOCATION_ALIGNMENT),
275 274
276 DUMP_RELOC_OFFSET_BITS = sizeof (dump_off) * CHAR_BIT - DUMP_RELOC_TYPE_BITS 275 DUMP_RELOC_OFFSET_BITS = DUMP_OFF_WIDTH - DUMP_RELOC_TYPE_BITS
277 }; 276 };
278 277
279verify (RELOC_DUMP_TO_EMACS_LV + 8 < (1 << DUMP_RELOC_TYPE_BITS)); 278verify (RELOC_DUMP_TO_EMACS_LV + 8 < (1 << DUMP_RELOC_TYPE_BITS));
@@ -2459,10 +2458,10 @@ dump_symbol (struct dump_context *ctx,
2459 Lisp_Object object, 2458 Lisp_Object object,
2460 dump_off offset) 2459 dump_off offset)
2461{ 2460{
2462#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_999DC26DEC 2461#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_61B174C9F4
2463# error "Lisp_Symbol changed. See CHECK_STRUCTS comment in config.h." 2462# error "Lisp_Symbol changed. See CHECK_STRUCTS comment in config.h."
2464#endif 2463#endif
2465#if CHECK_STRUCTS && !defined (HASH_symbol_redirect_ADB4F5B113) 2464#if CHECK_STRUCTS && !defined (HASH_symbol_redirect_EA72E4BFF5)
2466# error "symbol_redirect changed. See CHECK_STRUCTS comment in config.h." 2465# error "symbol_redirect changed. See CHECK_STRUCTS comment in config.h."
2467#endif 2466#endif
2468 2467
@@ -5001,6 +5000,7 @@ dump_mmap_contiguous (struct dump_memory_map *maps, int nr_maps)
5001} 5000}
5002 5001
5003typedef uint_fast32_t dump_bitset_word; 5002typedef uint_fast32_t dump_bitset_word;
5003#define DUMP_BITSET_WORD_WIDTH UINT_FAST32_WIDTH
5004 5004
5005struct dump_bitset 5005struct dump_bitset
5006{ 5006{
@@ -5011,9 +5011,9 @@ struct dump_bitset
5011static bool 5011static bool
5012dump_bitsets_init (struct dump_bitset bitset[2], size_t number_bits) 5012dump_bitsets_init (struct dump_bitset bitset[2], size_t number_bits)
5013{ 5013{
5014 int xword_size = sizeof (bitset[0].bits[0]); 5014 int xword_size = sizeof (dump_bitset_word);
5015 int bits_per_word = xword_size * CHAR_BIT; 5015 ptrdiff_t words_needed = divide_round_up (number_bits,
5016 ptrdiff_t words_needed = divide_round_up (number_bits, bits_per_word); 5016 DUMP_BITSET_WORD_WIDTH);
5017 dump_bitset_word *bits = calloc (words_needed, 2 * xword_size); 5017 dump_bitset_word *bits = calloc (words_needed, 2 * xword_size);
5018 if (!bits) 5018 if (!bits)
5019 return false; 5019 return false;
@@ -5028,9 +5028,7 @@ static dump_bitset_word *
5028dump_bitset__bit_slot (const struct dump_bitset *bitset, 5028dump_bitset__bit_slot (const struct dump_bitset *bitset,
5029 size_t bit_number) 5029 size_t bit_number)
5030{ 5030{
5031 int xword_size = sizeof (bitset->bits[0]); 5031 ptrdiff_t word_number = bit_number / DUMP_BITSET_WORD_WIDTH;
5032 int bits_per_word = xword_size * CHAR_BIT;
5033 ptrdiff_t word_number = bit_number / bits_per_word;
5034 eassert (word_number < bitset->number_words); 5032 eassert (word_number < bitset->number_words);
5035 return &bitset->bits[word_number]; 5033 return &bitset->bits[word_number];
5036} 5034}
@@ -5039,10 +5037,8 @@ static bool
5039dump_bitset_bit_set_p (const struct dump_bitset *bitset, 5037dump_bitset_bit_set_p (const struct dump_bitset *bitset,
5040 size_t bit_number) 5038 size_t bit_number)
5041{ 5039{
5042 unsigned xword_size = sizeof (bitset->bits[0]);
5043 unsigned bits_per_word = xword_size * CHAR_BIT;
5044 dump_bitset_word bit = 1; 5040 dump_bitset_word bit = 1;
5045 bit <<= bit_number % bits_per_word; 5041 bit <<= bit_number % DUMP_BITSET_WORD_WIDTH;
5046 return *dump_bitset__bit_slot (bitset, bit_number) & bit; 5042 return *dump_bitset__bit_slot (bitset, bit_number) & bit;
5047} 5043}
5048 5044
@@ -5051,11 +5047,9 @@ dump_bitset__set_bit_value (struct dump_bitset *bitset,
5051 size_t bit_number, 5047 size_t bit_number,
5052 bool bit_is_set) 5048 bool bit_is_set)
5053{ 5049{
5054 int xword_size = sizeof (bitset->bits[0]);
5055 int bits_per_word = xword_size * CHAR_BIT;
5056 dump_bitset_word *slot = dump_bitset__bit_slot (bitset, bit_number); 5050 dump_bitset_word *slot = dump_bitset__bit_slot (bitset, bit_number);
5057 dump_bitset_word bit = 1; 5051 dump_bitset_word bit = 1;
5058 bit <<= bit_number % bits_per_word; 5052 bit <<= bit_number % DUMP_BITSET_WORD_WIDTH;
5059 if (bit_is_set) 5053 if (bit_is_set)
5060 *slot = *slot | bit; 5054 *slot = *slot | bit;
5061 else 5055 else
diff --git a/src/pgtkfns.c b/src/pgtkfns.c
index 6e5bb22375a..801f97d26d2 100644
--- a/src/pgtkfns.c
+++ b/src/pgtkfns.c
@@ -398,13 +398,6 @@ pgtk_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name)
398 pgtk_set_name_internal (f, name); 398 pgtk_set_name_internal (f, name);
399} 399}
400 400
401
402void
403pgtk_set_doc_edited (void)
404{
405}
406
407
408static void 401static void
409pgtk_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) 402pgtk_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
410{ 403{
diff --git a/src/pgtkterm.c b/src/pgtkterm.c
index c00e13550bd..91e4d828f51 100644
--- a/src/pgtkterm.c
+++ b/src/pgtkterm.c
@@ -376,6 +376,13 @@ mark_pgtkterm (void)
376 for (i = 0; i < n; i++) 376 for (i = 0; i < n; i++)
377 { 377 {
378 union buffered_input_event *ev = &evq->q[i]; 378 union buffered_input_event *ev = &evq->q[i];
379
380 /* Selection requests don't have Lisp object members. */
381
382 if (ev->ie.kind == SELECTION_REQUEST_EVENT
383 || ev->ie.kind == SELECTION_CLEAR_EVENT)
384 continue;
385
379 mark_object (ev->ie.x); 386 mark_object (ev->ie.x);
380 mark_object (ev->ie.y); 387 mark_object (ev->ie.y);
381 mark_object (ev->ie.frame_or_window); 388 mark_object (ev->ie.frame_or_window);
@@ -4954,22 +4961,19 @@ pgtk_clear_under_internal_border (struct frame *f)
4954 4961
4955 if (face) 4962 if (face)
4956 { 4963 {
4957#define x_fill_rectangle(f, gc, x, y, w, h) \ 4964 fill_background_by_face (f, face, 0, margin, width, border);
4958 fill_background_by_face (f, face, x, y, w, h) 4965 fill_background_by_face (f, face, 0, 0, border, height);
4959 x_fill_rectangle (f, gc, 0, margin, width, border); 4966 fill_background_by_face (f, face, width - border, 0, border,
4960 x_fill_rectangle (f, gc, 0, 0, border, height); 4967 height);
4961 x_fill_rectangle (f, gc, width - border, 0, border, height); 4968 fill_background_by_face (f, face, 0, height - border, width,
4962 x_fill_rectangle (f, gc, 0, height - border, width, border); 4969 border);
4963#undef x_fill_rectangle
4964 } 4970 }
4965 else 4971 else
4966 { 4972 {
4967#define x_clear_area(f, x, y, w, h) pgtk_clear_area (f, x, y, w, h) 4973 pgtk_clear_area (f, 0, 0, border, height);
4968 x_clear_area (f, 0, 0, border, height); 4974 pgtk_clear_area (f, 0, margin, width, border);
4969 x_clear_area (f, 0, margin, width, border); 4975 pgtk_clear_area (f, width - border, 0, border, height);
4970 x_clear_area (f, width - border, 0, border, height); 4976 pgtk_clear_area (f, 0, height - border, width, border);
4971 x_clear_area (f, 0, height - border, width, border);
4972#undef x_clear_area
4973 } 4977 }
4974 4978
4975 unblock_input (); 4979 unblock_input ();
@@ -6835,8 +6839,7 @@ pgtk_term_init (Lisp_Object display_name, char *resource_name)
6835 6839
6836 Lisp_Object system_name = Fsystem_name (); 6840 Lisp_Object system_name = Fsystem_name ();
6837 ptrdiff_t nbytes; 6841 ptrdiff_t nbytes;
6838 if (INT_ADD_WRAPV (SBYTES (Vinvocation_name), SBYTES (system_name) + 2, 6842 if (ckd_add (&nbytes, SBYTES (Vinvocation_name), SBYTES (system_name) + 2))
6839 &nbytes))
6840 memory_full (SIZE_MAX); 6843 memory_full (SIZE_MAX);
6841 dpyinfo->x_id = ++x_display_id; 6844 dpyinfo->x_id = ++x_display_id;
6842 dpyinfo->x_id_name = xmalloc (nbytes); 6845 dpyinfo->x_id_name = xmalloc (nbytes);
diff --git a/src/pgtkterm.h b/src/pgtkterm.h
index 202c6622ce3..8f2f00efdad 100644
--- a/src/pgtkterm.h
+++ b/src/pgtkterm.h
@@ -553,7 +553,6 @@ extern void pgtk_clear_frame (struct frame *);
553extern char *pgtk_xlfd_to_fontname (const char *); 553extern char *pgtk_xlfd_to_fontname (const char *);
554 554
555/* Implemented in pgtkfns.c. */ 555/* Implemented in pgtkfns.c. */
556extern void pgtk_set_doc_edited (void);
557extern const char *pgtk_get_defaults_value (const char *); 556extern const char *pgtk_get_defaults_value (const char *);
558extern const char *pgtk_get_string_resource (XrmDatabase, const char *, const char *); 557extern const char *pgtk_get_string_resource (XrmDatabase, const char *, const char *);
559extern void pgtk_implicitly_set_name (struct frame *, Lisp_Object, Lisp_Object); 558extern void pgtk_implicitly_set_name (struct frame *, Lisp_Object, Lisp_Object);
diff --git a/src/print.c b/src/print.c
index e65b4c40b0e..5c95aeb9a20 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2202,9 +2202,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
2202 char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT), 2202 char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT),
2203 max (sizeof " . #" + INT_STRLEN_BOUND (intmax_t), 2203 max (sizeof " . #" + INT_STRLEN_BOUND (intmax_t),
2204 max ((sizeof " with data 0x" 2204 max ((sizeof " with data 0x"
2205 + (sizeof (uintmax_t) * CHAR_BIT + 4 - 1) / 4), 2205 + (UINTMAX_WIDTH + 4 - 1) / 4),
2206 40)))]; 2206 40)))];
2207 current_thread->stack_top = buf; 2207 current_thread->stack_top = NEAR_STACK_TOP (buf);
2208 2208
2209 print_obj: 2209 print_obj:
2210 maybe_quit (); 2210 maybe_quit ();
diff --git a/src/profiler.c b/src/profiler.c
index 8247b2e90c6..6217071ef9c 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -49,7 +49,13 @@ static const struct hash_table_test hashtest_profiler =
49 hashfn_profiler, 49 hashfn_profiler,
50 }; 50 };
51 51
52static Lisp_Object 52struct profiler_log {
53 Lisp_Object log;
54 EMACS_INT gc_count; /* Samples taken during GC. */
55 EMACS_INT discarded; /* Samples evicted during table overflow. */
56};
57
58static struct profiler_log
53make_log (void) 59make_log (void)
54{ 60{
55 /* We use a standard Elisp hash-table object, but we use it in 61 /* We use a standard Elisp hash-table object, but we use it in
@@ -60,11 +66,13 @@ make_log (void)
60 = clip_to_bounds (0, profiler_log_size, MOST_POSITIVE_FIXNUM); 66 = clip_to_bounds (0, profiler_log_size, MOST_POSITIVE_FIXNUM);
61 ptrdiff_t max_stack_depth 67 ptrdiff_t max_stack_depth
62 = clip_to_bounds (0, profiler_max_stack_depth, PTRDIFF_MAX);; 68 = clip_to_bounds (0, profiler_max_stack_depth, PTRDIFF_MAX);;
63 Lisp_Object log = make_hash_table (hashtest_profiler, heap_size, 69 struct profiler_log log
64 DEFAULT_REHASH_SIZE, 70 = { make_hash_table (hashtest_profiler, heap_size,
65 DEFAULT_REHASH_THRESHOLD, 71 DEFAULT_REHASH_SIZE,
66 Qnil, false); 72 DEFAULT_REHASH_THRESHOLD,
67 struct Lisp_Hash_Table *h = XHASH_TABLE (log); 73 Qnil, false),
74 0, 0 };
75 struct Lisp_Hash_Table *h = XHASH_TABLE (log.log);
68 76
69 /* What is special about our hash-tables is that the values are pre-filled 77 /* What is special about our hash-tables is that the values are pre-filled
70 with the vectors we'll use as keys. */ 78 with the vectors we'll use as keys. */
@@ -116,8 +124,9 @@ static EMACS_INT approximate_median (log_t *log,
116 } 124 }
117} 125}
118 126
119static void evict_lower_half (log_t *log) 127static void evict_lower_half (struct profiler_log *plog)
120{ 128{
129 log_t *log = XHASH_TABLE (plog->log);
121 ptrdiff_t size = ASIZE (log->key_and_value) / 2; 130 ptrdiff_t size = ASIZE (log->key_and_value) / 2;
122 EMACS_INT median = approximate_median (log, 0, size); 131 EMACS_INT median = approximate_median (log, 0, size);
123 132
@@ -127,6 +136,8 @@ static void evict_lower_half (log_t *log)
127 if (XFIXNUM (HASH_VALUE (log, i)) <= median) 136 if (XFIXNUM (HASH_VALUE (log, i)) <= median)
128 { 137 {
129 Lisp_Object key = HASH_KEY (log, i); 138 Lisp_Object key = HASH_KEY (log, i);
139 EMACS_INT count = XFIXNUM (HASH_VALUE (log, i));
140 plog->discarded = saturated_add (plog->discarded, count);
130 { /* FIXME: we could make this more efficient. */ 141 { /* FIXME: we could make this more efficient. */
131 Lisp_Object tmp; 142 Lisp_Object tmp;
132 XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */ 143 XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */
@@ -148,12 +159,12 @@ static void evict_lower_half (log_t *log)
148 size for memory. */ 159 size for memory. */
149 160
150static void 161static void
151record_backtrace (log_t *log, EMACS_INT count) 162record_backtrace (struct profiler_log *plog, EMACS_INT count)
152{ 163{
164 eassert (HASH_TABLE_P (plog->log));
165 log_t *log = XHASH_TABLE (plog->log);
153 if (log->next_free < 0) 166 if (log->next_free < 0)
154 /* FIXME: transfer the evicted counts to a special entry rather 167 evict_lower_half (plog);
155 than dropping them on the floor. */
156 evict_lower_half (log);
157 ptrdiff_t index = log->next_free; 168 ptrdiff_t index = log->next_free;
158 169
159 /* Get a "working memory" vector. */ 170 /* Get a "working memory" vector. */
@@ -222,10 +233,10 @@ static enum profiler_cpu_running
222 profiler_cpu_running; 233 profiler_cpu_running;
223 234
224/* Hash-table log of CPU profiler. */ 235/* Hash-table log of CPU profiler. */
225static Lisp_Object cpu_log; 236static struct profiler_log cpu;
226 237
227/* Separate counter for the time spent in the GC. */ 238/* Hash-table log of Memory profiler. */
228static EMACS_INT cpu_gc_count; 239static struct profiler_log memory;
229 240
230/* The current sampling interval in nanoseconds. */ 241/* The current sampling interval in nanoseconds. */
231static EMACS_INT current_sampling_interval; 242static EMACS_INT current_sampling_interval;
@@ -233,30 +244,34 @@ static EMACS_INT current_sampling_interval;
233/* Signal handler for sampling profiler. */ 244/* Signal handler for sampling profiler. */
234 245
235static void 246static void
236handle_profiler_signal (int signal) 247add_sample (struct profiler_log *plog, EMACS_INT count)
237{ 248{
238 if (EQ (backtrace_top_function (), QAutomatic_GC)) 249 if (EQ (backtrace_top_function (), QAutomatic_GC)) /* bug#60237 */
239 /* Special case the time-count inside GC because the hash-table 250 /* Special case the time-count inside GC because the hash-table
240 code is not prepared to be used while the GC is running. 251 code is not prepared to be used while the GC is running.
241 More specifically it uses ASIZE at many places where it does 252 More specifically it uses ASIZE at many places where it does
242 not expect the ARRAY_MARK_FLAG to be set. We could try and 253 not expect the ARRAY_MARK_FLAG to be set. We could try and
243 harden the hash-table code, but it doesn't seem worth the 254 harden the hash-table code, but it doesn't seem worth the
244 effort. */ 255 effort. */
245 cpu_gc_count = saturated_add (cpu_gc_count, 1); 256 plog->gc_count = saturated_add (plog->gc_count, count);
246 else 257 else
247 { 258 record_backtrace (plog, count);
248 EMACS_INT count = 1; 259}
260
261
262static void
263handle_profiler_signal (int signal)
264{
265 EMACS_INT count = 1;
249#if defined HAVE_ITIMERSPEC && defined HAVE_TIMER_GETOVERRUN 266#if defined HAVE_ITIMERSPEC && defined HAVE_TIMER_GETOVERRUN
250 if (profiler_timer_ok) 267 if (profiler_timer_ok)
251 { 268 {
252 int overruns = timer_getoverrun (profiler_timer); 269 int overruns = timer_getoverrun (profiler_timer);
253 eassert (overruns >= 0); 270 eassert (overruns >= 0);
254 count += overruns; 271 count += overruns;
255 }
256#endif
257 eassert (HASH_TABLE_P (cpu_log));
258 record_backtrace (XHASH_TABLE (cpu_log), count);
259 } 272 }
273#endif
274 add_sample (&cpu, count);
260} 275}
261 276
262static void 277static void
@@ -343,11 +358,8 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */)
343 if (profiler_cpu_running) 358 if (profiler_cpu_running)
344 error ("CPU profiler is already running"); 359 error ("CPU profiler is already running");
345 360
346 if (NILP (cpu_log)) 361 if (NILP (cpu.log))
347 { 362 cpu = make_log ();
348 cpu_gc_count = 0;
349 cpu_log = make_log ();
350 }
351 363
352 int status = setup_cpu_timer (sampling_interval); 364 int status = setup_cpu_timer (sampling_interval);
353 if (status < 0) 365 if (status < 0)
@@ -409,6 +421,26 @@ DEFUN ("profiler-cpu-running-p",
409 return profiler_cpu_running ? Qt : Qnil; 421 return profiler_cpu_running ? Qt : Qnil;
410} 422}
411 423
424static Lisp_Object
425export_log (struct profiler_log *log)
426{
427 Lisp_Object result = log->log;
428 if (log->gc_count)
429 Fputhash (CALLN (Fvector, QAutomatic_GC, Qnil),
430 make_fixnum (log->gc_count),
431 result);
432 if (log->discarded)
433 Fputhash (CALLN (Fvector, QDiscarded_Samples, Qnil),
434 make_fixnum (log->discarded),
435 result);
436 /* Here we're making the log visible to Elisp, so it's not safe any
437 more for our use afterwards since we can't rely on its special
438 pre-allocated keys anymore. So we have to allocate a new one. */
439 if (profiler_cpu_running)
440 *log = make_log ();
441 return result;
442}
443
412DEFUN ("profiler-cpu-log", Fprofiler_cpu_log, Sprofiler_cpu_log, 444DEFUN ("profiler-cpu-log", Fprofiler_cpu_log, Sprofiler_cpu_log,
413 0, 0, 0, 445 0, 0, 0,
414 doc: /* Return the current cpu profiler log. 446 doc: /* Return the current cpu profiler log.
@@ -418,16 +450,7 @@ of functions, where the last few elements may be nil.
418Before returning, a new log is allocated for future samples. */) 450Before returning, a new log is allocated for future samples. */)
419 (void) 451 (void)
420{ 452{
421 Lisp_Object result = cpu_log; 453 return (export_log (&cpu));
422 /* Here we're making the log visible to Elisp, so it's not safe any
423 more for our use afterwards since we can't rely on its special
424 pre-allocated keys anymore. So we have to allocate a new one. */
425 cpu_log = profiler_cpu_running ? make_log () : Qnil;
426 Fputhash (make_vector (1, QAutomatic_GC),
427 make_fixnum (cpu_gc_count),
428 result);
429 cpu_gc_count = 0;
430 return result;
431} 454}
432#endif /* PROFILER_CPU_SUPPORT */ 455#endif /* PROFILER_CPU_SUPPORT */
433 456
@@ -436,8 +459,6 @@ Before returning, a new log is allocated for future samples. */)
436/* True if memory profiler is running. */ 459/* True if memory profiler is running. */
437bool profiler_memory_running; 460bool profiler_memory_running;
438 461
439static Lisp_Object memory_log;
440
441DEFUN ("profiler-memory-start", Fprofiler_memory_start, Sprofiler_memory_start, 462DEFUN ("profiler-memory-start", Fprofiler_memory_start, Sprofiler_memory_start,
442 0, 0, 0, 463 0, 0, 0,
443 doc: /* Start/restart the memory profiler. 464 doc: /* Start/restart the memory profiler.
@@ -450,8 +471,8 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */)
450 if (profiler_memory_running) 471 if (profiler_memory_running)
451 error ("Memory profiler is already running"); 472 error ("Memory profiler is already running");
452 473
453 if (NILP (memory_log)) 474 if (NILP (memory.log))
454 memory_log = make_log (); 475 memory = make_log ();
455 476
456 profiler_memory_running = true; 477 profiler_memory_running = true;
457 478
@@ -490,12 +511,7 @@ of functions, where the last few elements may be nil.
490Before returning, a new log is allocated for future samples. */) 511Before returning, a new log is allocated for future samples. */)
491 (void) 512 (void)
492{ 513{
493 Lisp_Object result = memory_log; 514 return (export_log (&memory));
494 /* Here we're making the log visible to Elisp , so it's not safe any
495 more for our use afterwards since we can't rely on its special
496 pre-allocated keys anymore. So we have to allocate a new one. */
497 memory_log = profiler_memory_running ? make_log () : Qnil;
498 return result;
499} 515}
500 516
501 517
@@ -505,11 +521,7 @@ Before returning, a new log is allocated for future samples. */)
505void 521void
506malloc_probe (size_t size) 522malloc_probe (size_t size)
507{ 523{
508 if (EQ (backtrace_top_function (), QAutomatic_GC)) /* bug#60237 */ 524 add_sample (&memory, min (size, MOST_POSITIVE_FIXNUM));
509 /* FIXME: We should do something like what we did with `cpu_gc_count`. */
510 return;
511 eassert (HASH_TABLE_P (memory_log));
512 record_backtrace (XHASH_TABLE (memory_log), min (size, MOST_POSITIVE_FIXNUM));
513} 525}
514 526
515DEFUN ("function-equal", Ffunction_equal, Sfunction_equal, 2, 2, 0, 527DEFUN ("function-equal", Ffunction_equal, Sfunction_equal, 2, 2, 0,
@@ -589,21 +601,22 @@ to make room for new entries. */);
589 profiler_log_size = 10000; 601 profiler_log_size = 10000;
590 602
591 DEFSYM (Qprofiler_backtrace_equal, "profiler-backtrace-equal"); 603 DEFSYM (Qprofiler_backtrace_equal, "profiler-backtrace-equal");
604 DEFSYM (QDiscarded_Samples, "Discarded Samples");
592 605
593 defsubr (&Sfunction_equal); 606 defsubr (&Sfunction_equal);
594 607
595#ifdef PROFILER_CPU_SUPPORT 608#ifdef PROFILER_CPU_SUPPORT
596 profiler_cpu_running = NOT_RUNNING; 609 profiler_cpu_running = NOT_RUNNING;
597 cpu_log = Qnil; 610 cpu.log = Qnil;
598 staticpro (&cpu_log); 611 staticpro (&cpu.log);
599 defsubr (&Sprofiler_cpu_start); 612 defsubr (&Sprofiler_cpu_start);
600 defsubr (&Sprofiler_cpu_stop); 613 defsubr (&Sprofiler_cpu_stop);
601 defsubr (&Sprofiler_cpu_running_p); 614 defsubr (&Sprofiler_cpu_running_p);
602 defsubr (&Sprofiler_cpu_log); 615 defsubr (&Sprofiler_cpu_log);
603#endif 616#endif
604 profiler_memory_running = false; 617 profiler_memory_running = false;
605 memory_log = Qnil; 618 memory.log = Qnil;
606 staticpro (&memory_log); 619 staticpro (&memory.log);
607 defsubr (&Sprofiler_memory_start); 620 defsubr (&Sprofiler_memory_start);
608 defsubr (&Sprofiler_memory_stop); 621 defsubr (&Sprofiler_memory_stop);
609 defsubr (&Sprofiler_memory_running_p); 622 defsubr (&Sprofiler_memory_running_p);
@@ -618,16 +631,16 @@ syms_of_profiler_for_pdumper (void)
618 if (dumped_with_pdumper_p ()) 631 if (dumped_with_pdumper_p ())
619 { 632 {
620#ifdef PROFILER_CPU_SUPPORT 633#ifdef PROFILER_CPU_SUPPORT
621 cpu_log = Qnil; 634 cpu.log = Qnil;
622#endif 635#endif
623 memory_log = Qnil; 636 memory.log = Qnil;
624 } 637 }
625 else 638 else
626 { 639 {
627#ifdef PROFILER_CPU_SUPPORT 640#ifdef PROFILER_CPU_SUPPORT
628 eassert (NILP (cpu_log)); 641 eassert (NILP (cpu.log));
629#endif 642#endif
630 eassert (NILP (memory_log)); 643 eassert (NILP (memory.log));
631 } 644 }
632 645
633} 646}
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index 2571812cb39..e3237cd425a 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -47,13 +47,6 @@
47/* Make syntax table lookup grant data in gl_state. */ 47/* Make syntax table lookup grant data in gl_state. */
48#define SYNTAX(c) syntax_property (c, 1) 48#define SYNTAX(c) syntax_property (c, 1)
49 49
50/* Convert the pointer to the char to BEG-based offset from the start. */
51#define PTR_TO_OFFSET(d) POS_AS_IN_BUFFER (POINTER_TO_OFFSET (d))
52/* Strings are 0-indexed, buffers are 1-indexed; pun on the boolean
53 result to get the right base index. */
54#define POS_AS_IN_BUFFER(p) \
55 ((p) + (NILP (gl_state.object) || BUFFERP (gl_state.object)))
56
57#define RE_MULTIBYTE_P(bufp) ((bufp)->multibyte) 50#define RE_MULTIBYTE_P(bufp) ((bufp)->multibyte)
58#define RE_TARGET_MULTIBYTE_P(bufp) ((bufp)->target_multibyte) 51#define RE_TARGET_MULTIBYTE_P(bufp) ((bufp)->target_multibyte)
59#define RE_STRING_CHAR(p, multibyte) \ 52#define RE_STRING_CHAR(p, multibyte) \
@@ -2209,9 +2202,8 @@ regex_compile (re_char *pattern, ptrdiff_t size,
2209 FALLTHROUGH; 2202 FALLTHROUGH;
2210 case '1': case '2': case '3': case '4': 2203 case '1': case '2': case '3': case '4':
2211 case '5': case '6': case '7': case '8': case '9': 2204 case '5': case '6': case '7': case '8': case '9':
2212 if (INT_MULTIPLY_WRAPV (regnum, 10, &regnum) 2205 if (ckd_mul (&regnum, regnum, 10)
2213 || INT_ADD_WRAPV (regnum, c - '0', 2206 || ckd_add (&regnum, regnum, c - '0'))
2214 &regnum))
2215 FREE_STACK_RETURN (REG_ESIZE); 2207 FREE_STACK_RETURN (REG_ESIZE);
2216 break; 2208 break;
2217 default: 2209 default:
@@ -3258,12 +3250,7 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, ptrdiff_t size1,
3258 /* See whether the pattern is anchored. */ 3250 /* See whether the pattern is anchored. */
3259 anchored_start = (bufp->buffer[0] == begline); 3251 anchored_start = (bufp->buffer[0] == begline);
3260 3252
3261 gl_state.object = re_match_object; /* Used by SYNTAX_TABLE_BYTE_TO_CHAR. */ 3253 RE_SETUP_SYNTAX_TABLE_FOR_OBJECT (re_match_object, startpos);
3262 {
3263 ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (POS_AS_IN_BUFFER (startpos));
3264
3265 SETUP_SYNTAX_TABLE_FOR_OBJECT (re_match_object, charpos, 1);
3266 }
3267 3254
3268 /* Loop through the string, looking for a place to start matching. */ 3255 /* Loop through the string, looking for a place to start matching. */
3269 for (;;) 3256 for (;;)
@@ -3871,10 +3858,7 @@ re_match_2 (struct re_pattern_buffer *bufp,
3871{ 3858{
3872 ptrdiff_t result; 3859 ptrdiff_t result;
3873 3860
3874 ptrdiff_t charpos; 3861 RE_SETUP_SYNTAX_TABLE_FOR_OBJECT (re_match_object, pos);
3875 gl_state.object = re_match_object; /* Used by SYNTAX_TABLE_BYTE_TO_CHAR. */
3876 charpos = SYNTAX_TABLE_BYTE_TO_CHAR (POS_AS_IN_BUFFER (pos));
3877 SETUP_SYNTAX_TABLE_FOR_OBJECT (re_match_object, charpos, 1);
3878 3862
3879 result = re_match_2_internal (bufp, (re_char *) string1, size1, 3863 result = re_match_2_internal (bufp, (re_char *) string1, size1,
3880 (re_char *) string2, size2, 3864 (re_char *) string2, size2,
@@ -4806,8 +4790,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
4806 int c1, c2; 4790 int c1, c2;
4807 int s1, s2; 4791 int s1, s2;
4808 int dummy; 4792 int dummy;
4809 ptrdiff_t offset = PTR_TO_OFFSET (d); 4793 ptrdiff_t offset = POINTER_TO_OFFSET (d);
4810 ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset) - 1; 4794 ptrdiff_t charpos = RE_SYNTAX_TABLE_BYTE_TO_CHAR (offset) - 1;
4811 UPDATE_SYNTAX_TABLE (charpos); 4795 UPDATE_SYNTAX_TABLE (charpos);
4812 GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); 4796 GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2);
4813 nchars++; 4797 nchars++;
@@ -4846,8 +4830,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
4846 int c1, c2; 4830 int c1, c2;
4847 int s1, s2; 4831 int s1, s2;
4848 int dummy; 4832 int dummy;
4849 ptrdiff_t offset = PTR_TO_OFFSET (d); 4833 ptrdiff_t offset = POINTER_TO_OFFSET (d);
4850 ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); 4834 ptrdiff_t charpos = RE_SYNTAX_TABLE_BYTE_TO_CHAR (offset);
4851 UPDATE_SYNTAX_TABLE (charpos); 4835 UPDATE_SYNTAX_TABLE (charpos);
4852 PREFETCH (); 4836 PREFETCH ();
4853 GET_CHAR_AFTER (c2, d, dummy); 4837 GET_CHAR_AFTER (c2, d, dummy);
@@ -4889,8 +4873,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
4889 int c1, c2; 4873 int c1, c2;
4890 int s1, s2; 4874 int s1, s2;
4891 int dummy; 4875 int dummy;
4892 ptrdiff_t offset = PTR_TO_OFFSET (d); 4876 ptrdiff_t offset = POINTER_TO_OFFSET (d);
4893 ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset) - 1; 4877 ptrdiff_t charpos = RE_SYNTAX_TABLE_BYTE_TO_CHAR (offset) - 1;
4894 UPDATE_SYNTAX_TABLE (charpos); 4878 UPDATE_SYNTAX_TABLE (charpos);
4895 GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); 4879 GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2);
4896 nchars++; 4880 nchars++;
@@ -4931,8 +4915,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
4931 is the character at D, and S2 is the syntax of C2. */ 4915 is the character at D, and S2 is the syntax of C2. */
4932 int c1, c2; 4916 int c1, c2;
4933 int s1, s2; 4917 int s1, s2;
4934 ptrdiff_t offset = PTR_TO_OFFSET (d); 4918 ptrdiff_t offset = POINTER_TO_OFFSET (d);
4935 ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); 4919 ptrdiff_t charpos = RE_SYNTAX_TABLE_BYTE_TO_CHAR (offset);
4936 UPDATE_SYNTAX_TABLE (charpos); 4920 UPDATE_SYNTAX_TABLE (charpos);
4937 PREFETCH (); 4921 PREFETCH ();
4938 c2 = RE_STRING_CHAR (d, target_multibyte); 4922 c2 = RE_STRING_CHAR (d, target_multibyte);
@@ -4972,8 +4956,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
4972 is the character at D, and S2 is the syntax of C2. */ 4956 is the character at D, and S2 is the syntax of C2. */
4973 int c1, c2; 4957 int c1, c2;
4974 int s1, s2; 4958 int s1, s2;
4975 ptrdiff_t offset = PTR_TO_OFFSET (d); 4959 ptrdiff_t offset = POINTER_TO_OFFSET (d);
4976 ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset) - 1; 4960 ptrdiff_t charpos = RE_SYNTAX_TABLE_BYTE_TO_CHAR (offset) - 1;
4977 UPDATE_SYNTAX_TABLE (charpos); 4961 UPDATE_SYNTAX_TABLE (charpos);
4978 GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); 4962 GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2);
4979 nchars++; 4963 nchars++;
@@ -5008,8 +4992,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
5008 mcnt); 4992 mcnt);
5009 PREFETCH (); 4993 PREFETCH ();
5010 { 4994 {
5011 ptrdiff_t offset = PTR_TO_OFFSET (d); 4995 ptrdiff_t offset = POINTER_TO_OFFSET (d);
5012 ptrdiff_t pos1 = SYNTAX_TABLE_BYTE_TO_CHAR (offset); 4996 ptrdiff_t pos1 = RE_SYNTAX_TABLE_BYTE_TO_CHAR (offset);
5013 UPDATE_SYNTAX_TABLE (pos1); 4997 UPDATE_SYNTAX_TABLE (pos1);
5014 } 4998 }
5015 { 4999 {
diff --git a/src/regex-emacs.h b/src/regex-emacs.h
index 1bc973363e9..bc357633135 100644
--- a/src/regex-emacs.h
+++ b/src/regex-emacs.h
@@ -187,7 +187,8 @@ typedef enum { RECC_ERROR = 0,
187 RECC_DIGIT, RECC_XDIGIT, 187 RECC_DIGIT, RECC_XDIGIT,
188 RECC_BLANK, RECC_SPACE, 188 RECC_BLANK, RECC_SPACE,
189 RECC_MULTIBYTE, RECC_NONASCII, 189 RECC_MULTIBYTE, RECC_NONASCII,
190 RECC_ASCII, RECC_UNIBYTE 190 RECC_ASCII, RECC_UNIBYTE,
191 RECC_NUM_CLASSES = RECC_UNIBYTE
191} re_wctype_t; 192} re_wctype_t;
192 193
193extern bool re_iswctype (int ch, re_wctype_t cc); 194extern bool re_iswctype (int ch, re_wctype_t cc);
diff --git a/src/sort.c b/src/sort.c
index 34d0d690198..706c057dab0 100644
--- a/src/sort.c
+++ b/src/sort.c
@@ -40,7 +40,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
40 minimal length. So the number of bits in a ptrdiff_t is plenty large 40 minimal length. So the number of bits in a ptrdiff_t is plenty large
41 enough for all cases. */ 41 enough for all cases. */
42 42
43#define MAX_MERGE_PENDING (sizeof (ptrdiff_t) * 8) 43#define MAX_MERGE_PENDING PTRDIFF_WIDTH
44 44
45/* Once we get into galloping mode, we stay there as long as both runs 45/* Once we get into galloping mode, we stay there as long as both runs
46 win at least GALLOP_WIN_MIN consecutive times. */ 46 win at least GALLOP_WIN_MIN consecutive times. */
diff --git a/src/sqlite.c b/src/sqlite.c
index 0361514766a..fd528f2b0d5 100644
--- a/src/sqlite.c
+++ b/src/sqlite.c
@@ -23,6 +23,8 @@ YOSHIDA <syohex@gmail.com>, which can be found at:
23 https://github.com/syohex/emacs-sqlite3 */ 23 https://github.com/syohex/emacs-sqlite3 */
24 24
25#include <config.h> 25#include <config.h>
26
27#include <c-strcase.h>
26#include "lisp.h" 28#include "lisp.h"
27#include "coding.h" 29#include "coding.h"
28 30
@@ -30,6 +32,17 @@ YOSHIDA <syohex@gmail.com>, which can be found at:
30 32
31#include <sqlite3.h> 33#include <sqlite3.h>
32 34
35/* Support for loading SQLite extensions requires the ability to
36 enable and disable loading of extensions (by default this is
37 disabled, and we want to keep it that way). The required macro is
38 available since SQLite 3.13. */
39# if defined HAVE_SQLITE3_LOAD_EXTENSION && \
40 defined SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION
41# define HAVE_LOAD_EXTENSION 1
42# else
43# define HAVE_LOAD_EXTENSION 0
44# endif
45
33#ifdef WINDOWSNT 46#ifdef WINDOWSNT
34 47
35# include <windows.h> 48# include <windows.h>
@@ -75,11 +88,14 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_exec,
75DEF_DLL_FN (SQLITE_API int, sqlite3_prepare_v2, 88DEF_DLL_FN (SQLITE_API int, sqlite3_prepare_v2,
76 (sqlite3*, const char*, int, sqlite3_stmt**, const char**)); 89 (sqlite3*, const char*, int, sqlite3_stmt**, const char**));
77 90
78# ifdef HAVE_SQLITE3_LOAD_EXTENSION 91# if HAVE_LOAD_EXTENSION
79DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension, 92DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
80 (sqlite3*, const char*, const char*, char**)); 93 (sqlite3*, const char*, const char*, char**));
81# undef sqlite3_load_extension 94# undef sqlite3_load_extension
82# define sqlite3_load_extension fn_sqlite3_load_extension 95# define sqlite3_load_extension fn_sqlite3_load_extension
96DEF_DLL_FN (SQLITE_API int, sqlite3_db_config, (sqlite3*, int, ...));
97# undef sqlite3_db_config
98# define sqlite3_db_config fn_sqlite3_db_config
83# endif 99# endif
84 100
85# undef sqlite3_finalize 101# undef sqlite3_finalize
@@ -170,8 +186,9 @@ load_dll_functions (HMODULE library)
170 LOAD_DLL_FN (library, sqlite3_column_text); 186 LOAD_DLL_FN (library, sqlite3_column_text);
171 LOAD_DLL_FN (library, sqlite3_column_name); 187 LOAD_DLL_FN (library, sqlite3_column_name);
172 LOAD_DLL_FN (library, sqlite3_exec); 188 LOAD_DLL_FN (library, sqlite3_exec);
173# ifdef HAVE_SQLITE3_LOAD_EXTENSION 189# if HAVE_LOAD_EXTENSION
174 LOAD_DLL_FN (library, sqlite3_load_extension); 190 LOAD_DLL_FN (library, sqlite3_load_extension);
191 LOAD_DLL_FN (library, sqlite3_db_config);
175# endif 192# endif
176 LOAD_DLL_FN (library, sqlite3_prepare_v2); 193 LOAD_DLL_FN (library, sqlite3_prepare_v2);
177 return true; 194 return true;
@@ -669,7 +686,7 @@ DEFUN ("sqlite-pragma", Fsqlite_pragma, Ssqlite_pragma, 2, 2, 0,
669 SSDATA (concat2 (build_string ("PRAGMA "), pragma))); 686 SSDATA (concat2 (build_string ("PRAGMA "), pragma)));
670} 687}
671 688
672#ifdef HAVE_SQLITE3_LOAD_EXTENSION 689#if HAVE_LOAD_EXTENSION
673DEFUN ("sqlite-load-extension", Fsqlite_load_extension, 690DEFUN ("sqlite-load-extension", Fsqlite_load_extension,
674 Ssqlite_load_extension, 2, 2, 0, 691 Ssqlite_load_extension, 2, 2, 0,
675 doc: /* Load an SQlite MODULE into DB. 692 doc: /* Load an SQlite MODULE into DB.
@@ -684,9 +701,28 @@ Only modules on Emacs' list of allowed modules can be loaded. */)
684 CHECK_STRING (module); 701 CHECK_STRING (module);
685 702
686 /* Add names of useful and free modules here. */ 703 /* Add names of useful and free modules here. */
687 const char *allowlist[3] = { "pcre", "csvtable", NULL }; 704 const char *allowlist[] = {
705 "base64",
706 "cksumvfs",
707 "compress",
708 "csv",
709 "csvtable",
710 "fts3",
711 "icu",
712 "pcre",
713 "percentile",
714 "regexp",
715 "rot13",
716 "rtree",
717 "sha1",
718 "uuid",
719 "vfslog",
720 "zipfile",
721 NULL
722 };
688 char *name = SSDATA (Ffile_name_nondirectory (module)); 723 char *name = SSDATA (Ffile_name_nondirectory (module));
689 /* Possibly skip past a common prefix. */ 724 /* Possibly skip past a common prefix (libsqlite3_mod_ is used by
725 Debian, see https://packages.debian.org/source/sid/sqliteodbc). */
690 const char *prefix = "libsqlite3_mod_"; 726 const char *prefix = "libsqlite3_mod_";
691 if (!strncmp (name, prefix, strlen (prefix))) 727 if (!strncmp (name, prefix, strlen (prefix)))
692 name += strlen (prefix); 728 name += strlen (prefix);
@@ -694,10 +730,12 @@ Only modules on Emacs' list of allowed modules can be loaded. */)
694 bool do_allow = false; 730 bool do_allow = false;
695 for (const char **allow = allowlist; *allow; allow++) 731 for (const char **allow = allowlist; *allow; allow++)
696 { 732 {
697 if (strlen (*allow) < strlen (name) 733 ptrdiff_t allow_len = strlen (*allow);
698 && !strncmp (*allow, name, strlen (*allow)) 734 if (allow_len < strlen (name)
699 && (!strcmp (name + strlen (*allow), ".so") 735 && !strncmp (*allow, name, allow_len)
700 || !strcmp (name + strlen (*allow), ".DLL"))) 736 && (!strcmp (name + allow_len, ".so")
737 ||!strcmp (name + allow_len, ".dylib")
738 || !strcasecmp (name + allow_len, ".dll")))
701 { 739 {
702 do_allow = true; 740 do_allow = true;
703 break; 741 break;
@@ -707,15 +745,25 @@ Only modules on Emacs' list of allowed modules can be loaded. */)
707 if (!do_allow) 745 if (!do_allow)
708 xsignal1 (Qsqlite_error, build_string ("Module name not on allowlist")); 746 xsignal1 (Qsqlite_error, build_string ("Module name not on allowlist"));
709 747
710 int result = sqlite3_load_extension 748 /* Expand all Lisp data explicitly, so as to avoid signaling an
711 (XSQLITE (db)->db, 749 error while extension loading is enabled -- we don't want to
712 SSDATA (ENCODE_FILE (Fexpand_file_name (module, Qnil))), 750 "leak" this outside this function. */
713 NULL, NULL); 751 sqlite3 *sdb = XSQLITE (db)->db;
714 if (result == SQLITE_OK) 752 char *ext_fn = SSDATA (ENCODE_FILE (Fexpand_file_name (module, Qnil)));
715 return Qt; 753 /* Temporarily enable loading extensions via the C API. */
754 int result = sqlite3_db_config (sdb, SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION, 1,
755 NULL);
756 if (result == SQLITE_OK)
757 {
758 result = sqlite3_load_extension (sdb, ext_fn, NULL, NULL);
759 /* Disable loading extensions via C API. */
760 sqlite3_db_config (sdb, SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION, 0, NULL);
761 if (result == SQLITE_OK)
762 return Qt;
763 }
716 return Qnil; 764 return Qnil;
717} 765}
718#endif /* HAVE_SQLITE3_LOAD_EXTENSION */ 766#endif /* HAVE_LOAD_EXTENSION */
719 767
720DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0, 768DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0,
721 doc: /* Return the next result set from SET. 769 doc: /* Return the next result set from SET.
@@ -825,7 +873,7 @@ syms_of_sqlite (void)
825 defsubr (&Ssqlite_commit); 873 defsubr (&Ssqlite_commit);
826 defsubr (&Ssqlite_rollback); 874 defsubr (&Ssqlite_rollback);
827 defsubr (&Ssqlite_pragma); 875 defsubr (&Ssqlite_pragma);
828#ifdef HAVE_SQLITE3_LOAD_EXTENSION 876#if HAVE_LOAD_EXTENSION
829 defsubr (&Ssqlite_load_extension); 877 defsubr (&Ssqlite_load_extension);
830#endif 878#endif
831 defsubr (&Ssqlite_next); 879 defsubr (&Ssqlite_next);
diff --git a/src/syntax.c b/src/syntax.c
index 79e16f652f3..0cac923bba7 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -178,14 +178,14 @@ static ptrdiff_t find_start_begv;
178static modiff_count find_start_modiff; 178static modiff_count find_start_modiff;
179 179
180 180
181static Lisp_Object skip_chars (bool, Lisp_Object, Lisp_Object, bool); 181static Lisp_Object skip_chars (bool, Lisp_Object, Lisp_Object);
182static Lisp_Object skip_syntaxes (bool, Lisp_Object, Lisp_Object); 182static Lisp_Object skip_syntaxes (bool, Lisp_Object, Lisp_Object);
183static Lisp_Object scan_lists (EMACS_INT, EMACS_INT, EMACS_INT, bool); 183static Lisp_Object scan_lists (EMACS_INT, EMACS_INT, EMACS_INT, bool);
184static void scan_sexps_forward (struct lisp_parse_state *, 184static void scan_sexps_forward (struct lisp_parse_state *,
185 ptrdiff_t, ptrdiff_t, ptrdiff_t, EMACS_INT, 185 ptrdiff_t, ptrdiff_t, ptrdiff_t, EMACS_INT,
186 bool, int); 186 bool, int);
187static void internalize_parse_state (Lisp_Object, struct lisp_parse_state *); 187static void internalize_parse_state (Lisp_Object, struct lisp_parse_state *);
188static bool in_classes (int, Lisp_Object); 188static bool in_classes (int c, int num_classes, const unsigned char *classes);
189static void parse_sexp_propertize (ptrdiff_t charpos); 189static void parse_sexp_propertize (ptrdiff_t charpos);
190 190
191/* This setter is used only in this file, so it can be private. */ 191/* This setter is used only in this file, so it can be private. */
@@ -250,7 +250,6 @@ SETUP_SYNTAX_TABLE (ptrdiff_t from, ptrdiff_t count)
250 gl_state.b_property = BEGV; 250 gl_state.b_property = BEGV;
251 gl_state.e_property = ZV + 1; 251 gl_state.e_property = ZV + 1;
252 gl_state.object = Qnil; 252 gl_state.object = Qnil;
253 gl_state.offset = 0;
254 if (parse_sexp_lookup_properties) 253 if (parse_sexp_lookup_properties)
255 { 254 {
256 if (count > 0) 255 if (count > 0)
@@ -266,46 +265,38 @@ SETUP_SYNTAX_TABLE (ptrdiff_t from, ptrdiff_t count)
266/* Same as above, but in OBJECT. If OBJECT is nil, use current buffer. 265/* Same as above, but in OBJECT. If OBJECT is nil, use current buffer.
267 If it is t (which is only used in fast_c_string_match_ignore_case), 266 If it is t (which is only used in fast_c_string_match_ignore_case),
268 ignore properties altogether. 267 ignore properties altogether.
269 268 FROMBYTE is an regexp-byteoffset. */
270 This is meant for regex-emacs.c to use. For buffers, regex-emacs.c
271 passes arguments to the UPDATE_SYNTAX_TABLE functions which are
272 relative to BEGV. So if it is a buffer, we set the offset field to
273 BEGV. */
274 269
275void 270void
276SETUP_SYNTAX_TABLE_FOR_OBJECT (Lisp_Object object, 271RE_SETUP_SYNTAX_TABLE_FOR_OBJECT (Lisp_Object object,
277 ptrdiff_t from, ptrdiff_t count) 272 ptrdiff_t frombyte)
278{ 273{
279 SETUP_BUFFER_SYNTAX_TABLE (); 274 SETUP_BUFFER_SYNTAX_TABLE ();
280 gl_state.object = object; 275 gl_state.object = object;
281 if (BUFFERP (gl_state.object)) 276 if (BUFFERP (gl_state.object))
282 { 277 {
283 struct buffer *buf = XBUFFER (gl_state.object); 278 struct buffer *buf = XBUFFER (gl_state.object);
284 gl_state.b_property = 1; 279 gl_state.b_property = BEG;
285 gl_state.e_property = BUF_ZV (buf) - BUF_BEGV (buf) + 1; 280 gl_state.e_property = BUF_ZV (buf);
286 gl_state.offset = BUF_BEGV (buf) - 1;
287 } 281 }
288 else if (NILP (gl_state.object)) 282 else if (NILP (gl_state.object))
289 { 283 {
290 gl_state.b_property = 1; 284 gl_state.b_property = BEG;
291 gl_state.e_property = ZV - BEGV + 1; 285 gl_state.e_property = ZV; /* FIXME: Why not +1 like in SETUP_SYNTAX_TABLE? */
292 gl_state.offset = BEGV - 1;
293 } 286 }
294 else if (EQ (gl_state.object, Qt)) 287 else if (EQ (gl_state.object, Qt))
295 { 288 {
296 gl_state.b_property = 0; 289 gl_state.b_property = 0;
297 gl_state.e_property = PTRDIFF_MAX; 290 gl_state.e_property = PTRDIFF_MAX;
298 gl_state.offset = 0;
299 } 291 }
300 else 292 else
301 { 293 {
302 gl_state.b_property = 0; 294 gl_state.b_property = 0;
303 gl_state.e_property = 1 + SCHARS (gl_state.object); 295 gl_state.e_property = 1 + SCHARS (gl_state.object);
304 gl_state.offset = 0;
305 } 296 }
306 if (parse_sexp_lookup_properties) 297 if (parse_sexp_lookup_properties)
307 update_syntax_table (from + gl_state.offset - (count <= 0), 298 update_syntax_table (RE_SYNTAX_TABLE_BYTE_TO_CHAR (frombyte),
308 count, 1, gl_state.object); 299 1, 1, gl_state.object);
309} 300}
310 301
311/* Update gl_state to an appropriate interval which contains CHARPOS. The 302/* Update gl_state to an appropriate interval which contains CHARPOS. The
@@ -341,8 +332,8 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init,
341 if (!i) 332 if (!i)
342 return; 333 return;
343 i = gl_state.forward_i; 334 i = gl_state.forward_i;
344 gl_state.b_property = i->position - gl_state.offset; 335 gl_state.b_property = i->position;
345 gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset; 336 gl_state.e_property = INTERVAL_LAST_POS (i);
346 } 337 }
347 else 338 else
348 { 339 {
@@ -362,7 +353,7 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init,
362 { 353 {
363 invalidate = false; 354 invalidate = false;
364 gl_state.forward_i = i; 355 gl_state.forward_i = i;
365 gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset; 356 gl_state.e_property = INTERVAL_LAST_POS (i);
366 } 357 }
367 } 358 }
368 else if (charpos >= INTERVAL_LAST_POS (i)) /* Move right. */ 359 else if (charpos >= INTERVAL_LAST_POS (i)) /* Move right. */
@@ -375,7 +366,7 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init,
375 { 366 {
376 invalidate = false; 367 invalidate = false;
377 gl_state.backward_i = i; 368 gl_state.backward_i = i;
378 gl_state.b_property = i->position - gl_state.offset; 369 gl_state.b_property = i->position;
379 } 370 }
380 } 371 }
381 } 372 }
@@ -391,12 +382,12 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init,
391 if (count > 0) 382 if (count > 0)
392 { 383 {
393 gl_state.backward_i = i; 384 gl_state.backward_i = i;
394 gl_state.b_property = i->position - gl_state.offset; 385 gl_state.b_property = i->position;
395 } 386 }
396 else 387 else
397 { 388 {
398 gl_state.forward_i = i; 389 gl_state.forward_i = i;
399 gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset; 390 gl_state.e_property = INTERVAL_LAST_POS (i);
400 } 391 }
401 } 392 }
402 393
@@ -426,13 +417,13 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init,
426 { 417 {
427 if (count > 0) 418 if (count > 0)
428 { 419 {
429 gl_state.e_property = i->position - gl_state.offset; 420 gl_state.e_property = i->position;
430 gl_state.forward_i = i; 421 gl_state.forward_i = i;
431 } 422 }
432 else 423 else
433 { 424 {
434 gl_state.b_property 425 gl_state.b_property
435 = i->position + LENGTH (i) - gl_state.offset; 426 = i->position + LENGTH (i);
436 gl_state.backward_i = i; 427 gl_state.backward_i = i;
437 } 428 }
438 return; 429 return;
@@ -442,7 +433,7 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init,
442 if (count > 0) 433 if (count > 0)
443 { 434 {
444 gl_state.e_property 435 gl_state.e_property
445 = i->position + LENGTH (i) - gl_state.offset 436 = i->position + LENGTH (i)
446 /* e_property at EOB is not set to ZV but to ZV+1, so that 437 /* e_property at EOB is not set to ZV but to ZV+1, so that
447 we can do INC(from);UPDATE_SYNTAX_TABLE_FORWARD without 438 we can do INC(from);UPDATE_SYNTAX_TABLE_FORWARD without
448 having to check eob between the two. */ 439 having to check eob between the two. */
@@ -451,7 +442,7 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init,
451 } 442 }
452 else 443 else
453 { 444 {
454 gl_state.b_property = i->position - gl_state.offset; 445 gl_state.b_property = i->position;
455 gl_state.backward_i = i; 446 gl_state.backward_i = i;
456 } 447 }
457 return; 448 return;
@@ -1616,7 +1607,7 @@ Char classes, e.g. `[:alpha:]', are supported.
1616Returns the distance traveled, either zero or positive. */) 1607Returns the distance traveled, either zero or positive. */)
1617 (Lisp_Object string, Lisp_Object lim) 1608 (Lisp_Object string, Lisp_Object lim)
1618{ 1609{
1619 return skip_chars (1, string, lim, 1); 1610 return skip_chars (1, string, lim);
1620} 1611}
1621 1612
1622DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0, 1613DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
@@ -1625,7 +1616,7 @@ See `skip-chars-forward' for details.
1625Returns the distance traveled, either zero or negative. */) 1616Returns the distance traveled, either zero or negative. */)
1626 (Lisp_Object string, Lisp_Object lim) 1617 (Lisp_Object string, Lisp_Object lim)
1627{ 1618{
1628 return skip_chars (0, string, lim, 1); 1619 return skip_chars (0, string, lim);
1629} 1620}
1630 1621
1631DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0, 1622DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0,
@@ -1652,8 +1643,7 @@ of this is the distance traveled. */)
1652} 1643}
1653 1644
1654static Lisp_Object 1645static Lisp_Object
1655skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, 1646skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim)
1656 bool handle_iso_classes)
1657{ 1647{
1658 int c; 1648 int c;
1659 char fastmap[0400]; 1649 char fastmap[0400];
@@ -1670,11 +1660,9 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
1670 ptrdiff_t size_byte; 1660 ptrdiff_t size_byte;
1671 const unsigned char *str; 1661 const unsigned char *str;
1672 int len; 1662 int len;
1673 Lisp_Object iso_classes;
1674 USE_SAFE_ALLOCA; 1663 USE_SAFE_ALLOCA;
1675 1664
1676 CHECK_STRING (string); 1665 CHECK_STRING (string);
1677 iso_classes = Qnil;
1678 1666
1679 if (NILP (lim)) 1667 if (NILP (lim))
1680 XSETINT (lim, forwardp ? ZV : BEGV); 1668 XSETINT (lim, forwardp ? ZV : BEGV);
@@ -1709,6 +1697,8 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
1709 If STRING contains non-ASCII characters, setup char_ranges for 1697 If STRING contains non-ASCII characters, setup char_ranges for
1710 them and use fastmap only for their leading codes. */ 1698 them and use fastmap only for their leading codes. */
1711 1699
1700 int nclasses = 0;
1701 unsigned char classes[RECC_NUM_CLASSES];
1712 if (! string_multibyte) 1702 if (! string_multibyte)
1713 { 1703 {
1714 bool string_has_eight_bit = 0; 1704 bool string_has_eight_bit = 0;
@@ -1716,18 +1706,16 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
1716 /* At first setup fastmap. */ 1706 /* At first setup fastmap. */
1717 while (i_byte < size_byte) 1707 while (i_byte < size_byte)
1718 { 1708 {
1719 if (handle_iso_classes) 1709 const unsigned char *ch = str + i_byte;
1710 re_wctype_t cc = re_wctype_parse (&ch, size_byte - i_byte);
1711 if (cc == 0)
1712 error ("Invalid ISO C character class");
1713 if (cc != -1)
1720 { 1714 {
1721 const unsigned char *ch = str + i_byte; 1715 if (!(nclasses && memchr (classes, cc, nclasses)))
1722 re_wctype_t cc = re_wctype_parse (&ch, size_byte - i_byte); 1716 classes[nclasses++] = cc;
1723 if (cc == 0) 1717 i_byte = ch - str;
1724 error ("Invalid ISO C character class"); 1718 continue;
1725 if (cc != -1)
1726 {
1727 iso_classes = Fcons (make_fixnum (cc), iso_classes);
1728 i_byte = ch - str;
1729 continue;
1730 }
1731 } 1719 }
1732 1720
1733 c = str[i_byte++]; 1721 c = str[i_byte++];
@@ -1812,18 +1800,16 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
1812 { 1800 {
1813 int leading_code = str[i_byte]; 1801 int leading_code = str[i_byte];
1814 1802
1815 if (handle_iso_classes) 1803 const unsigned char *ch = str + i_byte;
1804 re_wctype_t cc = re_wctype_parse (&ch, size_byte - i_byte);
1805 if (cc == 0)
1806 error ("Invalid ISO C character class");
1807 if (cc != -1)
1816 { 1808 {
1817 const unsigned char *ch = str + i_byte; 1809 if (!(nclasses && memchr (classes, cc, nclasses)))
1818 re_wctype_t cc = re_wctype_parse (&ch, size_byte - i_byte); 1810 classes[nclasses++] = cc;
1819 if (cc == 0) 1811 i_byte = ch - str;
1820 error ("Invalid ISO C character class"); 1812 continue;
1821 if (cc != -1)
1822 {
1823 iso_classes = Fcons (make_fixnum (cc), iso_classes);
1824 i_byte = ch - str;
1825 continue;
1826 }
1827 } 1813 }
1828 1814
1829 if (leading_code== '\\') 1815 if (leading_code== '\\')
@@ -1969,7 +1955,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
1969 stop = endp; 1955 stop = endp;
1970 } 1956 }
1971 c = string_char_and_length (p, &nbytes); 1957 c = string_char_and_length (p, &nbytes);
1972 if (! NILP (iso_classes) && in_classes (c, iso_classes)) 1958 if (nclasses && in_classes (c, nclasses, classes))
1973 { 1959 {
1974 if (negate) 1960 if (negate)
1975 break; 1961 break;
@@ -2010,7 +1996,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2010 stop = endp; 1996 stop = endp;
2011 } 1997 }
2012 1998
2013 if (!NILP (iso_classes) && in_classes (*p, iso_classes)) 1999 if (nclasses && in_classes (*p, nclasses, classes))
2014 { 2000 {
2015 if (negate) 2001 if (negate)
2016 break; 2002 break;
@@ -2044,7 +2030,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2044 2030
2045 c = STRING_CHAR (p); 2031 c = STRING_CHAR (p);
2046 2032
2047 if (! NILP (iso_classes) && in_classes (c, iso_classes)) 2033 if (nclasses && in_classes (c, nclasses, classes))
2048 { 2034 {
2049 if (negate) 2035 if (negate)
2050 break; 2036 break;
@@ -2078,7 +2064,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2078 stop = endp; 2064 stop = endp;
2079 } 2065 }
2080 2066
2081 if (! NILP (iso_classes) && in_classes (p[-1], iso_classes)) 2067 if (nclasses && in_classes (p[-1], nclasses, classes))
2082 { 2068 {
2083 if (negate) 2069 if (negate)
2084 break; 2070 break;
@@ -2201,8 +2187,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2201 while (!parse_sexp_lookup_properties 2187 while (!parse_sexp_lookup_properties
2202 || pos < gl_state.e_property); 2188 || pos < gl_state.e_property);
2203 2189
2204 update_syntax_table_forward (pos + gl_state.offset, 2190 update_syntax_table_forward (pos, false, gl_state.object);
2205 false, gl_state.object);
2206 } 2191 }
2207 } 2192 }
2208 else 2193 else
@@ -2263,26 +2248,16 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2263 } 2248 }
2264} 2249}
2265 2250
2266/* Return true if character C belongs to one of the ISO classes 2251/* Return true if character C belongs to one of the ISO classes in the
2267 in the list ISO_CLASSES. Each class is represented by an 2252 array. */
2268 integer which is its type according to re_wctype. */
2269 2253
2270static bool 2254static bool
2271in_classes (int c, Lisp_Object iso_classes) 2255in_classes (int c, int nclasses, const unsigned char *classes)
2272{ 2256{
2273 bool fits_class = 0; 2257 for (int i = 0; i < nclasses; i++)
2274 2258 if (re_iswctype (c, classes[i]))
2275 while (CONSP (iso_classes)) 2259 return true;
2276 { 2260 return false;
2277 Lisp_Object elt;
2278 elt = XCAR (iso_classes);
2279 iso_classes = XCDR (iso_classes);
2280
2281 if (re_iswctype (c, XFIXNAT (elt)))
2282 fits_class = 1;
2283 }
2284
2285 return fits_class;
2286} 2261}
2287 2262
2288/* Jump over a comment, assuming we are at the beginning of one. 2263/* Jump over a comment, assuming we are at the beginning of one.
@@ -2348,13 +2323,16 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
2348 return 0; 2323 return 0;
2349 } 2324 }
2350 c = FETCH_CHAR_AS_MULTIBYTE (from_byte); 2325 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2326 prev_syntax = syntax;
2351 syntax = SYNTAX_WITH_FLAGS (c); 2327 syntax = SYNTAX_WITH_FLAGS (c);
2352 code = syntax & 0xff; 2328 code = syntax & 0xff;
2353 if (code == Sendcomment 2329 if (code == Sendcomment
2354 && SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0) == style 2330 && SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0) == style
2355 && (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ? 2331 && (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ?
2356 (nesting > 0 && --nesting == 0) : nesting < 0) 2332 (nesting > 0 && --nesting == 0) : nesting < 0)
2357 && !(comment_end_can_be_escaped && char_quoted (from, from_byte))) 2333 && !(comment_end_can_be_escaped
2334 && ((prev_syntax & 0xff) == Sescape
2335 || (prev_syntax & 0xff) == Scharquote)))
2358 /* We have encountered a comment end of the same style 2336 /* We have encountered a comment end of the same style
2359 as the comment sequence which began this comment 2337 as the comment sequence which began this comment
2360 section. */ 2338 section. */
@@ -2378,7 +2356,11 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
2378 inc_both (&from, &from_byte); 2356 inc_both (&from, &from_byte);
2379 UPDATE_SYNTAX_TABLE_FORWARD (from); 2357 UPDATE_SYNTAX_TABLE_FORWARD (from);
2380 if (from == stop) continue; /* Failure */ 2358 if (from == stop) continue; /* Failure */
2381 } 2359 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2360 prev_syntax = syntax;
2361 syntax = Smax;
2362 code = syntax;
2363 }
2382 inc_both (&from, &from_byte); 2364 inc_both (&from, &from_byte);
2383 UPDATE_SYNTAX_TABLE_FORWARD (from); 2365 UPDATE_SYNTAX_TABLE_FORWARD (from);
2384 2366
@@ -3359,7 +3341,14 @@ do { prev_from = from; \
3359 are invalid now. Luckily, the `done' doesn't use them 3341 are invalid now. Luckily, the `done' doesn't use them
3360 and the INC_FROM sets them to a sane value without 3342 and the INC_FROM sets them to a sane value without
3361 looking at them. */ 3343 looking at them. */
3362 if (!found) goto done; 3344 if (!found)
3345 {
3346 if ((prev_from_syntax & 0xff) == Sescape
3347 || (prev_from_syntax & 0xff) == Scharquote)
3348 goto endquoted;
3349 else
3350 goto done;
3351 }
3363 INC_FROM; 3352 INC_FROM;
3364 state->incomment = 0; 3353 state->incomment = 0;
3365 state->comstyle = 0; /* reset the comment style */ 3354 state->comstyle = 0; /* reset the comment style */
diff --git a/src/syntax.h b/src/syntax.h
index 9eb8701628b..01982be25a0 100644
--- a/src/syntax.h
+++ b/src/syntax.h
@@ -85,8 +85,6 @@ struct gl_state_s
85 and possibly at the 85 and possibly at the
86 intervals too, depending 86 intervals too, depending
87 on: */ 87 on: */
88 /* Offset for positions specified to UPDATE_SYNTAX_TABLE. */
89 ptrdiff_t offset;
90}; 88};
91 89
92extern struct gl_state_s gl_state; 90extern struct gl_state_s gl_state;
@@ -147,28 +145,27 @@ extern bool syntax_prefix_flag_p (int c);
147 145
148extern unsigned char const syntax_spec_code[0400]; 146extern unsigned char const syntax_spec_code[0400];
149 147
150/* Convert the byte offset BYTEPOS into a character position, 148/* Convert the regexp's BYTEOFFSET into a character position,
151 for the object recorded in gl_state with SETUP_SYNTAX_TABLE_FOR_OBJECT. 149 for the object recorded in gl_state with RE_SETUP_SYNTAX_TABLE_FOR_OBJECT.
152 150
153 The value is meant for use in code that does nothing when 151 The value is meant for use in code that does nothing when
154 parse_sexp_lookup_properties is false, so return 0 in that case, 152 parse_sexp_lookup_properties is false, so return 0 in that case,
155 for speed. */ 153 for speed. */
156 154
157INLINE ptrdiff_t 155INLINE ptrdiff_t
158SYNTAX_TABLE_BYTE_TO_CHAR (ptrdiff_t bytepos) 156RE_SYNTAX_TABLE_BYTE_TO_CHAR (ptrdiff_t byteoffset)
159{ 157{
160 return (! parse_sexp_lookup_properties 158 return (! parse_sexp_lookup_properties
161 ? 0 159 ? 0
162 : STRINGP (gl_state.object) 160 : STRINGP (gl_state.object)
163 ? string_byte_to_char (gl_state.object, bytepos) 161 ? string_byte_to_char (gl_state.object, byteoffset)
164 : BUFFERP (gl_state.object) 162 : BUFFERP (gl_state.object)
165 ? ((buf_bytepos_to_charpos 163 ? ((buf_bytepos_to_charpos
166 (XBUFFER (gl_state.object), 164 (XBUFFER (gl_state.object),
167 (bytepos + BUF_BEGV_BYTE (XBUFFER (gl_state.object)) - 1))) 165 (byteoffset + BUF_BEGV_BYTE (XBUFFER (gl_state.object))))))
168 - BUF_BEGV (XBUFFER (gl_state.object)) + 1)
169 : NILP (gl_state.object) 166 : NILP (gl_state.object)
170 ? BYTE_TO_CHAR (bytepos + BEGV_BYTE - 1) - BEGV + 1 167 ? BYTE_TO_CHAR (byteoffset + BEGV_BYTE)
171 : bytepos); 168 : byteoffset);
172} 169}
173 170
174/* Make syntax table state (gl_state) good for CHARPOS, assuming it is 171/* Make syntax table state (gl_state) good for CHARPOS, assuming it is
@@ -178,8 +175,7 @@ INLINE void
178UPDATE_SYNTAX_TABLE_FORWARD (ptrdiff_t charpos) 175UPDATE_SYNTAX_TABLE_FORWARD (ptrdiff_t charpos)
179{ /* Performs just-in-time syntax-propertization. */ 176{ /* Performs just-in-time syntax-propertization. */
180 if (parse_sexp_lookup_properties && charpos >= gl_state.e_property) 177 if (parse_sexp_lookup_properties && charpos >= gl_state.e_property)
181 update_syntax_table_forward (charpos + gl_state.offset, 178 update_syntax_table_forward (charpos, false, gl_state.object);
182 false, gl_state.object);
183} 179}
184 180
185/* Make syntax table state (gl_state) good for CHARPOS, assuming it is 181/* Make syntax table state (gl_state) good for CHARPOS, assuming it is
@@ -189,7 +185,7 @@ INLINE void
189UPDATE_SYNTAX_TABLE_BACKWARD (ptrdiff_t charpos) 185UPDATE_SYNTAX_TABLE_BACKWARD (ptrdiff_t charpos)
190{ 186{
191 if (parse_sexp_lookup_properties && charpos < gl_state.b_property) 187 if (parse_sexp_lookup_properties && charpos < gl_state.b_property)
192 update_syntax_table (charpos + gl_state.offset, -1, false, gl_state.object); 188 update_syntax_table (charpos, -1, false, gl_state.object);
193} 189}
194 190
195/* Make syntax table good for CHARPOS. */ 191/* Make syntax table good for CHARPOS. */
@@ -212,7 +208,7 @@ SETUP_BUFFER_SYNTAX_TABLE (void)
212} 208}
213 209
214extern ptrdiff_t scan_words (ptrdiff_t, EMACS_INT); 210extern ptrdiff_t scan_words (ptrdiff_t, EMACS_INT);
215extern void SETUP_SYNTAX_TABLE_FOR_OBJECT (Lisp_Object, ptrdiff_t, ptrdiff_t); 211extern void RE_SETUP_SYNTAX_TABLE_FOR_OBJECT (Lisp_Object, ptrdiff_t);
216 212
217INLINE_HEADER_END 213INLINE_HEADER_END
218 214
diff --git a/src/sysdep.c b/src/sysdep.c
index a5b3117d262..443602a2d6d 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -2005,7 +2005,9 @@ init_signals (void)
2005 signal (SIGPIPE, SIG_IGN); 2005 signal (SIGPIPE, SIG_IGN);
2006 2006
2007 sigaction (SIGQUIT, &process_fatal_action, 0); 2007 sigaction (SIGQUIT, &process_fatal_action, 0);
2008#ifndef __vax__
2008 sigaction (SIGILL, &thread_fatal_action, 0); 2009 sigaction (SIGILL, &thread_fatal_action, 0);
2010#endif /* __vax__ */
2009 sigaction (SIGTRAP, &thread_fatal_action, 0); 2011 sigaction (SIGTRAP, &thread_fatal_action, 0);
2010 2012
2011 /* Typically SIGFPE is thread-specific and is fatal, like SIGILL. 2013 /* Typically SIGFPE is thread-specific and is fatal, like SIGILL.
@@ -2018,6 +2020,11 @@ init_signals (void)
2018 { 2020 {
2019 emacs_sigaction_init (&action, deliver_arith_signal); 2021 emacs_sigaction_init (&action, deliver_arith_signal);
2020 sigaction (SIGFPE, &action, 0); 2022 sigaction (SIGFPE, &action, 0);
2023#ifdef __vax__
2024 /* NetBSD/vax generates SIGILL upon some floating point errors,
2025 such as taking the log of 0.0. */
2026 sigaction (SIGILL, &action, 0);
2027#endif /* __vax__ */
2021 } 2028 }
2022 2029
2023#ifdef SIGUSR1 2030#ifdef SIGUSR1
diff --git a/src/term.c b/src/term.c
index d881dee39fe..4df3de8f4a5 100644
--- a/src/term.c
+++ b/src/term.c
@@ -533,7 +533,7 @@ encode_terminal_code (struct glyph *src, int src_len,
533 multibyte-form. But, it may be enlarged on demand if 533 multibyte-form. But, it may be enlarged on demand if
534 Vglyph_table contains a string or a composite glyph is 534 Vglyph_table contains a string or a composite glyph is
535 encountered. */ 535 encountered. */
536 if (INT_MULTIPLY_WRAPV (src_len, MAX_MULTIBYTE_LENGTH, &required)) 536 if (ckd_mul (&required, src_len, MAX_MULTIBYTE_LENGTH))
537 memory_full (SIZE_MAX); 537 memory_full (SIZE_MAX);
538 if (encode_terminal_src_size < required) 538 if (encode_terminal_src_size < required)
539 encode_terminal_src = xpalloc (encode_terminal_src, 539 encode_terminal_src = xpalloc (encode_terminal_src,
@@ -3319,7 +3319,7 @@ tty_menu_activate (tty_menu *menu, int *pane, int *selidx,
3319 active submenu. */ 3319 active submenu. */
3320 if (i != statecount - 2 3320 if (i != statecount - 2
3321 || state[i].menu->submenu[dy] != state[i + 1].menu) 3321 || state[i].menu->submenu[dy] != state[i + 1].menu)
3322 while (i != statecount - 1) 3322 while (i < statecount - 1)
3323 { 3323 {
3324 statecount--; 3324 statecount--;
3325 screen_update (sf, state[statecount].screen_behind); 3325 screen_update (sf, state[statecount].screen_behind);
@@ -4163,7 +4163,15 @@ use the Bourne shell command 'TERM=...; export TERM' (C-shell:\n\
4163 tty->TS_enter_alt_charset_mode = tgetstr ("as", address); 4163 tty->TS_enter_alt_charset_mode = tgetstr ("as", address);
4164 tty->TS_exit_alt_charset_mode = tgetstr ("ae", address); 4164 tty->TS_exit_alt_charset_mode = tgetstr ("ae", address);
4165 tty->TS_exit_attribute_mode = tgetstr ("me", address); 4165 tty->TS_exit_attribute_mode = tgetstr ("me", address);
4166#ifdef TERMINFO
4167 tty->TS_enter_strike_through_mode = tigetstr ("smxx");
4168 if (tty->TS_enter_strike_through_mode == (char *) (intptr_t) -1)
4169 tty->TS_enter_strike_through_mode = NULL;
4170#else
4171 /* FIXME: Is calling tgetstr here for non-terminfo case correct,
4172 even though "smxx" is more than 2 characters? */
4166 tty->TS_enter_strike_through_mode = tgetstr ("smxx", address); 4173 tty->TS_enter_strike_through_mode = tgetstr ("smxx", address);
4174#endif
4167 4175
4168 MultiUp (tty) = tgetstr ("UP", address); 4176 MultiUp (tty) = tgetstr ("UP", address);
4169 MultiDown (tty) = tgetstr ("DO", address); 4177 MultiDown (tty) = tgetstr ("DO", address);
diff --git a/src/termcap.c b/src/termcap.c
index d2688b3838d..1e989b6e2de 100644
--- a/src/termcap.c
+++ b/src/termcap.c
@@ -296,7 +296,7 @@ tputs (register const char *str, int nlines, int (*outfun) (int))
296 BAUD_RATE is measured in characters per 10 seconds. 296 BAUD_RATE is measured in characters per 10 seconds.
297 Compute PADFACTOR = 100000 * (how many padding bytes are needed). */ 297 Compute PADFACTOR = 100000 * (how many padding bytes are needed). */
298 intmax_t padfactor; 298 intmax_t padfactor;
299 if (INT_MULTIPLY_WRAPV (padcount, baud_rate, &padfactor)) 299 if (ckd_mul (&padfactor, padcount, baud_rate))
300 padfactor = baud_rate < 0 ? INTMAX_MIN : INTMAX_MAX; 300 padfactor = baud_rate < 0 ? INTMAX_MIN : INTMAX_MAX;
301 301
302 for (; 50000 <= padfactor; padfactor -= 100000) 302 for (; 50000 <= padfactor; padfactor -= 100000)
diff --git a/src/textconv.c b/src/textconv.c
index d5db6d11717..7ed8ede3544 100644
--- a/src/textconv.c
+++ b/src/textconv.c
@@ -125,7 +125,7 @@ textconv_query (struct frame *f, struct textconv_callback_struct *query)
125 overflows, move back to point or to the extremes of the 125 overflows, move back to point or to the extremes of the
126 accessible region. */ 126 accessible region. */
127 127
128 if (INT_ADD_WRAPV (pos, query->position, &pos)) 128 if (ckd_add (&pos, pos, query->position))
129 pos = PT; 129 pos = PT;
130 130
131 if (pos < BEGV) 131 if (pos < BEGV)
@@ -145,7 +145,7 @@ textconv_query (struct frame *f, struct textconv_callback_struct *query)
145 { 145 {
146 case TEXTCONV_FORWARD_CHAR: 146 case TEXTCONV_FORWARD_CHAR:
147 /* Move forward by query->factor characters. */ 147 /* Move forward by query->factor characters. */
148 if (INT_ADD_WRAPV (pos, query->factor, &end) || end > ZV) 148 if (ckd_add (&end, pos, query->factor) || end > ZV)
149 end = ZV; 149 end = ZV;
150 150
151 end_byte = CHAR_TO_BYTE (end); 151 end_byte = CHAR_TO_BYTE (end);
@@ -153,7 +153,7 @@ textconv_query (struct frame *f, struct textconv_callback_struct *query)
153 153
154 case TEXTCONV_BACKWARD_CHAR: 154 case TEXTCONV_BACKWARD_CHAR:
155 /* Move backward by query->factor characters. */ 155 /* Move backward by query->factor characters. */
156 if (INT_SUBTRACT_WRAPV (pos, query->factor, &end) || end < BEGV) 156 if (ckd_sub (&end, pos, query->factor) || end < BEGV)
157 end = BEGV; 157 end = BEGV;
158 158
159 end_byte = CHAR_TO_BYTE (end); 159 end_byte = CHAR_TO_BYTE (end);
diff --git a/src/thread.h b/src/thread.h
index f0e9ee01173..9b14cc44f35 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -33,6 +33,15 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
33#include "sysselect.h" /* FIXME */ 33#include "sysselect.h" /* FIXME */
34#include "systhread.h" 34#include "systhread.h"
35 35
36/* Yield an address close enough to the top of the stack that the
37 garbage collector need not scan above it. Callers should be
38 declared NO_INLINE. */
39#ifdef HAVE___BUILTIN_FRAME_ADDRESS
40# define NEAR_STACK_TOP(addr) ((void) (addr), __builtin_frame_address (0))
41#else
42# define NEAR_STACK_TOP(addr) (addr)
43#endif
44
36INLINE_HEADER_BEGIN 45INLINE_HEADER_BEGIN
37 46
38/* Byte-code interpreter thread state. */ 47/* Byte-code interpreter thread state. */
diff --git a/src/timefns.c b/src/timefns.c
index b3132e7bc34..151f5b482a3 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -180,6 +180,15 @@ static timezone_t const utc_tz = 0;
180static struct tm * 180static struct tm *
181emacs_localtime_rz (timezone_t tz, time_t const *t, struct tm *tm) 181emacs_localtime_rz (timezone_t tz, time_t const *t, struct tm *tm)
182{ 182{
183#ifdef WINDOWSNT
184 /* The Windows CRT functions are "optimized for speed", so they don't
185 check for timezone and DST changes if they were last called less
186 than 1 minute ago (see http://support.microsoft.com/kb/821231).
187 So all Emacs features that repeatedly call time functions (e.g.,
188 display-time) are in real danger of missing timezone and DST
189 changes. Calling tzset before each localtime call fixes that. */
190 tzset ();
191#endif
183 tm = localtime_rz (tz, t, tm); 192 tm = localtime_rz (tz, t, tm);
184 if (!tm && errno == ENOMEM) 193 if (!tm && errno == ENOMEM)
185 memory_full (SIZE_MAX); 194 memory_full (SIZE_MAX);
@@ -505,8 +514,8 @@ timespec_ticks (struct timespec t)
505 /* For speed, use intmax_t arithmetic if it will do. */ 514 /* For speed, use intmax_t arithmetic if it will do. */
506 intmax_t accum; 515 intmax_t accum;
507 if (FASTER_TIMEFNS 516 if (FASTER_TIMEFNS
508 && !INT_MULTIPLY_WRAPV (t.tv_sec, TIMESPEC_HZ, &accum) 517 && !ckd_mul (&accum, t.tv_sec, TIMESPEC_HZ)
509 && !INT_ADD_WRAPV (t.tv_nsec, accum, &accum)) 518 && !ckd_add (&accum, accum, t.tv_nsec))
510 return make_int (accum); 519 return make_int (accum);
511 520
512 /* Fall back on bignum arithmetic. */ 521 /* Fall back on bignum arithmetic. */
@@ -534,7 +543,7 @@ lisp_time_hz_ticks (struct lisp_time t, Lisp_Object hz)
534 /* For speed, use intmax_t arithmetic if it will do. */ 543 /* For speed, use intmax_t arithmetic if it will do. */
535 intmax_t ticks; 544 intmax_t ticks;
536 if (FASTER_TIMEFNS && FIXNUMP (t.ticks) && FIXNUMP (t.hz) 545 if (FASTER_TIMEFNS && FIXNUMP (t.ticks) && FIXNUMP (t.hz)
537 && !INT_MULTIPLY_WRAPV (XFIXNUM (t.ticks), XFIXNUM (hz), &ticks)) 546 && !ckd_mul (&ticks, XFIXNUM (t.ticks), XFIXNUM (hz)))
538 return make_int (ticks / XFIXNUM (t.hz) 547 return make_int (ticks / XFIXNUM (t.hz)
539 - (ticks % XFIXNUM (t.hz) < 0)); 548 - (ticks % XFIXNUM (t.hz) < 0));
540 } 549 }
@@ -1548,12 +1557,10 @@ usage: (decode-time &optional TIME ZONE FORM) */)
1548 Lisp_Object ticks; 1557 Lisp_Object ticks;
1549 intmax_t n; 1558 intmax_t n;
1550 if (FASTER_TIMEFNS && FIXNUMP (lt.ticks) && FIXNUMP (hz) 1559 if (FASTER_TIMEFNS && FIXNUMP (lt.ticks) && FIXNUMP (hz)
1551 && !INT_MULTIPLY_WRAPV (XFIXNUM (hz), local_tm.tm_sec, &n) 1560 && !ckd_mul (&n, XFIXNUM (hz), local_tm.tm_sec)
1552 && ! (INT_ADD_WRAPV 1561 && !ckd_add (&n, n, (XFIXNUM (lt.ticks) % XFIXNUM (hz)
1553 (n, (XFIXNUM (lt.ticks) % XFIXNUM (hz) 1562 + (XFIXNUM (lt.ticks) % XFIXNUM (hz) < 0
1554 + (XFIXNUM (lt.ticks) % XFIXNUM (hz) < 0 1563 ? XFIXNUM (hz) : 0))))
1555 ? XFIXNUM (hz) : 0)),
1556 &n)))
1557 ticks = make_int (n); 1564 ticks = make_int (n);
1558 else 1565 else
1559 { 1566 {
@@ -1594,7 +1601,7 @@ check_tm_member (Lisp_Object obj, int offset)
1594 CHECK_FIXNUM (obj); 1601 CHECK_FIXNUM (obj);
1595 EMACS_INT n = XFIXNUM (obj); 1602 EMACS_INT n = XFIXNUM (obj);
1596 int i; 1603 int i;
1597 if (INT_SUBTRACT_WRAPV (n, offset, &i)) 1604 if (ckd_sub (&i, n, offset))
1598 time_overflow (); 1605 time_overflow ();
1599 return i; 1606 return i;
1600 } 1607 }
diff --git a/src/tparam.c b/src/tparam.c
index 1a5eab37452..a0d2ee74d99 100644
--- a/src/tparam.c
+++ b/src/tparam.c
@@ -173,8 +173,7 @@ tparam1 (const char *string, char *outstring, int len,
173 doup++, append_len_incr = strlen (up); 173 doup++, append_len_incr = strlen (up);
174 else 174 else
175 doleft++, append_len_incr = strlen (left); 175 doleft++, append_len_incr = strlen (left);
176 if (INT_ADD_WRAPV (append_len_incr, 176 if (ckd_add (&append_len, append_len, append_len_incr))
177 append_len, &append_len))
178 memory_full (SIZE_MAX); 177 memory_full (SIZE_MAX);
179 } 178 }
180 } 179 }
diff --git a/src/treesit.c b/src/treesit.c
index 5a4fe3e8803..0af0e347694 100644
--- a/src/treesit.c
+++ b/src/treesit.c
@@ -404,6 +404,9 @@ init_treesit_functions (void)
404 404
405static Lisp_Object Vtreesit_str_libtree_sitter; 405static Lisp_Object Vtreesit_str_libtree_sitter;
406static Lisp_Object Vtreesit_str_tree_sitter; 406static Lisp_Object Vtreesit_str_tree_sitter;
407#ifndef WINDOWSNT
408static Lisp_Object Vtreesit_str_dot_0;
409#endif
407static Lisp_Object Vtreesit_str_dot; 410static Lisp_Object Vtreesit_str_dot;
408static Lisp_Object Vtreesit_str_question_mark; 411static Lisp_Object Vtreesit_str_question_mark;
409static Lisp_Object Vtreesit_str_star; 412static Lisp_Object Vtreesit_str_star;
@@ -421,10 +424,17 @@ static Lisp_Object Vtreesit_str_match;
421static Lisp_Object Vtreesit_str_pred; 424static Lisp_Object Vtreesit_str_pred;
422 425
423/* This is the limit on recursion levels for some tree-sitter 426/* This is the limit on recursion levels for some tree-sitter
424 functions. Remember to update docstrings when changing this 427 functions. Remember to update docstrings when changing this value.
425 value. */ 428
426const ptrdiff_t treesit_recursion_limit = 1000; 429 If we think of programs and AST, it is very rare for any program to
427bool treesit_initialized = false; 430 have a very deep AST. For example, you would need 1000+ levels of
431 nested if-statements, or a struct somehow nested for 1000+ levels.
432 It’s hard for me to imagine any hand-written or machine generated
433 program to be like that. So I think 1000 is already generous. If
434 we look at xdisp.c, its AST only have 30 levels. */
435#define TREESIT_RECURSION_LIMIT 1000
436
437static bool treesit_initialized = false;
428 438
429static bool 439static bool
430load_tree_sitter_if_necessary (bool required) 440load_tree_sitter_if_necessary (bool required)
@@ -478,40 +488,47 @@ treesit_initialize (void)
478static void 488static void
479treesit_symbol_to_c_name (char *symbol_name) 489treesit_symbol_to_c_name (char *symbol_name)
480{ 490{
481 for (int idx = 0; idx < strlen (symbol_name); idx++) 491 size_t len = strlen (symbol_name);
492 for (int idx = 0; idx < len; idx++)
482 { 493 {
483 if (symbol_name[idx] == '-') 494 if (symbol_name[idx] == '-')
484 symbol_name[idx] = '_'; 495 symbol_name[idx] = '_';
485 } 496 }
486} 497}
487 498
499/* Find the override name for LANGUAGE_SYMBOL in
500 treesit-load-name-override-list. Set NAME and C_SYMBOL to the
501 override name, and return true if there exists one, otherwise
502 return false.
503
504 This function may signal if treesit-load-name-override-list is
505 malformed. */
488static bool 506static bool
489treesit_find_override_name (Lisp_Object language_symbol, Lisp_Object *name, 507treesit_find_override_name (Lisp_Object language_symbol, Lisp_Object *name,
490 Lisp_Object *c_symbol) 508 Lisp_Object *c_symbol)
491{ 509{
492 Lisp_Object tem;
493
494 CHECK_LIST (Vtreesit_load_name_override_list); 510 CHECK_LIST (Vtreesit_load_name_override_list);
511 Lisp_Object tail = Vtreesit_load_name_override_list;
495 512
496 tem = Vtreesit_load_name_override_list; 513 FOR_EACH_TAIL (tail)
497
498 FOR_EACH_TAIL (tem)
499 { 514 {
500 Lisp_Object lang = XCAR (XCAR (tem)); 515 Lisp_Object entry = XCAR (tail);
516 CHECK_LIST (entry);
517 Lisp_Object lang = XCAR (entry);
501 CHECK_SYMBOL (lang); 518 CHECK_SYMBOL (lang);
502 519
503 if (EQ (lang, language_symbol)) 520 if (EQ (lang, language_symbol))
504 { 521 {
505 *name = Fnth (make_fixnum (1), XCAR (tem)); 522 *name = Fnth (make_fixnum (1), entry);
506 CHECK_STRING (*name); 523 CHECK_STRING (*name);
507 *c_symbol = Fnth (make_fixnum (2), XCAR (tem)); 524 *c_symbol = Fnth (make_fixnum (2), entry);
508 CHECK_STRING (*c_symbol); 525 CHECK_STRING (*c_symbol);
509 526
510 return true; 527 return true;
511 } 528 }
512 } 529 }
513 530
514 CHECK_LIST_END (tem, Vtreesit_load_name_override_list); 531 CHECK_LIST_END (tail, Vtreesit_load_name_override_list);
515 532
516 return false; 533 return false;
517} 534}
@@ -529,8 +546,21 @@ treesit_load_language_push_for_each_suffix (Lisp_Object lib_base_name,
529 suffixes = Vdynamic_library_suffixes; 546 suffixes = Vdynamic_library_suffixes;
530 547
531 FOR_EACH_TAIL (suffixes) 548 FOR_EACH_TAIL (suffixes)
532 *path_candidates = Fcons (concat2 (lib_base_name, XCAR (suffixes)), 549 {
533 *path_candidates); 550 Lisp_Object candidate1 = concat2 (lib_base_name, XCAR (suffixes));
551#ifndef WINDOWSNT
552 /* On Posix hosts, support libraries named with ABI version
553 numbers. In the foreseeable future we only need to support
554 version 0.0. For more details, see
555 https://lists.gnu.org/archive/html/emacs-devel/2023-04/msg00386.html. */
556 Lisp_Object candidate2 = concat2 (candidate1, Vtreesit_str_dot_0);
557 Lisp_Object candidate3 = concat2 (candidate2, Vtreesit_str_dot_0);
558
559 *path_candidates = Fcons (candidate3, *path_candidates);
560 *path_candidates = Fcons (candidate2, *path_candidates);
561#endif
562 *path_candidates = Fcons (candidate1, *path_candidates);
563 }
534} 564}
535 565
536/* Load the dynamic library of LANGUAGE_SYMBOL and return the pointer 566/* Load the dynamic library of LANGUAGE_SYMBOL and return the pointer
@@ -1016,11 +1046,6 @@ treesit_call_after_change_functions (TSTree *old_tree, TSTree *new_tree,
1016static void 1046static void
1017treesit_ensure_parsed (Lisp_Object parser) 1047treesit_ensure_parsed (Lisp_Object parser)
1018{ 1048{
1019 /* Make sure this comes before everything else, see comment
1020 (ref:notifier-inside-ensure-parsed) for more detail. */
1021 if (!XTS_PARSER (parser)->need_reparse)
1022 return;
1023
1024 struct buffer *buffer = XBUFFER (XTS_PARSER (parser)->buffer); 1049 struct buffer *buffer = XBUFFER (XTS_PARSER (parser)->buffer);
1025 1050
1026 /* Before we parse, catch up with the narrowing situation. */ 1051 /* Before we parse, catch up with the narrowing situation. */
@@ -1029,6 +1054,11 @@ treesit_ensure_parsed (Lisp_Object parser)
1029 because it might set the flag to true. */ 1054 because it might set the flag to true. */
1030 treesit_sync_visible_region (parser); 1055 treesit_sync_visible_region (parser);
1031 1056
1057 /* Make sure this comes before everything else, see comment
1058 (ref:notifier-inside-ensure-parsed) for more detail. */
1059 if (!XTS_PARSER (parser)->need_reparse)
1060 return;
1061
1032 TSParser *treesit_parser = XTS_PARSER (parser)->parser; 1062 TSParser *treesit_parser = XTS_PARSER (parser)->parser;
1033 TSTree *tree = XTS_PARSER (parser)->tree; 1063 TSTree *tree = XTS_PARSER (parser)->tree;
1034 TSInput input = XTS_PARSER (parser)->input; 1064 TSInput input = XTS_PARSER (parser)->input;
@@ -1619,6 +1649,9 @@ buffer. */)
1619 TSRange *treesit_ranges = xmalloc (sizeof (TSRange) * len); 1649 TSRange *treesit_ranges = xmalloc (sizeof (TSRange) * len);
1620 struct buffer *buffer = XBUFFER (XTS_PARSER (parser)->buffer); 1650 struct buffer *buffer = XBUFFER (XTS_PARSER (parser)->buffer);
1621 1651
1652 /* We can use XFUXNUM, XCAR, XCDR freely because we have checked
1653 the input by treesit_check_range_argument. */
1654
1622 for (int idx = 0; !NILP (ranges); idx++, ranges = XCDR (ranges)) 1655 for (int idx = 0; !NILP (ranges); idx++, ranges = XCDR (ranges))
1623 { 1656 {
1624 Lisp_Object range = XCAR (ranges); 1657 Lisp_Object range = XCAR (ranges);
@@ -1639,9 +1672,6 @@ buffer. */)
1639 } 1672 }
1640 success = ts_parser_set_included_ranges (XTS_PARSER (parser)->parser, 1673 success = ts_parser_set_included_ranges (XTS_PARSER (parser)->parser,
1641 treesit_ranges, len); 1674 treesit_ranges, len);
1642 /* Although XFIXNUM could signal, it should be impossible
1643 because we have checked the input by treesit_check_range_argument.
1644 So there is no need for unwind-protect. */
1645 xfree (treesit_ranges); 1675 xfree (treesit_ranges);
1646 } 1676 }
1647 1677
@@ -1962,19 +1992,19 @@ live. */)
1962 TSNode treesit_node = XTS_NODE (node)->node; 1992 TSNode treesit_node = XTS_NODE (node)->node;
1963 bool result; 1993 bool result;
1964 1994
1965 if (EQ (property, Qoutdated)) 1995 if (BASE_EQ (property, Qoutdated))
1966 return treesit_node_uptodate_p (node) ? Qnil : Qt; 1996 return treesit_node_uptodate_p (node) ? Qnil : Qt;
1967 1997
1968 treesit_check_node (node); 1998 treesit_check_node (node);
1969 if (EQ (property, Qnamed)) 1999 if (BASE_EQ (property, Qnamed))
1970 result = ts_node_is_named (treesit_node); 2000 result = ts_node_is_named (treesit_node);
1971 else if (EQ (property, Qmissing)) 2001 else if (BASE_EQ (property, Qmissing))
1972 result = ts_node_is_missing (treesit_node); 2002 result = ts_node_is_missing (treesit_node);
1973 else if (EQ (property, Qextra)) 2003 else if (BASE_EQ (property, Qextra))
1974 result = ts_node_is_extra (treesit_node); 2004 result = ts_node_is_extra (treesit_node);
1975 else if (EQ (property, Qhas_error)) 2005 else if (BASE_EQ (property, Qhas_error))
1976 result = ts_node_has_error (treesit_node); 2006 result = ts_node_has_error (treesit_node);
1977 else if (EQ (property, Qlive)) 2007 else if (BASE_EQ (property, Qlive))
1978 result = treesit_parser_live_p (XTS_NODE (node)->parser); 2008 result = treesit_parser_live_p (XTS_NODE (node)->parser);
1979 else 2009 else
1980 signal_error ("Expecting `named', `missing', `extra', " 2010 signal_error ("Expecting `named', `missing', `extra', "
@@ -2293,19 +2323,19 @@ PATTERN can be
2293See Info node `(elisp)Pattern Matching' for detailed explanation. */) 2323See Info node `(elisp)Pattern Matching' for detailed explanation. */)
2294 (Lisp_Object pattern) 2324 (Lisp_Object pattern)
2295{ 2325{
2296 if (EQ (pattern, QCanchor)) 2326 if (BASE_EQ (pattern, QCanchor))
2297 return Vtreesit_str_dot; 2327 return Vtreesit_str_dot;
2298 if (EQ (pattern, intern_c_string (":?"))) 2328 if (BASE_EQ (pattern, QCquestion))
2299 return Vtreesit_str_question_mark; 2329 return Vtreesit_str_question_mark;
2300 if (EQ (pattern, intern_c_string (":*"))) 2330 if (BASE_EQ (pattern, QCstar))
2301 return Vtreesit_str_star; 2331 return Vtreesit_str_star;
2302 if (EQ (pattern, intern_c_string (":+"))) 2332 if (BASE_EQ (pattern, QCplus))
2303 return Vtreesit_str_plus; 2333 return Vtreesit_str_plus;
2304 if (EQ (pattern, QCequal)) 2334 if (BASE_EQ (pattern, QCequal))
2305 return Vtreesit_str_pound_equal; 2335 return Vtreesit_str_pound_equal;
2306 if (EQ (pattern, QCmatch)) 2336 if (BASE_EQ (pattern, QCmatch))
2307 return Vtreesit_str_pound_match; 2337 return Vtreesit_str_pound_match;
2308 if (EQ (pattern, QCpred)) 2338 if (BASE_EQ (pattern, QCpred))
2309 return Vtreesit_str_pound_pred; 2339 return Vtreesit_str_pound_pred;
2310 Lisp_Object opening_delimeter 2340 Lisp_Object opening_delimeter
2311 = VECTORP (pattern) 2341 = VECTORP (pattern)
@@ -2407,87 +2437,111 @@ treesit_predicates_for_pattern (TSQuery *query, uint32_t pattern_index)
2407 return Fnreverse (result); 2437 return Fnreverse (result);
2408} 2438}
2409 2439
2410/* Translate a capture NAME (symbol) to a node. 2440/* Translate a capture NAME (symbol) to a node. If everything goes
2411 Signals treesit-query-error if such node is not captured. */ 2441 fine, set NODE and return true; if error occurs (e.g., when there
2412static Lisp_Object 2442 is no node for the capture name), set NODE to Qnil, SIGNAL_DATA to
2443 a suitable signal data, and return false. */
2444static bool
2413treesit_predicate_capture_name_to_node (Lisp_Object name, 2445treesit_predicate_capture_name_to_node (Lisp_Object name,
2414 struct capture_range captures) 2446 struct capture_range captures,
2447 Lisp_Object *node,
2448 Lisp_Object *signal_data)
2415{ 2449{
2416 Lisp_Object node = Qnil; 2450 *node = Qnil;
2417 for (Lisp_Object tail = captures.start; !EQ (tail, captures.end); 2451 for (Lisp_Object tail = captures.start; !EQ (tail, captures.end);
2418 tail = XCDR (tail)) 2452 tail = XCDR (tail))
2419 { 2453 {
2420 if (EQ (XCAR (XCAR (tail)), name)) 2454 if (EQ (XCAR (XCAR (tail)), name))
2421 { 2455 {
2422 node = XCDR (XCAR (tail)); 2456 *node = XCDR (XCAR (tail));
2423 break; 2457 break;
2424 } 2458 }
2425 } 2459 }
2426 2460
2427 if (NILP (node)) 2461 if (NILP (*node))
2428 xsignal3 (Qtreesit_query_error, 2462 {
2429 build_string ("Cannot find captured node"), 2463 *signal_data = list3 (build_string ("Cannot find captured node"),
2430 name, build_string ("A predicate can only refer" 2464 name, build_string ("A predicate can only refer"
2431 " to captured nodes in the " 2465 " to captured nodes in the "
2432 "same pattern")); 2466 "same pattern"));
2433 return node; 2467 return false;
2468 }
2469 return true;
2434} 2470}
2435 2471
2436/* Translate a capture NAME (symbol) to the text of the captured node. 2472/* Translate a capture NAME (symbol) to the text of the captured node.
2437 Signals treesit-query-error if such node is not captured. */ 2473 If everything goes fine, set TEXT to the text and return true;
2438static Lisp_Object 2474 otherwise set TEXT to Qnil and set SIGNAL_DATA to a suitable signal
2475 data. */
2476static bool
2439treesit_predicate_capture_name_to_text (Lisp_Object name, 2477treesit_predicate_capture_name_to_text (Lisp_Object name,
2440 struct capture_range captures) 2478 struct capture_range captures,
2479 Lisp_Object *text,
2480 Lisp_Object *signal_data)
2441{ 2481{
2442 Lisp_Object node = treesit_predicate_capture_name_to_node (name, captures); 2482 Lisp_Object node = Qnil;
2483 if (!treesit_predicate_capture_name_to_node (name, captures, &node, signal_data))
2484 return false;
2443 2485
2444 struct buffer *old_buffer = current_buffer; 2486 struct buffer *old_buffer = current_buffer;
2445 set_buffer_internal (XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer)); 2487 set_buffer_internal (XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer));
2446 Lisp_Object text = Fbuffer_substring (Ftreesit_node_start (node), 2488 *text = Fbuffer_substring (Ftreesit_node_start (node),
2447 Ftreesit_node_end (node)); 2489 Ftreesit_node_end (node));
2448 set_buffer_internal (old_buffer); 2490 set_buffer_internal (old_buffer);
2449 return text; 2491 return true;
2450} 2492}
2451 2493
2452/* Handles predicate (#equal A B). Return true if A equals B; return 2494/* Handles predicate (#equal A B). Return true if A equals B; return
2453 false otherwise. A and B can be either string, or a capture name. 2495 false otherwise. A and B can be either string, or a capture name.
2454 The capture name evaluates to the text its captured node spans in 2496 The capture name evaluates to the text its captured node spans in
2455 the buffer. */ 2497 the buffer. If everything goes fine, don't touch SIGNAL_DATA; if
2498 error occurs, set it to a suitable signal data. */
2456static bool 2499static bool
2457treesit_predicate_equal (Lisp_Object args, struct capture_range captures) 2500treesit_predicate_equal (Lisp_Object args, struct capture_range captures,
2501 Lisp_Object *signal_data)
2458{ 2502{
2459 if (XFIXNUM (Flength (args)) != 2) 2503 if (XFIXNUM (Flength (args)) != 2)
2460 xsignal2 (Qtreesit_query_error, 2504 {
2461 build_string ("Predicate `equal' requires " 2505 *signal_data = list2 (build_string ("Predicate `equal' requires "
2462 "two arguments but only given"), 2506 "two arguments but only given"),
2463 Flength (args)); 2507 Flength (args));
2464 2508 return false;
2509 }
2465 Lisp_Object arg1 = XCAR (args); 2510 Lisp_Object arg1 = XCAR (args);
2466 Lisp_Object arg2 = XCAR (XCDR (args)); 2511 Lisp_Object arg2 = XCAR (XCDR (args));
2467 Lisp_Object text1 = (STRINGP (arg1) 2512 Lisp_Object text1 = arg1;
2468 ? arg1 2513 Lisp_Object text2 = arg2;
2469 : treesit_predicate_capture_name_to_text (arg1, 2514 if (SYMBOLP (arg1))
2470 captures)); 2515 {
2471 Lisp_Object text2 = (STRINGP (arg2) 2516 if (!treesit_predicate_capture_name_to_text (arg1, captures, &text1,
2472 ? arg2 2517 signal_data))
2473 : treesit_predicate_capture_name_to_text (arg2, 2518 return false;
2474 captures)); 2519 }
2520 if (SYMBOLP (arg2))
2521 {
2522 if (!treesit_predicate_capture_name_to_text (arg2, captures, &text2,
2523 signal_data))
2524 return false;
2525 }
2475 2526
2476 return !NILP (Fstring_equal (text1, text2)); 2527 return !NILP (Fstring_equal (text1, text2));
2477} 2528}
2478 2529
2479/* Handles predicate (#match "regexp" @node). Return true if "regexp" 2530/* Handles predicate (#match "regexp" @node). Return true if "regexp"
2480 matches the text spanned by @node; return false otherwise. Matching 2531 matches the text spanned by @node; return false otherwise.
2481 is case-sensitive. */ 2532 Matching is case-sensitive. If everything goes fine, don't touch
2533 SIGNAL_DATA; if error occurs, set it to a suitable signal data. */
2482static bool 2534static bool
2483treesit_predicate_match (Lisp_Object args, struct capture_range captures) 2535treesit_predicate_match (Lisp_Object args, struct capture_range captures,
2536 Lisp_Object *signal_data)
2484{ 2537{
2485 if (XFIXNUM (Flength (args)) != 2) 2538 if (XFIXNUM (Flength (args)) != 2)
2486 xsignal2 (Qtreesit_query_error, 2539 {
2487 build_string ("Predicate `match' requires two " 2540 *signal_data = list2 (build_string ("Predicate `match' requires two "
2488 "arguments but only given"), 2541 "arguments but only given"),
2489 Flength (args)); 2542 Flength (args));
2490 2543 return false;
2544 }
2491 Lisp_Object regexp = XCAR (args); 2545 Lisp_Object regexp = XCAR (args);
2492 Lisp_Object capture_name = XCAR (XCDR (args)); 2546 Lisp_Object capture_name = XCAR (XCDR (args));
2493 2547
@@ -2504,12 +2558,10 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures)
2504 build_string ("The second argument to `match' should " 2558 build_string ("The second argument to `match' should "
2505 "be a capture name, not a string")); 2559 "be a capture name, not a string"));
2506 2560
2507 Lisp_Object node = treesit_predicate_capture_name_to_node (capture_name, 2561 Lisp_Object node = Qnil;
2508 captures); 2562 if (!treesit_predicate_capture_name_to_node (capture_name, captures, &node,
2509 2563 signal_data))
2510 struct buffer *old_buffer = current_buffer; 2564 return false;
2511 struct buffer *buffer = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer);
2512 set_buffer_internal (buffer);
2513 2565
2514 TSNode treesit_node = XTS_NODE (node)->node; 2566 TSNode treesit_node = XTS_NODE (node)->node;
2515 ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg; 2567 ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg;
@@ -2537,61 +2589,71 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures)
2537 ZV = old_zv; 2589 ZV = old_zv;
2538 ZV_BYTE = old_zv_byte; 2590 ZV_BYTE = old_zv_byte;
2539 2591
2540 set_buffer_internal (old_buffer);
2541
2542 return (val > 0); 2592 return (val > 0);
2543} 2593}
2544 2594
2545/* Handles predicate (#pred FN ARG...). Return true if FN returns 2595/* Handles predicate (#pred FN ARG...). Return true if FN returns
2546 non-nil; return false otherwise. The arity of FN must match the 2596 non-nil; return false otherwise. The arity of FN must match the
2547 number of ARGs */ 2597 number of ARGs. If everything goes fine, don't touch SIGNAL_DATA;
2598 if error occurs, set it to a suitable signal data. */
2548static bool 2599static bool
2549treesit_predicate_pred (Lisp_Object args, struct capture_range captures) 2600treesit_predicate_pred (Lisp_Object args, struct capture_range captures,
2601 Lisp_Object *signal_data)
2550{ 2602{
2551 if (XFIXNUM (Flength (args)) < 2) 2603 if (XFIXNUM (Flength (args)) < 2)
2552 xsignal2 (Qtreesit_query_error, 2604 {
2553 build_string ("Predicate `pred' requires " 2605 *signal_data = list2 (build_string ("Predicate `pred' requires "
2554 "at least two arguments, " 2606 "at least two arguments, "
2555 "but was only given"), 2607 "but was only given"),
2556 Flength (args)); 2608 Flength (args));
2609 return false;
2610 }
2557 2611
2558 Lisp_Object fn = Fintern (XCAR (args), Qnil); 2612 Lisp_Object fn = Fintern (XCAR (args), Qnil);
2559 Lisp_Object nodes = Qnil; 2613 Lisp_Object nodes = Qnil;
2560 Lisp_Object tail = XCDR (args); 2614 Lisp_Object tail = XCDR (args);
2561 FOR_EACH_TAIL (tail) 2615 FOR_EACH_TAIL (tail)
2562 nodes = Fcons (treesit_predicate_capture_name_to_node (XCAR (tail), 2616 {
2563 captures), 2617 Lisp_Object node = Qnil;
2564 nodes); 2618 if (!treesit_predicate_capture_name_to_node (XCAR (tail), captures, &node,
2619 signal_data))
2620 return false;
2621 nodes = Fcons (node, nodes);
2622 }
2565 nodes = Fnreverse (nodes); 2623 nodes = Fnreverse (nodes);
2566 2624
2567 return !NILP (CALLN (Fapply, fn, nodes)); 2625 return !NILP (CALLN (Fapply, fn, nodes));
2568} 2626}
2569 2627
2570/* If all predicates in PREDICATES passes, return true; otherwise 2628/* If all predicates in PREDICATES passes, return true; otherwise
2571 return false. */ 2629 return false. If everything goes fine, don't touch SIGNAL_DATA; if
2630 error occurs, set it to a suitable signal data. */
2572static bool 2631static bool
2573treesit_eval_predicates (struct capture_range captures, Lisp_Object predicates) 2632treesit_eval_predicates (struct capture_range captures, Lisp_Object predicates,
2633 Lisp_Object *signal_data)
2574{ 2634{
2575 bool pass = true; 2635 bool pass = true;
2576 /* Evaluate each predicates. */ 2636 /* Evaluate each predicates. */
2577 for (Lisp_Object tail = predicates; 2637 for (Lisp_Object tail = predicates;
2578 !NILP (tail); tail = XCDR (tail)) 2638 pass && !NILP (tail); tail = XCDR (tail))
2579 { 2639 {
2580 Lisp_Object predicate = XCAR (tail); 2640 Lisp_Object predicate = XCAR (tail);
2581 Lisp_Object fn = XCAR (predicate); 2641 Lisp_Object fn = XCAR (predicate);
2582 Lisp_Object args = XCDR (predicate); 2642 Lisp_Object args = XCDR (predicate);
2583 if (!NILP (Fstring_equal (fn, Vtreesit_str_equal))) 2643 if (!NILP (Fstring_equal (fn, Vtreesit_str_equal)))
2584 pass &= treesit_predicate_equal (args, captures); 2644 pass &= treesit_predicate_equal (args, captures, signal_data);
2585 else if (!NILP (Fstring_equal (fn, Vtreesit_str_match))) 2645 else if (!NILP (Fstring_equal (fn, Vtreesit_str_match)))
2586 pass &= treesit_predicate_match (args, captures); 2646 pass &= treesit_predicate_match (args, captures, signal_data);
2587 else if (!NILP (Fstring_equal (fn, Vtreesit_str_pred))) 2647 else if (!NILP (Fstring_equal (fn, Vtreesit_str_pred)))
2588 pass &= treesit_predicate_pred (args, captures); 2648 pass &= treesit_predicate_pred (args, captures, signal_data);
2589 else 2649 else
2590 xsignal3 (Qtreesit_query_error, 2650 {
2591 build_string ("Invalid predicate"), 2651 *signal_data = list3 (build_string ("Invalid predicate"),
2592 fn, build_string ("Currently Emacs only supports" 2652 fn, build_string ("Currently Emacs only supports"
2593 " equal, match, and pred" 2653 " equal, match, and pred"
2594 " predicate")); 2654 " predicates"));
2655 pass = false;
2656 }
2595 } 2657 }
2596 /* If all predicates passed, add captures to result list. */ 2658 /* If all predicates passed, add captures to result list. */
2597 return pass; 2659 return pass;
@@ -2631,8 +2693,8 @@ You can use `treesit-query-validate' to validate and debug a query. */)
2631 Lisp_Object signal_symbol = Qnil; 2693 Lisp_Object signal_symbol = Qnil;
2632 Lisp_Object signal_data = Qnil; 2694 Lisp_Object signal_data = Qnil;
2633 TSQuery *treesit_query = treesit_ensure_query_compiled (lisp_query, 2695 TSQuery *treesit_query = treesit_ensure_query_compiled (lisp_query,
2634 &signal_symbol, 2696 &signal_symbol,
2635 &signal_data); 2697 &signal_data);
2636 2698
2637 if (treesit_query == NULL) 2699 if (treesit_query == NULL)
2638 xsignal (signal_symbol, signal_data); 2700 xsignal (signal_symbol, signal_data);
@@ -2641,6 +2703,92 @@ You can use `treesit-query-validate' to validate and debug a query. */)
2641 } 2703 }
2642} 2704}
2643 2705
2706/* Resolve OBJ into a tree-sitter node Lisp_Object. OBJ can be a
2707 node, a parser, or a language symbol. Note that this function can
2708 signal. */
2709static Lisp_Object treesit_resolve_node (Lisp_Object obj)
2710{
2711 if (TS_NODEP (obj))
2712 {
2713 treesit_check_node (obj); /* Check if up-to-date. */
2714 return obj;
2715 }
2716 else if (TS_PARSERP (obj))
2717 {
2718 treesit_check_parser (obj); /* Check if deleted. */
2719 return Ftreesit_parser_root_node (obj);
2720 }
2721 else if (SYMBOLP (obj))
2722 {
2723 Lisp_Object parser
2724 = Ftreesit_parser_create (obj, Fcurrent_buffer (), Qnil);
2725 return Ftreesit_parser_root_node (parser);
2726 }
2727 else
2728 xsignal2 (Qwrong_type_argument,
2729 list4 (Qor, Qtreesit_node_p, Qtreesit_parser_p, Qsymbolp),
2730 obj);
2731}
2732
2733/* Create and initialize QUERY. When success, initialize TS_QUERY,
2734 CURSOR, and NEED_FREE, and return true; if failed, initialize
2735 SIGNAL_SYMBOL and SIGNAL_DATA, and return false. If NEED_FREE is
2736 initialized to true, the TS_QUERY and CURSOR needs to be freed
2737 after use; otherwise they shouldn't be freed by hand.
2738
2739 Basically this function looks at QUERY and check its type, if QUERY
2740 is a compiled query, this function takes out its query and cursor;
2741 if QUERY is a string or a cons, this function creates a new query
2742 and cursor (so they need to be manually freed).
2743
2744 This function assumes QUERY is either a compiled query, a string or
2745 a cons, the caller should make sure QUERY is valid.
2746
2747 LANG is the language to use if we need to create the query and
2748 cursor. */
2749static bool
2750treesit_initialize_query (Lisp_Object query, const TSLanguage *lang,
2751 TSQuery **ts_query, TSQueryCursor **cursor,
2752 bool *need_free, Lisp_Object *signal_symbol,
2753 Lisp_Object *signal_data)
2754{
2755 if (TS_COMPILED_QUERY_P (query))
2756 {
2757 *ts_query = treesit_ensure_query_compiled (query, signal_symbol,
2758 signal_data);
2759 *cursor = XTS_COMPILED_QUERY (query)->cursor;
2760 /* We don't need to free ts_query and cursor because they
2761 are stored in a lisp object, which is tracked by gc. */
2762 *need_free = false;
2763 return (*ts_query != NULL);
2764 }
2765 else
2766 {
2767 /* Since query is not TS_COMPILED_QUERY, it can only be a string
2768 or a cons. */
2769 if (CONSP (query))
2770 query = Ftreesit_query_expand (query);
2771 char *query_string = SSDATA (query);
2772 uint32_t error_offset;
2773 TSQueryError error_type;
2774 *ts_query = ts_query_new (lang, query_string, strlen (query_string),
2775 &error_offset, &error_type);
2776 if (*ts_query == NULL)
2777 {
2778 *signal_symbol = Qtreesit_query_error;
2779 *signal_data = treesit_compose_query_signal_data (error_offset,
2780 error_type, query);
2781 return false;
2782 }
2783 else
2784 {
2785 *cursor = ts_query_cursor_new ();
2786 *need_free = true;
2787 return true;
2788 }
2789 }
2790}
2791
2644DEFUN ("treesit-query-capture", 2792DEFUN ("treesit-query-capture",
2645 Ftreesit_query_capture, 2793 Ftreesit_query_capture,
2646 Streesit_query_capture, 2, 5, 0, 2794 Streesit_query_capture, 2, 5, 0,
@@ -2681,35 +2829,12 @@ the query. */)
2681 treesit_initialize (); 2829 treesit_initialize ();
2682 2830
2683 /* Resolve NODE into an actual node. */ 2831 /* Resolve NODE into an actual node. */
2684 Lisp_Object lisp_node; 2832 Lisp_Object lisp_node = treesit_resolve_node (node);
2685 if (TS_NODEP (node))
2686 {
2687 treesit_check_node (node); /* Check if up-to-date. */
2688 lisp_node = node;
2689 }
2690 else if (TS_PARSERP (node))
2691 {
2692 treesit_check_parser (node); /* Check if deleted. */
2693 lisp_node = Ftreesit_parser_root_node (node);
2694 }
2695 else if (SYMBOLP (node))
2696 {
2697 Lisp_Object parser
2698 = Ftreesit_parser_create (node, Fcurrent_buffer (), Qnil);
2699 lisp_node = Ftreesit_parser_root_node (parser);
2700 }
2701 else
2702 xsignal2 (Qwrong_type_argument,
2703 list4 (Qor, Qtreesit_node_p, Qtreesit_parser_p, Qsymbolp),
2704 node);
2705 2833
2706 /* Extract C values from Lisp objects. */ 2834 /* Extract C values from Lisp objects. */
2707 TSNode treesit_node 2835 TSNode treesit_node = XTS_NODE (lisp_node)->node;
2708 = XTS_NODE (lisp_node)->node; 2836 Lisp_Object lisp_parser = XTS_NODE (lisp_node)->parser;
2709 Lisp_Object lisp_parser 2837
2710 = XTS_NODE (lisp_node)->parser;
2711 ptrdiff_t visible_beg
2712 = XTS_PARSER (XTS_NODE (lisp_node)->parser)->visible_beg;
2713 const TSLanguage *lang 2838 const TSLanguage *lang
2714 = ts_parser_language (XTS_PARSER (lisp_parser)->parser); 2839 = ts_parser_language (XTS_PARSER (lisp_parser)->parser);
2715 2840
@@ -2725,44 +2850,21 @@ the query. */)
2725 TSQuery *treesit_query; 2850 TSQuery *treesit_query;
2726 TSQueryCursor *cursor; 2851 TSQueryCursor *cursor;
2727 bool needs_to_free_query_and_cursor; 2852 bool needs_to_free_query_and_cursor;
2728 if (TS_COMPILED_QUERY_P (query)) 2853 Lisp_Object signal_symbol;
2729 { 2854 Lisp_Object signal_data;
2730 Lisp_Object signal_symbol = Qnil; 2855 if (!treesit_initialize_query (query, lang, &treesit_query, &cursor,
2731 Lisp_Object signal_data = Qnil; 2856 &needs_to_free_query_and_cursor,
2732 treesit_query = treesit_ensure_query_compiled (query, &signal_symbol, 2857 &signal_symbol, &signal_data))
2733 &signal_data); 2858 xsignal (signal_symbol, signal_data);
2734 cursor = XTS_COMPILED_QUERY (query)->cursor;
2735 /* We don't need to free ts_query and cursor because they
2736 are stored in a lisp object, which is tracked by gc. */
2737 needs_to_free_query_and_cursor = false;
2738 if (treesit_query == NULL)
2739 xsignal (signal_symbol, signal_data);
2740 }
2741 else
2742 {
2743 /* Since query is not TS_COMPILED_QUERY, it can only be a string
2744 or a cons. */
2745 if (CONSP (query))
2746 query = Ftreesit_query_expand (query);
2747 char *query_string = SSDATA (query);
2748 uint32_t error_offset;
2749 TSQueryError error_type;
2750 treesit_query = ts_query_new (lang, query_string, strlen (query_string),
2751 &error_offset, &error_type);
2752 if (treesit_query == NULL)
2753 xsignal (Qtreesit_query_error,
2754 treesit_compose_query_signal_data (error_offset,
2755 error_type, query));
2756 cursor = ts_query_cursor_new ();
2757 needs_to_free_query_and_cursor = true;
2758 }
2759 2859
2760 /* WARN: After this point, free treesit_query and cursor before every 2860 /* WARN: After this point, free TREESIT_QUERY and CURSOR before every
2761 signal and return. */ 2861 signal and return if NEEDS_TO_FREE_QUERY_AND_CURSOR is true. */
2762 2862
2763 /* Set query range. */ 2863 /* Set query range. */
2764 if (!NILP (beg) && !NILP (end)) 2864 if (!NILP (beg) && !NILP (end))
2765 { 2865 {
2866 ptrdiff_t visible_beg
2867 = XTS_PARSER (XTS_NODE (lisp_node)->parser)->visible_beg;
2766 ptrdiff_t beg_byte = CHAR_TO_BYTE (XFIXNUM (beg)); 2868 ptrdiff_t beg_byte = CHAR_TO_BYTE (XFIXNUM (beg));
2767 ptrdiff_t end_byte = CHAR_TO_BYTE (XFIXNUM (end)); 2869 ptrdiff_t end_byte = CHAR_TO_BYTE (XFIXNUM (end));
2768 /* We never let tree-sitter run on buffers too large, so these 2870 /* We never let tree-sitter run on buffers too large, so these
@@ -2791,11 +2893,16 @@ the query. */)
2791 Lisp_Object result = Qnil; 2893 Lisp_Object result = Qnil;
2792 Lisp_Object prev_result = result; 2894 Lisp_Object prev_result = result;
2793 Lisp_Object predicates_table = make_vector (patterns_count, Qt); 2895 Lisp_Object predicates_table = make_vector (patterns_count, Qt);
2896 Lisp_Object predicate_signal_data = Qnil;
2897
2898 struct buffer *old_buf = current_buffer;
2899 set_buffer_internal (buf);
2900
2794 while (ts_query_cursor_next_match (cursor, &match)) 2901 while (ts_query_cursor_next_match (cursor, &match))
2795 { 2902 {
2796 /* Record the checkpoint that we may roll back to. */ 2903 /* Record the checkpoint that we may roll back to. */
2797 prev_result = result; 2904 prev_result = result;
2798 /* Get captured nodes. */ 2905 /* 1. Get captured nodes. */
2799 const TSQueryCapture *captures = match.captures; 2906 const TSQueryCapture *captures = match.captures;
2800 for (int idx = 0; idx < match.capture_count; idx++) 2907 for (int idx = 0; idx < match.capture_count; idx++)
2801 { 2908 {
@@ -2818,9 +2925,10 @@ the query. */)
2818 2925
2819 result = Fcons (cap, result); 2926 result = Fcons (cap, result);
2820 } 2927 }
2821 /* Get predicates. */ 2928 /* 2. Get predicates and check whether this match can be
2929 included in the result list. */
2822 Lisp_Object predicates = AREF (predicates_table, match.pattern_index); 2930 Lisp_Object predicates = AREF (predicates_table, match.pattern_index);
2823 if (EQ (predicates, Qt)) 2931 if (BASE_EQ (predicates, Qt))
2824 { 2932 {
2825 predicates = treesit_predicates_for_pattern (treesit_query, 2933 predicates = treesit_predicates_for_pattern (treesit_query,
2826 match.pattern_index); 2934 match.pattern_index);
@@ -2829,15 +2937,28 @@ the query. */)
2829 2937
2830 /* captures_lisp = Fnreverse (captures_lisp); */ 2938 /* captures_lisp = Fnreverse (captures_lisp); */
2831 struct capture_range captures_range = { result, prev_result }; 2939 struct capture_range captures_range = { result, prev_result };
2832 if (!treesit_eval_predicates (captures_range, predicates)) 2940 bool match = treesit_eval_predicates (captures_range, predicates,
2833 /* Predicates didn't pass, roll back. */ 2941 &predicate_signal_data);
2942 if (!NILP (predicate_signal_data))
2943 break;
2944
2945 /* Predicates didn't pass, roll back. */
2946 if (!match)
2834 result = prev_result; 2947 result = prev_result;
2835 } 2948 }
2949
2950 /* Final clean up. */
2836 if (needs_to_free_query_and_cursor) 2951 if (needs_to_free_query_and_cursor)
2837 { 2952 {
2838 ts_query_delete (treesit_query); 2953 ts_query_delete (treesit_query);
2839 ts_query_cursor_delete (cursor); 2954 ts_query_cursor_delete (cursor);
2840 } 2955 }
2956 set_buffer_internal (old_buf);
2957
2958 /* Some capture predicate signaled an error. */
2959 if (!NILP (predicate_signal_data))
2960 xsignal (Qtreesit_query_error, predicate_signal_data);
2961
2841 return Fnreverse (result); 2962 return Fnreverse (result);
2842} 2963}
2843 2964
@@ -2917,7 +3038,7 @@ treesit_cursor_helper (TSTreeCursor *cursor, TSNode node, Lisp_Object parser)
2917 TSNode root = ts_tree_root_node (XTS_PARSER (parser)->tree); 3038 TSNode root = ts_tree_root_node (XTS_PARSER (parser)->tree);
2918 *cursor = ts_tree_cursor_new (root); 3039 *cursor = ts_tree_cursor_new (root);
2919 bool success = treesit_cursor_helper_1 (cursor, &node, end_pos, 3040 bool success = treesit_cursor_helper_1 (cursor, &node, end_pos,
2920 treesit_recursion_limit); 3041 TREESIT_RECURSION_LIMIT);
2921 if (!success) 3042 if (!success)
2922 ts_tree_cursor_delete (cursor); 3043 ts_tree_cursor_delete (cursor);
2923 return success; 3044 return success;
@@ -3048,10 +3169,136 @@ treesit_traverse_child_helper (TSTreeCursor *cursor,
3048 } 3169 }
3049} 3170}
3050 3171
3051/* Return true if the node at CURSOR matches PRED. PRED can be a 3172/* Given a symbol THING, and a language symbol LANGUAGE, find the
3052 string or a function. This function assumes PRED is either a 3173 corresponding predicate definition in treesit-things-settings.
3053 string or a function. If NAMED is true, also check that the node 3174 Don't check for the type of THING and LANGUAGE.
3054 is named. */ 3175
3176 If there isn't one, return Qnil. */
3177static Lisp_Object
3178treesit_traverse_get_predicate (Lisp_Object thing, Lisp_Object language)
3179{
3180 Lisp_Object cons = assq_no_quit (language, Vtreesit_thing_settings);
3181 if (NILP (cons))
3182 return Qnil;
3183 Lisp_Object definitions = XCDR (cons);
3184 Lisp_Object entry = assq_no_quit (thing, definitions);
3185 if (NILP (entry))
3186 return Qnil;
3187 /* ENTRY looks like (THING PRED). */
3188 Lisp_Object cdr = XCDR (entry);
3189 if (!CONSP (cdr))
3190 return Qnil;
3191 return XCAR (cdr);
3192}
3193
3194/* Validate the PRED passed to treesit_traverse_match_predicate. If
3195 there's an error, set SIGNAL_DATA to something signal accepts, and
3196 return false, otherwise return true. This function also check for
3197 recusion levels: we place a arbitrary 100 level limit on recursive
3198 predicates. RECURSION_LEVEL is the current recursion level (that
3199 starts at 0), if it goes over 99, return false and set
3200 SIGNAL_DATA. LANGUAGE is a LANGUAGE symbol. */
3201static bool
3202treesit_traverse_validate_predicate (Lisp_Object pred,
3203 Lisp_Object language,
3204 Lisp_Object *signal_data,
3205 ptrdiff_t recursion_level)
3206{
3207 if (recursion_level > 99)
3208 {
3209 *signal_data = list1 (build_string ("Predicate recursion level "
3210 "exceeded: it must not exceed "
3211 "100 levels"));
3212 return false;
3213 }
3214 if (STRINGP (pred))
3215 return true;
3216 else if (FUNCTIONP (pred))
3217 return true;
3218 else if (SYMBOLP (pred))
3219 {
3220 Lisp_Object definition = treesit_traverse_get_predicate (pred,
3221 language);
3222 if (NILP (definition))
3223 {
3224 *signal_data = list2 (build_string ("Cannot find the definition "
3225 "of the predicate in "
3226 "`treesit-thing-settings'"),
3227 pred);
3228 return false;
3229 }
3230 return treesit_traverse_validate_predicate (definition,
3231 language,
3232 signal_data,
3233 recursion_level + 1);
3234 }
3235 else if (CONSP (pred))
3236 {
3237 Lisp_Object car = XCAR (pred);
3238 Lisp_Object cdr = XCDR (pred);
3239 if (BASE_EQ (car, Qnot))
3240 {
3241 if (!CONSP (cdr))
3242 {
3243 *signal_data = list2 (build_string ("Invalide `not' "
3244 "predicate"),
3245 pred);
3246 return false;
3247 }
3248 /* At this point CDR must be a cons. */
3249 if (XFIXNUM (Flength (cdr)) != 1)
3250 {
3251 *signal_data = list2 (build_string ("`not' can only "
3252 "have one argument"),
3253 pred);
3254 return false;
3255 }
3256 return treesit_traverse_validate_predicate (XCAR (cdr),
3257 language,
3258 signal_data,
3259 recursion_level + 1);
3260 }
3261 else if (BASE_EQ (car, Qor))
3262 {
3263 if (!CONSP (cdr) || NILP (cdr))
3264 {
3265 *signal_data = list2 (build_string ("`or' must have a list "
3266 "of patterns as "
3267 "arguments "),
3268 pred);
3269 return false;
3270 }
3271 FOR_EACH_TAIL (cdr)
3272 {
3273 if (!treesit_traverse_validate_predicate (XCAR (cdr),
3274 language,
3275 signal_data,
3276 recursion_level + 1))
3277 return false;
3278 }
3279 return true;
3280 }
3281 else if (STRINGP (car) && FUNCTIONP (cdr))
3282 return true;
3283 }
3284 *signal_data = list2 (build_string ("Invalid predicate, see `treesit-thing-settings' for valid forms of predicate"),
3285 pred);
3286 return false;
3287}
3288
3289/* Return true if the node at CURSOR matches PRED. PRED can be a lot
3290 of things:
3291
3292 PRED := string | function | (string . function)
3293 | (or PRED...) | (not PRED)
3294
3295 See docstring of treesit-search-forward and friends for the meaning
3296 of each shape.
3297
3298 This function assumes PRED is in one of its valid forms. If NAMED
3299 is true, also check that the node is named.
3300
3301 This function may signal if the predicate function signals. */
3055static bool 3302static bool
3056treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred, 3303treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred,
3057 Lisp_Object parser, bool named) 3304 Lisp_Object parser, bool named)
@@ -3065,24 +3312,67 @@ treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred,
3065 const char *type = ts_node_type (node); 3312 const char *type = ts_node_type (node);
3066 return fast_c_string_match (pred, type, strlen (type)) >= 0; 3313 return fast_c_string_match (pred, type, strlen (type)) >= 0;
3067 } 3314 }
3068 else 3315 else if (FUNCTIONP (pred))
3069 { 3316 {
3070 Lisp_Object lisp_node = make_treesit_node (parser, node); 3317 Lisp_Object lisp_node = make_treesit_node (parser, node);
3071 return !NILP (CALLN (Ffuncall, pred, lisp_node)); 3318 return !NILP (CALLN (Ffuncall, pred, lisp_node));
3072 } 3319 }
3320 else if (SYMBOLP (pred))
3321 {
3322 Lisp_Object language = XTS_PARSER (parser)->language_symbol;
3323 Lisp_Object definition = treesit_traverse_get_predicate (pred,
3324 language);
3325 return treesit_traverse_match_predicate (cursor, definition,
3326 parser, named);
3327 }
3328 else if (CONSP (pred))
3329 {
3330 Lisp_Object car = XCAR (pred);
3331 Lisp_Object cdr = XCDR (pred);
3332
3333 if (BASE_EQ (car, Qnot))
3334 return !treesit_traverse_match_predicate (cursor, XCAR (cdr),
3335 parser, named);
3336 else if (BASE_EQ (car, Qor))
3337 {
3338 FOR_EACH_TAIL (cdr)
3339 {
3340 if (treesit_traverse_match_predicate (cursor, XCAR (cdr),
3341 parser, named))
3342 return true;
3343 }
3344 return false;
3345 }
3346 else if (STRINGP (car) && FUNCTIONP (cdr))
3347 {
3348 /* A bit of code duplication here, but should be fine. */
3349 const char *type = ts_node_type (node);
3350 if (!(fast_c_string_match (car, type, strlen (type)) >= 0))
3351 return false;
3352
3353 Lisp_Object lisp_node = make_treesit_node (parser, node);
3354 if (NILP (CALLN (Ffuncall, cdr, lisp_node)))
3355 return false;
3356
3357 return true;
3358 }
3359 }
3360 /* Returning false is better than UB. */
3361 return false;
3073} 3362}
3074 3363
3075/* Traverse the parse tree starting from CURSOR. PRED can be a 3364/* Traverse the parse tree starting from CURSOR. See
3076 function (takes a node and returns nil/non-nil), or a string 3365 `treesit-thing-settings' for the shapes PRED can have. If the
3077 (treated as regexp matching the node's type, must be all single 3366 node satisfies PRED, leave CURSOR on that node and return true. If
3078 byte characters). If the node satisfies PRED, leave CURSOR on that 3367 no node satisfies PRED, move CURSOR back to starting position and
3079 node and return true. If no node satisfies PRED, move CURSOR back 3368 return false.
3080 to starting position and return false.
3081 3369
3082 LIMIT is the number of levels we descend in the tree. FORWARD 3370 LIMIT is the number of levels we descend in the tree. FORWARD
3083 controls the direction in which we traverse the tree, true means 3371 controls the direction in which we traverse the tree, true means
3084 forward, false backward. If SKIP_ROOT is true, don't match ROOT. 3372 forward, false backward. If SKIP_ROOT is true, don't match ROOT.
3085 */ 3373
3374 This function may signal if the predicate function signals. */
3375
3086static bool 3376static bool
3087treesit_search_dfs (TSTreeCursor *cursor, 3377treesit_search_dfs (TSTreeCursor *cursor,
3088 Lisp_Object pred, Lisp_Object parser, 3378 Lisp_Object pred, Lisp_Object parser,
@@ -3118,7 +3408,10 @@ treesit_search_dfs (TSTreeCursor *cursor,
3118 START. PRED, PARSER, NAMED, FORWARD are the same as in 3408 START. PRED, PARSER, NAMED, FORWARD are the same as in
3119 ts_search_subtree. If a match is found, leave CURSOR at that node, 3409 ts_search_subtree. If a match is found, leave CURSOR at that node,
3120 and return true, if no match is found, return false, and CURSOR's 3410 and return true, if no match is found, return false, and CURSOR's
3121 position is undefined. */ 3411 position is undefined.
3412
3413 This function may signal if the predicate function signals. */
3414
3122static bool 3415static bool
3123treesit_search_forward (TSTreeCursor *cursor, 3416treesit_search_forward (TSTreeCursor *cursor,
3124 Lisp_Object pred, Lisp_Object parser, 3417 Lisp_Object pred, Lisp_Object parser,
@@ -3128,8 +3421,7 @@ treesit_search_forward (TSTreeCursor *cursor,
3128 nodes. This way repeated call of this function traverses each 3421 nodes. This way repeated call of this function traverses each
3129 node in the tree once and only once: 3422 node in the tree once and only once:
3130 3423
3131 (while node (setq node (treesit-search-forward node))) 3424 (while node (setq node (treesit-search-forward node))) */
3132 */
3133 bool initial = true; 3425 bool initial = true;
3134 while (true) 3426 while (true)
3135 { 3427 {
@@ -3156,6 +3448,14 @@ treesit_search_forward (TSTreeCursor *cursor,
3156 } 3448 }
3157} 3449}
3158 3450
3451/* Clean up the given tree cursor CURSOR. */
3452
3453static void
3454treesit_traverse_cleanup_cursor (void *cursor)
3455{
3456 ts_tree_cursor_delete (cursor);
3457}
3458
3159DEFUN ("treesit-search-subtree", 3459DEFUN ("treesit-search-subtree",
3160 Ftreesit_search_subtree, 3460 Ftreesit_search_subtree,
3161 Streesit_search_subtree, 2, 5, 0, 3461 Streesit_search_subtree, 2, 5, 0,
@@ -3175,14 +3475,12 @@ Return the first matched node, or nil if none matches. */)
3175 Lisp_Object all, Lisp_Object depth) 3475 Lisp_Object all, Lisp_Object depth)
3176{ 3476{
3177 CHECK_TS_NODE (node); 3477 CHECK_TS_NODE (node);
3178 CHECK_TYPE (STRINGP (predicate) || FUNCTIONP (predicate),
3179 list3 (Qor, Qstringp, Qfunctionp), predicate);
3180 CHECK_SYMBOL (all); 3478 CHECK_SYMBOL (all);
3181 CHECK_SYMBOL (backward); 3479 CHECK_SYMBOL (backward);
3182 3480
3183 /* We use a default limit of 1000. See bug#59426 for the 3481 /* We use a default limit of 1000. See bug#59426 for the
3184 discussion. */ 3482 discussion. */
3185 ptrdiff_t the_limit = treesit_recursion_limit; 3483 ptrdiff_t the_limit = TREESIT_RECURSION_LIMIT;
3186 if (!NILP (depth)) 3484 if (!NILP (depth))
3187 { 3485 {
3188 CHECK_FIXNUM (depth); 3486 CHECK_FIXNUM (depth);
@@ -3192,19 +3490,29 @@ Return the first matched node, or nil if none matches. */)
3192 treesit_initialize (); 3490 treesit_initialize ();
3193 3491
3194 Lisp_Object parser = XTS_NODE (node)->parser; 3492 Lisp_Object parser = XTS_NODE (node)->parser;
3493 Lisp_Object language = XTS_PARSER (parser)->language_symbol;
3494
3495 Lisp_Object signal_data = Qnil;
3496 if (!treesit_traverse_validate_predicate (predicate, language,
3497 &signal_data, 0))
3498 xsignal1 (Qtreesit_invalid_predicate, signal_data);
3499
3195 Lisp_Object return_value = Qnil; 3500 Lisp_Object return_value = Qnil;
3196 TSTreeCursor cursor; 3501 TSTreeCursor cursor;
3197 if (!treesit_cursor_helper (&cursor, XTS_NODE (node)->node, parser)) 3502 if (!treesit_cursor_helper (&cursor, XTS_NODE (node)->node, parser))
3198 return return_value; 3503 return return_value;
3199 3504
3505 specpdl_ref count = SPECPDL_INDEX ();
3506 record_unwind_protect_ptr (treesit_traverse_cleanup_cursor, &cursor);
3507
3200 if (treesit_search_dfs (&cursor, predicate, parser, NILP (backward), 3508 if (treesit_search_dfs (&cursor, predicate, parser, NILP (backward),
3201 NILP (all), the_limit, false)) 3509 NILP (all), the_limit, false))
3202 { 3510 {
3203 TSNode node = ts_tree_cursor_current_node (&cursor); 3511 TSNode node = ts_tree_cursor_current_node (&cursor);
3204 return_value = make_treesit_node (parser, node); 3512 return_value = make_treesit_node (parser, node);
3205 } 3513 }
3206 ts_tree_cursor_delete (&cursor); 3514
3207 return return_value; 3515 return unbind_to (count, return_value);
3208} 3516}
3209 3517
3210DEFUN ("treesit-search-forward", 3518DEFUN ("treesit-search-forward",
@@ -3241,33 +3549,43 @@ always traverse leaf nodes first, then upwards. */)
3241 Lisp_Object all) 3549 Lisp_Object all)
3242{ 3550{
3243 CHECK_TS_NODE (start); 3551 CHECK_TS_NODE (start);
3244 CHECK_TYPE (STRINGP (predicate) || FUNCTIONP (predicate),
3245 list3 (Qor, Qstringp, Qfunctionp), predicate);
3246 CHECK_SYMBOL (all); 3552 CHECK_SYMBOL (all);
3247 CHECK_SYMBOL (backward); 3553 CHECK_SYMBOL (backward);
3248 3554
3249 treesit_initialize (); 3555 treesit_initialize ();
3250 3556
3251 Lisp_Object parser = XTS_NODE (start)->parser; 3557 Lisp_Object parser = XTS_NODE (start)->parser;
3558 Lisp_Object language = XTS_PARSER (parser)->language_symbol;
3559
3560 Lisp_Object signal_data = Qnil;
3561 if (!treesit_traverse_validate_predicate (predicate, language,
3562 &signal_data, 0))
3563 xsignal1 (Qtreesit_invalid_predicate, signal_data);
3564
3252 Lisp_Object return_value = Qnil; 3565 Lisp_Object return_value = Qnil;
3253 TSTreeCursor cursor; 3566 TSTreeCursor cursor;
3254 if (!treesit_cursor_helper (&cursor, XTS_NODE (start)->node, parser)) 3567 if (!treesit_cursor_helper (&cursor, XTS_NODE (start)->node, parser))
3255 return return_value; 3568 return return_value;
3256 3569
3570 specpdl_ref count = SPECPDL_INDEX ();
3571 record_unwind_protect_ptr (treesit_traverse_cleanup_cursor, &cursor);
3572
3257 if (treesit_search_forward (&cursor, predicate, parser, 3573 if (treesit_search_forward (&cursor, predicate, parser,
3258 NILP (backward), NILP (all))) 3574 NILP (backward), NILP (all)))
3259 { 3575 {
3260 TSNode node = ts_tree_cursor_current_node (&cursor); 3576 TSNode node = ts_tree_cursor_current_node (&cursor);
3261 return_value = make_treesit_node (parser, node); 3577 return_value = make_treesit_node (parser, node);
3262 } 3578 }
3263 ts_tree_cursor_delete (&cursor); 3579
3264 return return_value; 3580 return unbind_to (count, return_value);
3265} 3581}
3266 3582
3267/* Recursively traverse the tree under CURSOR, and append the result 3583/* Recursively traverse the tree under CURSOR, and append the result
3268 subtree to PARENT's cdr. See more in Ftreesit_induce_sparse_tree. 3584 subtree to PARENT's cdr. See more in Ftreesit_induce_sparse_tree.
3269 Note that the top-level children list is reversed, because 3585 Note that the top-level children list is reversed, because
3270 reasons. */ 3586 reasons.
3587
3588 This function may signal if the predicate function signals. */
3271static void 3589static void
3272treesit_build_sparse_tree (TSTreeCursor *cursor, Lisp_Object parent, 3590treesit_build_sparse_tree (TSTreeCursor *cursor, Lisp_Object parent,
3273 Lisp_Object pred, Lisp_Object process_fn, 3591 Lisp_Object pred, Lisp_Object process_fn,
@@ -3353,15 +3671,13 @@ a regexp. */)
3353 Lisp_Object depth) 3671 Lisp_Object depth)
3354{ 3672{
3355 CHECK_TS_NODE (root); 3673 CHECK_TS_NODE (root);
3356 CHECK_TYPE (STRINGP (predicate) || FUNCTIONP (predicate),
3357 list3 (Qor, Qstringp, Qfunctionp), predicate);
3358 3674
3359 if (!NILP (process_fn)) 3675 if (!NILP (process_fn))
3360 CHECK_TYPE (FUNCTIONP (process_fn), Qfunctionp, process_fn); 3676 CHECK_TYPE (FUNCTIONP (process_fn), Qfunctionp, process_fn);
3361 3677
3362 /* We use a default limit of 1000. See bug#59426 for the 3678 /* We use a default limit of 1000. See bug#59426 for the
3363 discussion. */ 3679 discussion. */
3364 ptrdiff_t the_limit = treesit_recursion_limit; 3680 ptrdiff_t the_limit = TREESIT_RECURSION_LIMIT;
3365 if (!NILP (depth)) 3681 if (!NILP (depth))
3366 { 3682 {
3367 CHECK_FIXNUM (depth); 3683 CHECK_FIXNUM (depth);
@@ -3371,21 +3687,68 @@ a regexp. */)
3371 treesit_initialize (); 3687 treesit_initialize ();
3372 3688
3373 Lisp_Object parser = XTS_NODE (root)->parser; 3689 Lisp_Object parser = XTS_NODE (root)->parser;
3690 Lisp_Object language = XTS_PARSER (parser)->language_symbol;
3691
3692 Lisp_Object signal_data = Qnil;
3693 if (!treesit_traverse_validate_predicate (predicate, language,
3694 &signal_data, 0))
3695 xsignal1 (Qtreesit_invalid_predicate, signal_data);
3696
3374 Lisp_Object parent = Fcons (Qnil, Qnil); 3697 Lisp_Object parent = Fcons (Qnil, Qnil);
3375 /* In this function we never traverse above NODE, so we don't need 3698 /* In this function we never traverse above NODE, so we don't need
3376 to use treesit_cursor_helper. */ 3699 to use treesit_cursor_helper. */
3377 TSTreeCursor cursor = ts_tree_cursor_new (XTS_NODE (root)->node); 3700 TSTreeCursor cursor = ts_tree_cursor_new (XTS_NODE (root)->node);
3378 3701
3702 specpdl_ref count = SPECPDL_INDEX ();
3703 record_unwind_protect_ptr (treesit_traverse_cleanup_cursor, &cursor);
3704
3379 treesit_build_sparse_tree (&cursor, parent, predicate, process_fn, 3705 treesit_build_sparse_tree (&cursor, parent, predicate, process_fn,
3380 the_limit, parser); 3706 the_limit, parser);
3381 ts_tree_cursor_delete (&cursor); 3707
3708 unbind_to (count, Qnil);
3709
3382 Fsetcdr (parent, Fnreverse (Fcdr (parent))); 3710 Fsetcdr (parent, Fnreverse (Fcdr (parent)));
3711
3383 if (NILP (Fcdr (parent))) 3712 if (NILP (Fcdr (parent)))
3384 return Qnil; 3713 return Qnil;
3385 else 3714 else
3386 return parent; 3715 return parent;
3387} 3716}
3388 3717
3718DEFUN ("treesit-node-match-p",
3719 Ftreesit_node_match_p,
3720 Streesit_node_match_p, 2, 2, 0,
3721 doc: /* Check whether NODE matches PREDICATE.
3722
3723PREDICATE can be a regexp matching node type, a predicate function,
3724and more, see `treesit-thing-settings' for detail. Return non-nil
3725if NODE matches PRED, nil otherwise. */)
3726 (Lisp_Object node, Lisp_Object predicate)
3727{
3728 CHECK_TS_NODE (node);
3729
3730 Lisp_Object parser = XTS_NODE (node)->parser;
3731 Lisp_Object language = XTS_PARSER (parser)->language_symbol;
3732
3733 Lisp_Object signal_data = Qnil;
3734 if (!treesit_traverse_validate_predicate (predicate, language,
3735 &signal_data, 0))
3736 xsignal1 (Qtreesit_invalid_predicate, signal_data);
3737
3738 TSTreeCursor cursor = ts_tree_cursor_new (XTS_NODE (node)->node);
3739
3740 specpdl_ref count = SPECPDL_INDEX ();
3741 record_unwind_protect_ptr (treesit_traverse_cleanup_cursor, &cursor);
3742
3743 bool match = false;
3744 match = treesit_traverse_match_predicate (&cursor, predicate,
3745 parser, false);
3746
3747 unbind_to (count, Qnil);
3748
3749 return match ? Qt : Qnil;
3750}
3751
3389DEFUN ("treesit-subtree-stat", 3752DEFUN ("treesit-subtree-stat",
3390 Ftreesit_subtree_stat, 3753 Ftreesit_subtree_stat,
3391 Streesit_subtree_stat, 1, 1, 0, 3754 Streesit_subtree_stat, 1, 1, 0,
@@ -3480,8 +3843,12 @@ syms_of_treesit (void)
3480 DEFSYM (Qoutdated, "outdated"); 3843 DEFSYM (Qoutdated, "outdated");
3481 DEFSYM (Qhas_error, "has-error"); 3844 DEFSYM (Qhas_error, "has-error");
3482 DEFSYM (Qlive, "live"); 3845 DEFSYM (Qlive, "live");
3846 DEFSYM (Qnot, "not");
3483 3847
3484 DEFSYM (QCanchor, ":anchor"); 3848 DEFSYM (QCanchor, ":anchor");
3849 DEFSYM (QCquestion, ":?");
3850 DEFSYM (QCstar, ":*");
3851 DEFSYM (QCplus, ":+");
3485 DEFSYM (QCequal, ":equal"); 3852 DEFSYM (QCequal, ":equal");
3486 DEFSYM (QCmatch, ":match"); 3853 DEFSYM (QCmatch, ":match");
3487 DEFSYM (QCpred, ":pred"); 3854 DEFSYM (QCpred, ":pred");
@@ -3504,6 +3871,7 @@ syms_of_treesit (void)
3504 "user-emacs-directory"); 3871 "user-emacs-directory");
3505 DEFSYM (Qtreesit_parser_deleted, "treesit-parser-deleted"); 3872 DEFSYM (Qtreesit_parser_deleted, "treesit-parser-deleted");
3506 DEFSYM (Qtreesit_pattern_expand, "treesit-pattern-expand"); 3873 DEFSYM (Qtreesit_pattern_expand, "treesit-pattern-expand");
3874 DEFSYM (Qtreesit_invalid_predicate, "treesit-invalid-predicate");
3507 3875
3508 DEFSYM (Qor, "or"); 3876 DEFSYM (Qor, "or");
3509 3877
@@ -3518,9 +3886,9 @@ syms_of_treesit (void)
3518 define_error (Qtreesit_parse_error, "Parse failed", 3886 define_error (Qtreesit_parse_error, "Parse failed",
3519 Qtreesit_error); 3887 Qtreesit_error);
3520 define_error (Qtreesit_range_invalid, 3888 define_error (Qtreesit_range_invalid,
3521 "RANGES are invalid, they have to be ordered and not overlapping", 3889 "RANGES are invalid: they have to be ordered and should not overlap",
3522 Qtreesit_error); 3890 Qtreesit_error);
3523 define_error (Qtreesit_buffer_too_large, "Buffer too large (> 4GB)", 3891 define_error (Qtreesit_buffer_too_large, "Buffer too large (> 4GiB)",
3524 Qtreesit_error); 3892 Qtreesit_error);
3525 define_error (Qtreesit_load_language_error, 3893 define_error (Qtreesit_load_language_error,
3526 "Cannot load language definition", 3894 "Cannot load language definition",
@@ -3531,6 +3899,10 @@ syms_of_treesit (void)
3531 define_error (Qtreesit_parser_deleted, 3899 define_error (Qtreesit_parser_deleted,
3532 "This parser is deleted and cannot be used", 3900 "This parser is deleted and cannot be used",
3533 Qtreesit_error); 3901 Qtreesit_error);
3902 define_error (Qtreesit_invalid_predicate,
3903 "Invalid predicate, see `treesit-thing-settings' "
3904 "for valid forms for a predicate",
3905 Qtreesit_error);
3534 3906
3535 DEFVAR_LISP ("treesit-load-name-override-list", 3907 DEFVAR_LISP ("treesit-load-name-override-list",
3536 Vtreesit_load_name_override_list, 3908 Vtreesit_load_name_override_list,
@@ -3561,10 +3933,41 @@ then in the `tree-sitter' subdirectory of `user-emacs-directory', and
3561then in the system default locations for dynamic libraries, in that order. */); 3933then in the system default locations for dynamic libraries, in that order. */);
3562 Vtreesit_extra_load_path = Qnil; 3934 Vtreesit_extra_load_path = Qnil;
3563 3935
3936 DEFVAR_LISP ("treesit-thing-settings",
3937 Vtreesit_thing_settings,
3938 doc:
3939 /* A list defining things.
3940
3941The value should be an alist of (LANGUAGE . DEFINITIONS), where
3942LANGUAGE is a language symbol, and DEFINITIONS is a list of
3943
3944 (THING PRED)
3945
3946THING is a symbol representing the thing, like `defun', `sexp', or
3947`block'; PRED defines what kind of node can be qualified as THING.
3948
3949PRED can be a regexp string that matches the type of the node; it can
3950be a predicate function that takes the node as the sole argument and
3951returns t if the node is the thing; it can be a cons (REGEXP . FN),
3952which is a combination of a regexp and a predicate function, and the
3953node has to match both to qualify as the thing.
3954
3955PRED can also be recursively defined. It can be (or PRED...), meaning
3956satisfying anyone of the inner PREDs qualifies the node; or (not
3957PRED), meaning not satisfying the inner PRED qualifies the node.
3958
3959Finally, PRED can refer to other THINGs defined in this list by using
3960the symbol of that THING. For example, (or block sexp). */);
3961 Vtreesit_thing_settings = Qnil;
3962
3564 staticpro (&Vtreesit_str_libtree_sitter); 3963 staticpro (&Vtreesit_str_libtree_sitter);
3565 Vtreesit_str_libtree_sitter = build_pure_c_string ("libtree-sitter-"); 3964 Vtreesit_str_libtree_sitter = build_pure_c_string ("libtree-sitter-");
3566 staticpro (&Vtreesit_str_tree_sitter); 3965 staticpro (&Vtreesit_str_tree_sitter);
3567 Vtreesit_str_tree_sitter = build_pure_c_string ("tree-sitter-"); 3966 Vtreesit_str_tree_sitter = build_pure_c_string ("tree-sitter-");
3967#ifndef WINDOWSNT
3968 staticpro (&Vtreesit_str_dot_0);
3969 Vtreesit_str_dot_0 = build_pure_c_string (".0");
3970#endif
3568 staticpro (&Vtreesit_str_dot); 3971 staticpro (&Vtreesit_str_dot);
3569 Vtreesit_str_dot = build_pure_c_string ("."); 3972 Vtreesit_str_dot = build_pure_c_string (".");
3570 staticpro (&Vtreesit_str_question_mark); 3973 staticpro (&Vtreesit_str_question_mark);
@@ -3648,6 +4051,7 @@ then in the system default locations for dynamic libraries, in that order. */);
3648 defsubr (&Streesit_search_subtree); 4051 defsubr (&Streesit_search_subtree);
3649 defsubr (&Streesit_search_forward); 4052 defsubr (&Streesit_search_forward);
3650 defsubr (&Streesit_induce_sparse_tree); 4053 defsubr (&Streesit_induce_sparse_tree);
4054 defsubr (&Streesit_node_match_p);
3651 defsubr (&Streesit_subtree_stat); 4055 defsubr (&Streesit_subtree_stat);
3652#endif /* HAVE_TREE_SITTER */ 4056#endif /* HAVE_TREE_SITTER */
3653 defsubr (&Streesit_available_p); 4057 defsubr (&Streesit_available_p);
diff --git a/src/w32.c b/src/w32.c
index 8d344d2e6da..a6bc0f4b2ee 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -543,7 +543,14 @@ typedef LANGID (WINAPI *GetUserDefaultUILanguage_Proc) (void);
543 543
544typedef COORD (WINAPI *GetConsoleFontSize_Proc) (HANDLE, DWORD); 544typedef COORD (WINAPI *GetConsoleFontSize_Proc) (HANDLE, DWORD);
545 545
546#if _WIN32_WINNT < 0x0501 546/* Old versions of mingw.org's MinGW, before v5.2.0, don't have a
547 _WIN32_WINNT guard for CONSOLE_FONT_INFO in wincon.h, and so don't
548 need the conditional definition below, which causes compilation
549 errors. Note: MinGW64 sets _WIN32_WINNT to a higher version, and
550 its w32api.h version stays fixed at 3.14. */
551#if _WIN32_WINNT < 0x0501 \
552 && (__W32API_MAJOR_VERSION > 5 \
553 || (__W32API_MAJOR_VERSION == 5 && __W32API_MINOR_VERSION >= 2))
547typedef struct 554typedef struct
548{ 555{
549 DWORD nFont; 556 DWORD nFont;
diff --git a/src/w32term.c b/src/w32term.c
index 2899e82b295..57dc6b465e4 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -7378,7 +7378,7 @@ w32_initialize_display_info (Lisp_Object display_name)
7378 { 7378 {
7379 static char const at[] = " at "; 7379 static char const at[] = " at ";
7380 ptrdiff_t nbytes = sizeof (title) + sizeof (at); 7380 ptrdiff_t nbytes = sizeof (title) + sizeof (at);
7381 if (INT_ADD_WRAPV (nbytes, SCHARS (Vsystem_name), &nbytes)) 7381 if (ckd_add (&nbytes, nbytes, SCHARS (Vsystem_name)))
7382 memory_full (SIZE_MAX); 7382 memory_full (SIZE_MAX);
7383 dpyinfo->w32_id_name = xmalloc (nbytes); 7383 dpyinfo->w32_id_name = xmalloc (nbytes);
7384 sprintf (dpyinfo->w32_id_name, "%s%s%s", title, at, SDATA (Vsystem_name)); 7384 sprintf (dpyinfo->w32_id_name, "%s%s%s", title, at, SDATA (Vsystem_name));
diff --git a/src/window.h b/src/window.h
index 32b5fe14f4f..2f793ebe438 100644
--- a/src/window.h
+++ b/src/window.h
@@ -750,7 +750,7 @@ wset_next_buffers (struct window *w, Lisp_Object val)
750#endif 750#endif
751 751
752/* True if W is a tab bar window. */ 752/* True if W is a tab bar window. */
753#if defined (HAVE_WINDOW_SYSTEM) && !defined (HAVE_PGTK) 753#if defined (HAVE_WINDOW_SYSTEM)
754# define WINDOW_TAB_BAR_P(W) \ 754# define WINDOW_TAB_BAR_P(W) \
755 (WINDOWP (WINDOW_XFRAME (W)->tab_bar_window) \ 755 (WINDOWP (WINDOW_XFRAME (W)->tab_bar_window) \
756 && (W) == XWINDOW (WINDOW_XFRAME (W)->tab_bar_window)) 756 && (W) == XWINDOW (WINDOW_XFRAME (W)->tab_bar_window))
diff --git a/src/xdisp.c b/src/xdisp.c
index 0ebbe81f7d3..d21ee213bee 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -602,8 +602,8 @@ fill_column_indicator_column (struct it *it, int char_width)
602 if (RANGED_FIXNUMP (0, col, INT_MAX)) 602 if (RANGED_FIXNUMP (0, col, INT_MAX))
603 { 603 {
604 int icol = XFIXNUM (col); 604 int icol = XFIXNUM (col);
605 if (!INT_MULTIPLY_WRAPV (char_width, icol, &icol) 605 if (!ckd_mul (&icol, icol, char_width)
606 && !INT_ADD_WRAPV (it->lnum_pixel_width, icol, &icol)) 606 && !ckd_add (&icol, icol, it->lnum_pixel_width))
607 return icol; 607 return icol;
608 } 608 }
609 } 609 }
@@ -3482,7 +3482,7 @@ init_iterator (struct it *it, struct window *w,
3482 3482
3483 /* This is set only when long_line_optimizations_p is non-zero 3483 /* This is set only when long_line_optimizations_p is non-zero
3484 for the current buffer. */ 3484 for the current buffer. */
3485 it->narrowed_begv = 0; 3485 it->medium_narrowing_begv = 0;
3486 3486
3487 /* Compute faces etc. */ 3487 /* Compute faces etc. */
3488 reseat (it, it->current.pos, true); 3488 reseat (it, it->current.pos, true);
@@ -3491,17 +3491,104 @@ init_iterator (struct it *it, struct window *w,
3491 CHECK_IT (it); 3491 CHECK_IT (it);
3492} 3492}
3493 3493
3494/* Compute a suitable alternate value for BEGV and ZV that may be used 3494/* How Emacs deals with long lines.
3495 temporarily to optimize display if the buffer in window W contains 3495
3496 long lines. */ 3496 (1) When a buffer is about to be (re)displayed, 'redisplay_window'
3497 detects, with a heuristic, whether it contains long lines.
3498
3499 This happens in 'redisplay_window' because it is only displaying
3500 buffers with long lines that is problematic. In other words, none
3501 of the optimizations described below is ever used in buffers that
3502 are never displayed.
3503
3504 This happens with a heuristic, which checks whether a buffer
3505 contains long lines, each time its contents have changed "enough"
3506 between two redisplay cycles, because a buffer without long lines
3507 can become a buffer with long lines at any time, for example after
3508 a yank command, or after a replace command, or while the output of
3509 an external process is inserted in a buffer.
3510
3511 When Emacs has detected that a buffer contains long lines, the
3512 buffer-local variable 'long_line_optimizations_p' (in 'struct
3513 buffer') is set, and Emacs does not try to detect whether the
3514 buffer does or does not contain long lines anymore.
3515
3516 What a long line is depends on the variable 'long-line-threshold',
3517 whose default value is 50000 (characters).
3518
3519 (2) When a buffer with long lines is (re)displayed, the amount of
3520 data that the display routines consider is, in a few well-chosen
3521 places, limited with a temporary restriction, whose bounds are
3522 calculated with the functions below.
3523
3524 (2.1) 'get_small_narrowing_begv' is used to create a restriction
3525 which starts a few hundred characters before point. The exact
3526 number of characters depends on the width of the window in which
3527 the buffer is displayed.
3528
3529 There is no corresponding 'get_small_narrowing_zv' function,
3530 because it is not necessary to set the end limit of that
3531 restriction.
3532
3533 This restriction is used in four places, namely:
3534 'back_to_previous_line_start' and 'move_it_vertically_backward'
3535 (with the 'SET_WITH_NARROWED_BEGV' macro), and in
3536 'composition_compute_stop_pos' and 'find_automatic_composition' (in
3537 a conditional statement depending on 'long_line_optimizations_p').
3538
3539 (2.2) 'get_medium_narrowing_begv' is used to create a restriction
3540 which starts a few thousand characters before point. The exact
3541 number of characters depends on the size (width and height) of the
3542 window in which the buffer is displayed. For performance reasons,
3543 the return value of that function is cached in 'struct it', in the
3544 'medium_narrowing_begv' field.
3545
3546 The corresponding function 'get_medium_narrowing_zv' (and
3547 'medium_narrowing_zv' field in 'struct it') is not used to set the
3548 end limit of the restriction, which is again unnecessary, but to
3549 determine, in 'reseat', whether the iterator has moved far enough
3550 from its original position, and whether the start position of the
3551 restriction must be computed anew.
3552
3553 This restriction is used in a single place:
3554 'get_visually_first_element', with the 'SET_WITH_NARROWED_BEGV'
3555 macro.
3556
3557 (2.3) 'get_large_narrowing_begv' and 'get_large_narrowing_zv' are
3558 used to create a restriction which starts a few hundred thousand
3559 characters before point and ends a few hundred thousand characters
3560 after point. The size of that restriction depends on the variable
3561 'long-line-optimizations-region-size', whose default value is
3562 500000 (characters); it can be adjusted by a few hundred characters
3563 depending on 'long-line-optimizations-bol-search-limit', whose
3564 default value is 128 (characters).
3565
3566 For performance reasons again, the return values of these functions
3567 are stored in the 'large_narrowing_begv' and 'large_narrowing_zv'
3568 fields in 'struct it'.
3569
3570 The restriction defined by these values is used around three
3571 low-level hooks: around 'fontification-functions', in
3572 'handle_fontified_prop', and around 'pre-command-hook' and
3573 'post-command-hook', in 'safe_run_hooks_maybe_narrowed', which is
3574 called in 'command_loop_1'. These restrictions are set around
3575 these hooks with 'labeled_narrow_to_region'; the restrictions are
3576 labeled, and cannot be removed with a call to 'widen', but can be
3577 removed with 'without-restriction' with a :label argument.
3578*/
3497 3579
3498static int 3580static int
3499get_narrowed_width (struct window *w) 3581get_narrowed_width (struct window *w)
3500{ 3582{
3501 /* In a character-only terminal, only one font size is used, so we 3583 /* In a character-only terminal, only one font size is used, so we
3502 can use a smaller factor. */ 3584 can use a smaller factor. */
3503 int fact = EQ (Fterminal_live_p (Qnil), Qt) ? 2 : 3; 3585 int fact = FRAME_WINDOW_P (XFRAME (w->frame)) ? 3 : 2;
3504 int width = window_body_width (w, WINDOW_BODY_IN_CANONICAL_CHARS); 3586 /* If the window has no fringes (in a character-only terminal or in
3587 a GUI frame without fringes), subtract 1 from the width for the
3588 '\' line wrapping character. */
3589 int width = window_body_width (w, WINDOW_BODY_IN_CANONICAL_CHARS)
3590 - ((WINDOW_RIGHT_FRINGE_WIDTH (w) == 0
3591 || WINDOW_LEFT_FRINGE_WIDTH (w) == 0) ? 1 : 0);
3505 return fact * max (1, width); 3592 return fact * max (1, width);
3506} 3593}
3507 3594
@@ -3512,29 +3599,63 @@ get_narrowed_len (struct window *w)
3512 return get_narrowed_width (w) * max (1, height); 3599 return get_narrowed_width (w) * max (1, height);
3513} 3600}
3514 3601
3515ptrdiff_t 3602static ptrdiff_t
3516get_narrowed_begv (struct window *w, ptrdiff_t pos) 3603get_medium_narrowing_begv (struct window *w, ptrdiff_t pos)
3517{ 3604{
3518 int len = get_narrowed_len (w); 3605 int len = get_narrowed_len (w);
3519 return max ((pos / len - 1) * len, BEGV); 3606 return max ((pos / len - 1) * len, BEGV);
3520} 3607}
3521 3608
3522ptrdiff_t 3609static ptrdiff_t
3523get_narrowed_zv (struct window *w, ptrdiff_t pos) 3610get_medium_narrowing_zv (struct window *w, ptrdiff_t pos)
3524{ 3611{
3525 int len = get_narrowed_len (w); 3612 int len = get_narrowed_len (w);
3526 return min ((pos / len + 1) * len, ZV); 3613 return min ((pos / len + 1) * len, ZV);
3527} 3614}
3528 3615
3616/* Find the position of the last BOL before POS, unless it is too far
3617 away. The buffer portion in which the search occurs is gradually
3618 enlarged: [POS-500..POS], [POS-5500..POS-500],
3619 [POS-55500..POS-5500], and finally [POS-555500..POS-55500]. Return
3620 BEGV-1 if no BOL was found in [POS-555500..POS]. */
3621static ptrdiff_t
3622get_nearby_bol_pos (ptrdiff_t pos)
3623{
3624 ptrdiff_t start, pos_bytepos, cur, next, found, bol = BEGV - 1, init_pos = pos;
3625 int dist;
3626 for (dist = 500; dist <= 500000; dist *= 10)
3627 {
3628 pos_bytepos = pos == BEGV ? BEGV_BYTE : CHAR_TO_BYTE (pos);
3629 start = pos - dist < BEGV ? BEGV : pos - dist;
3630 for (cur = start; cur < pos; cur = next)
3631 {
3632 next = find_newline1 (cur, CHAR_TO_BYTE (cur),
3633 pos, pos_bytepos,
3634 1, &found, NULL, false);
3635 if (found)
3636 bol = next;
3637 else
3638 break;
3639 }
3640 if (bol >= BEGV || start == BEGV)
3641 break;
3642 else
3643 pos = pos - dist < BEGV ? BEGV : pos - dist;
3644 }
3645 eassert (bol <= init_pos);
3646 return bol;
3647}
3648
3529ptrdiff_t 3649ptrdiff_t
3530get_closer_narrowed_begv (struct window *w, ptrdiff_t pos) 3650get_small_narrowing_begv (struct window *w, ptrdiff_t pos)
3531{ 3651{
3532 int len = get_narrowed_width (w); 3652 int len = get_narrowed_width (w);
3533 return max ((pos / len - 1) * len, BEGV); 3653 ptrdiff_t bol_pos = max (get_nearby_bol_pos (pos), BEGV);
3654 return max (bol_pos + ((pos - bol_pos) / len - 1) * len, BEGV);
3534} 3655}
3535 3656
3536ptrdiff_t 3657ptrdiff_t
3537get_locked_narrowing_begv (ptrdiff_t pos) 3658get_large_narrowing_begv (ptrdiff_t pos)
3538{ 3659{
3539 if (long_line_optimizations_region_size <= 0) 3660 if (long_line_optimizations_region_size <= 0)
3540 return BEGV; 3661 return BEGV;
@@ -3552,7 +3673,7 @@ get_locked_narrowing_begv (ptrdiff_t pos)
3552} 3673}
3553 3674
3554ptrdiff_t 3675ptrdiff_t
3555get_locked_narrowing_zv (ptrdiff_t pos) 3676get_large_narrowing_zv (ptrdiff_t pos)
3556{ 3677{
3557 if (long_line_optimizations_region_size <= 0) 3678 if (long_line_optimizations_region_size <= 0)
3558 return ZV; 3679 return ZV;
@@ -3571,7 +3692,7 @@ unwind_narrowed_begv (Lisp_Object point_min)
3571 3692
3572#define SET_WITH_NARROWED_BEGV(IT,DST,EXPR,BV) \ 3693#define SET_WITH_NARROWED_BEGV(IT,DST,EXPR,BV) \
3573 do { \ 3694 do { \
3574 if (IT->narrowed_begv) \ 3695 if (IT->medium_narrowing_begv) \
3575 { \ 3696 { \
3576 specpdl_ref count = SPECPDL_INDEX (); \ 3697 specpdl_ref count = SPECPDL_INDEX (); \
3577 record_unwind_protect (unwind_narrowed_begv, Fpoint_min ()); \ 3698 record_unwind_protect (unwind_narrowed_begv, Fpoint_min ()); \
@@ -4056,7 +4177,7 @@ compute_stop_pos (struct it *it)
4056{ 4177{
4057 register INTERVAL iv, next_iv; 4178 register INTERVAL iv, next_iv;
4058 Lisp_Object object, limit, position; 4179 Lisp_Object object, limit, position;
4059 ptrdiff_t charpos, bytepos; 4180 ptrdiff_t charpos, bytepos, cmp_limit_pos = -1;
4060 4181
4061 if (STRINGP (it->string)) 4182 if (STRINGP (it->string))
4062 { 4183 {
@@ -4126,7 +4247,10 @@ compute_stop_pos (struct it *it)
4126 } 4247 }
4127 } 4248 }
4128 if (found) 4249 if (found)
4129 pos--; 4250 {
4251 pos--;
4252 cmp_limit_pos = pos;
4253 }
4130 else if (it->stop_charpos < endpos) 4254 else if (it->stop_charpos < endpos)
4131 pos = it->stop_charpos; 4255 pos = it->stop_charpos;
4132 else 4256 else
@@ -4184,14 +4308,25 @@ compute_stop_pos (struct it *it)
4184 } 4308 }
4185 } 4309 }
4186 4310
4187 if (it->cmp_it.id < 0) 4311 if (it->cmp_it.id < 0
4312 && (STRINGP (it->string)
4313 || ((!it->bidi_p || it->bidi_it.scan_dir >= 0)
4314 && it->cmp_it.stop_pos <= IT_CHARPOS (*it))))
4188 { 4315 {
4189 ptrdiff_t stoppos = it->end_charpos; 4316 ptrdiff_t stoppos = it->end_charpos;
4190 4317
4318 /* If we found, above, a buffer position that cannot be part of
4319 an automatic composition, limit the search of composable
4320 characters to that position. */
4191 if (it->bidi_p && it->bidi_it.scan_dir < 0) 4321 if (it->bidi_p && it->bidi_it.scan_dir < 0)
4192 stoppos = -1; 4322 stoppos = -1;
4323 else if (cmp_limit_pos > 0)
4324 stoppos = cmp_limit_pos;
4325 /* Force composition_compute_stop_pos avoid the costly search
4326 for static compositions, since those were already found by
4327 looking at text properties, above. */
4193 composition_compute_stop_pos (&it->cmp_it, charpos, bytepos, 4328 composition_compute_stop_pos (&it->cmp_it, charpos, bytepos,
4194 stoppos, it->string); 4329 stoppos, it->string, false);
4195 } 4330 }
4196 4331
4197 eassert (STRINGP (it->string) 4332 eassert (STRINGP (it->string)
@@ -4396,17 +4531,17 @@ handle_fontified_prop (struct it *it)
4396 if (current_buffer->long_line_optimizations_p 4531 if (current_buffer->long_line_optimizations_p
4397 && long_line_optimizations_region_size > 0) 4532 && long_line_optimizations_region_size > 0)
4398 { 4533 {
4399 ptrdiff_t begv = it->locked_narrowing_begv; 4534 ptrdiff_t begv = it->large_narrowing_begv;
4400 ptrdiff_t zv = it->locked_narrowing_zv; 4535 ptrdiff_t zv = it->large_narrowing_zv;
4401 ptrdiff_t charpos = IT_CHARPOS (*it); 4536 ptrdiff_t charpos = IT_CHARPOS (*it);
4402 if (charpos < begv || charpos > zv) 4537 if (charpos < begv || charpos > zv)
4403 { 4538 {
4404 begv = get_locked_narrowing_begv (charpos); 4539 begv = get_large_narrowing_begv (charpos);
4405 zv = get_locked_narrowing_zv (charpos); 4540 zv = get_large_narrowing_zv (charpos);
4406 } 4541 }
4407 if (begv != BEG || zv != Z) 4542 if (begv != BEG || zv != Z)
4408 narrow_to_region_locked (make_fixnum (begv), make_fixnum (zv), 4543 labeled_narrow_to_region (make_fixnum (begv), make_fixnum (zv),
4409 Qlong_line_optimizations_in_fontification_functions); 4544 Qlong_line_optimizations_in_fontification_functions);
4410 } 4545 }
4411 4546
4412 /* Don't allow Lisp that runs from 'fontification-functions' 4547 /* Don't allow Lisp that runs from 'fontification-functions'
@@ -7041,7 +7176,7 @@ back_to_previous_line_start (struct it *it)
7041 dec_both (&cp, &bp); 7176 dec_both (&cp, &bp);
7042 SET_WITH_NARROWED_BEGV (it, IT_CHARPOS (*it), 7177 SET_WITH_NARROWED_BEGV (it, IT_CHARPOS (*it),
7043 find_newline_no_quit (cp, bp, -1, &IT_BYTEPOS (*it)), 7178 find_newline_no_quit (cp, bp, -1, &IT_BYTEPOS (*it)),
7044 get_closer_narrowed_begv (it->w, IT_CHARPOS (*it))); 7179 get_small_narrowing_begv (it->w, IT_CHARPOS (*it)));
7045} 7180}
7046 7181
7047/* Find in the current buffer the first display or overlay string 7182/* Find in the current buffer the first display or overlay string
@@ -7345,7 +7480,7 @@ back_to_previous_visible_line_start (struct it *it)
7345 it->continuation_lines_width = 0; 7480 it->continuation_lines_width = 0;
7346 7481
7347 eassert (IT_CHARPOS (*it) >= BEGV); 7482 eassert (IT_CHARPOS (*it) >= BEGV);
7348 eassert (it->narrowed_begv > 0 /* long-line optimizations: all bets off */ 7483 eassert (it->medium_narrowing_begv > 0 /* long-line optimizations: all bets off */
7349 || IT_CHARPOS (*it) == BEGV 7484 || IT_CHARPOS (*it) == BEGV
7350 || FETCH_BYTE (IT_BYTEPOS (*it) - 1) == '\n'); 7485 || FETCH_BYTE (IT_BYTEPOS (*it) - 1) == '\n');
7351 CHECK_IT (it); 7486 CHECK_IT (it);
@@ -7463,24 +7598,29 @@ reseat (struct it *it, struct text_pos pos, bool force_p)
7463 7598
7464 if (current_buffer->long_line_optimizations_p) 7599 if (current_buffer->long_line_optimizations_p)
7465 { 7600 {
7466 if (!it->narrowed_begv) 7601 if (!it->medium_narrowing_begv)
7467 { 7602 {
7468 it->narrowed_begv = get_narrowed_begv (it->w, window_point (it->w)); 7603 it->medium_narrowing_begv
7469 it->narrowed_zv = get_narrowed_zv (it->w, window_point (it->w)); 7604 = get_medium_narrowing_begv (it->w, window_point (it->w));
7470 it->locked_narrowing_begv 7605 it->medium_narrowing_zv
7471 = get_locked_narrowing_begv (window_point (it->w)); 7606 = get_medium_narrowing_zv (it->w, window_point (it->w));
7472 it->locked_narrowing_zv 7607 it->large_narrowing_begv
7473 = get_locked_narrowing_zv (window_point (it->w)); 7608 = get_large_narrowing_begv (window_point (it->w));
7609 it->large_narrowing_zv
7610 = get_large_narrowing_zv (window_point (it->w));
7474 } 7611 }
7475 else if ((pos.charpos < it->narrowed_begv || pos.charpos > it->narrowed_zv) 7612 else if ((pos.charpos < it->medium_narrowing_begv
7613 || pos.charpos > it->medium_narrowing_zv)
7476 && (!redisplaying_p || it->line_wrap == TRUNCATE)) 7614 && (!redisplaying_p || it->line_wrap == TRUNCATE))
7477 { 7615 {
7478 it->narrowed_begv = get_narrowed_begv (it->w, pos.charpos); 7616 it->medium_narrowing_begv
7479 it->narrowed_zv = get_narrowed_zv (it->w, pos.charpos); 7617 = get_medium_narrowing_begv (it->w, pos.charpos);
7480 it->locked_narrowing_begv 7618 it->medium_narrowing_zv
7481 = get_locked_narrowing_begv (window_point (it->w)); 7619 = get_medium_narrowing_zv (it->w, pos.charpos);
7482 it->locked_narrowing_zv 7620 it->large_narrowing_begv
7483 = get_locked_narrowing_zv (window_point (it->w)); 7621 = get_large_narrowing_begv (window_point (it->w));
7622 it->large_narrowing_zv
7623 = get_large_narrowing_zv (window_point (it->w));
7484 } 7624 }
7485 } 7625 }
7486 7626
@@ -7716,7 +7856,7 @@ reseat_to_string (struct it *it, const char *s, Lisp_Object string,
7716 if (endpos > it->end_charpos) 7856 if (endpos > it->end_charpos)
7717 endpos = it->end_charpos; 7857 endpos = it->end_charpos;
7718 composition_compute_stop_pos (&it->cmp_it, charpos, -1, endpos, 7858 composition_compute_stop_pos (&it->cmp_it, charpos, -1, endpos,
7719 it->string); 7859 it->string, true);
7720 } 7860 }
7721 CHECK_IT (it); 7861 CHECK_IT (it);
7722} 7862}
@@ -8404,7 +8544,7 @@ set_iterator_to_next (struct it *it, bool reseat_p)
8404 where to stop. */ 8544 where to stop. */
8405 stop = -1; 8545 stop = -1;
8406 composition_compute_stop_pos (&it->cmp_it, IT_CHARPOS (*it), 8546 composition_compute_stop_pos (&it->cmp_it, IT_CHARPOS (*it),
8407 IT_BYTEPOS (*it), stop, Qnil); 8547 IT_BYTEPOS (*it), stop, Qnil, true);
8408 } 8548 }
8409 } 8549 }
8410 else 8550 else
@@ -8435,7 +8575,8 @@ set_iterator_to_next (struct it *it, bool reseat_p)
8435 if (it->bidi_it.scan_dir < 0) 8575 if (it->bidi_it.scan_dir < 0)
8436 stop = -1; 8576 stop = -1;
8437 composition_compute_stop_pos (&it->cmp_it, IT_CHARPOS (*it), 8577 composition_compute_stop_pos (&it->cmp_it, IT_CHARPOS (*it),
8438 IT_BYTEPOS (*it), stop, Qnil); 8578 IT_BYTEPOS (*it), stop, Qnil,
8579 true);
8439 } 8580 }
8440 } 8581 }
8441 eassert (IT_BYTEPOS (*it) == CHAR_TO_BYTE (IT_CHARPOS (*it))); 8582 eassert (IT_BYTEPOS (*it) == CHAR_TO_BYTE (IT_CHARPOS (*it)));
@@ -8591,7 +8732,7 @@ set_iterator_to_next (struct it *it, bool reseat_p)
8591 composition_compute_stop_pos (&it->cmp_it, 8732 composition_compute_stop_pos (&it->cmp_it,
8592 IT_STRING_CHARPOS (*it), 8733 IT_STRING_CHARPOS (*it),
8593 IT_STRING_BYTEPOS (*it), stop, 8734 IT_STRING_BYTEPOS (*it), stop,
8594 it->string); 8735 it->string, true);
8595 } 8736 }
8596 } 8737 }
8597 else 8738 else
@@ -8628,7 +8769,7 @@ set_iterator_to_next (struct it *it, bool reseat_p)
8628 composition_compute_stop_pos (&it->cmp_it, 8769 composition_compute_stop_pos (&it->cmp_it,
8629 IT_STRING_CHARPOS (*it), 8770 IT_STRING_CHARPOS (*it),
8630 IT_STRING_BYTEPOS (*it), stop, 8771 IT_STRING_BYTEPOS (*it), stop,
8631 it->string); 8772 it->string, true);
8632 } 8773 }
8633 } 8774 }
8634 } 8775 }
@@ -8789,7 +8930,7 @@ get_visually_first_element (struct it *it)
8789 SET_WITH_NARROWED_BEGV (it, bob, 8930 SET_WITH_NARROWED_BEGV (it, bob,
8790 string_p ? 0 : 8931 string_p ? 0 :
8791 IT_CHARPOS (*it) < BEGV ? obegv : BEGV, 8932 IT_CHARPOS (*it) < BEGV ? obegv : BEGV,
8792 it->narrowed_begv); 8933 it->medium_narrowing_begv);
8793 8934
8794 if (STRINGP (it->string)) 8935 if (STRINGP (it->string))
8795 { 8936 {
@@ -8833,7 +8974,7 @@ get_visually_first_element (struct it *it)
8833 find_newline_no_quit (IT_CHARPOS (*it), 8974 find_newline_no_quit (IT_CHARPOS (*it),
8834 IT_BYTEPOS (*it), -1, 8975 IT_BYTEPOS (*it), -1,
8835 &it->bidi_it.bytepos), 8976 &it->bidi_it.bytepos),
8836 it->narrowed_begv); 8977 it->medium_narrowing_begv);
8837 bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true); 8978 bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true);
8838 do 8979 do
8839 { 8980 {
@@ -8879,7 +9020,7 @@ get_visually_first_element (struct it *it)
8879 if (it->bidi_it.scan_dir < 0) 9020 if (it->bidi_it.scan_dir < 0)
8880 stop = -1; 9021 stop = -1;
8881 composition_compute_stop_pos (&it->cmp_it, charpos, bytepos, stop, 9022 composition_compute_stop_pos (&it->cmp_it, charpos, bytepos, stop,
8882 it->string); 9023 it->string, true);
8883 } 9024 }
8884} 9025}
8885 9026
@@ -10722,7 +10863,7 @@ move_it_vertically_backward (struct it *it, int dy)
10722 dec_both (&cp, &bp); 10863 dec_both (&cp, &bp);
10723 SET_WITH_NARROWED_BEGV (it, cp, 10864 SET_WITH_NARROWED_BEGV (it, cp,
10724 find_newline_no_quit (cp, bp, -1, NULL), 10865 find_newline_no_quit (cp, bp, -1, NULL),
10725 get_closer_narrowed_begv (it->w, IT_CHARPOS (*it))); 10866 get_small_narrowing_begv (it->w, IT_CHARPOS (*it)));
10726 move_it_to (it, cp, -1, -1, -1, MOVE_TO_POS); 10867 move_it_to (it, cp, -1, -1, -1, MOVE_TO_POS);
10727 } 10868 }
10728 bidi_unshelve_cache (it3data, true); 10869 bidi_unshelve_cache (it3data, true);
@@ -12810,6 +12951,8 @@ truncate_message_1 (void *a1, Lisp_Object a2)
12810 return false; 12951 return false;
12811} 12952}
12812 12953
12954extern intptr_t garbage_collection_inhibited;
12955
12813/* Set the current message to STRING. */ 12956/* Set the current message to STRING. */
12814 12957
12815static void 12958static void
@@ -12819,7 +12962,11 @@ set_message (Lisp_Object string)
12819 12962
12820 eassert (STRINGP (string)); 12963 eassert (STRINGP (string));
12821 12964
12822 if (FUNCTIONP (Vset_message_function)) 12965 if (FUNCTIONP (Vset_message_function)
12966 /* FIXME: (bug#63253) We should really make the regexp engine re-entrant,
12967 but in the mean time, let's ignore `set-message-function` when
12968 called from `probably_quit`. */
12969 && !garbage_collection_inhibited)
12823 { 12970 {
12824 specpdl_ref count = SPECPDL_INDEX (); 12971 specpdl_ref count = SPECPDL_INDEX ();
12825 specbind (Qinhibit_quit, Qt); 12972 specbind (Qinhibit_quit, Qt);
@@ -12896,7 +13043,9 @@ clear_message (bool current_p, bool last_displayed_p)
12896 13043
12897 if (current_p) 13044 if (current_p)
12898 { 13045 {
12899 if (FUNCTIONP (Vclear_message_function)) 13046 if (FUNCTIONP (Vclear_message_function)
13047 /* FIXME: (bug#63253) Same as for `set-message-function` above. */
13048 && !garbage_collection_inhibited)
12900 { 13049 {
12901 specpdl_ref count = SPECPDL_INDEX (); 13050 specpdl_ref count = SPECPDL_INDEX ();
12902 specbind (Qinhibit_quit, Qt); 13051 specbind (Qinhibit_quit, Qt);
@@ -16394,7 +16543,7 @@ redisplay_internal (void)
16394 FOR_EACH_FRAME (tail, frame) 16543 FOR_EACH_FRAME (tail, frame)
16395 XFRAME (frame)->already_hscrolled_p = false; 16544 XFRAME (frame)->already_hscrolled_p = false;
16396 16545
16397 reset_outermost_narrowings (); 16546 reset_outermost_restrictions ();
16398 16547
16399 retry: 16548 retry:
16400 /* Remember the currently selected window. */ 16549 /* Remember the currently selected window. */
@@ -18546,8 +18695,9 @@ try_scrolling (Lisp_Object window, bool just_this_one_p,
18546 start_display (&it, w, startp); 18695 start_display (&it, w, startp);
18547 18696
18548 if (arg_scroll_conservatively) 18697 if (arg_scroll_conservatively)
18549 amount_to_scroll = max (dy, frame_line_height 18698 amount_to_scroll
18550 * max (scroll_step, temp_scroll_step)); 18699 = min (max (dy, frame_line_height),
18700 frame_line_height * arg_scroll_conservatively);
18551 else if (scroll_step || temp_scroll_step) 18701 else if (scroll_step || temp_scroll_step)
18552 amount_to_scroll = scroll_max; 18702 amount_to_scroll = scroll_max;
18553 else 18703 else
@@ -20599,6 +20749,8 @@ try_window (Lisp_Object window, struct text_pos pos, int flags)
20599 int bot_scroll_margin = top_scroll_margin; 20749 int bot_scroll_margin = top_scroll_margin;
20600 if (window_wants_header_line (w)) 20750 if (window_wants_header_line (w))
20601 top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w); 20751 top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w);
20752 if (window_wants_tab_line (w))
20753 top_scroll_margin += CURRENT_TAB_LINE_HEIGHT (w);
20602 start_display (&it, w, pos); 20754 start_display (&it, w, pos);
20603 20755
20604 if ((w->cursor.y >= 0 20756 if ((w->cursor.y >= 0
@@ -20944,8 +21096,10 @@ try_window_reusing_current_matrix (struct window *w)
20944 pt_row = first_row_to_display; 21096 pt_row = first_row_to_display;
20945 } 21097 }
20946 21098
21099 if (first_row_to_display->y >= yb)
21100 return false;
21101
20947 /* Start displaying at the start of first_row_to_display. */ 21102 /* Start displaying at the start of first_row_to_display. */
20948 eassert (first_row_to_display->y < yb);
20949 init_to_row_start (&it, w, first_row_to_display); 21103 init_to_row_start (&it, w, first_row_to_display);
20950 21104
20951 nrows_scrolled = (MATRIX_ROW_VPOS (first_reusable_row, w->current_matrix) 21105 nrows_scrolled = (MATRIX_ROW_VPOS (first_reusable_row, w->current_matrix)
@@ -21943,17 +22097,23 @@ try_window_id (struct window *w)
21943 22097
21944 /* Don't let the cursor end in the scroll margins. */ 22098 /* Don't let the cursor end in the scroll margins. */
21945 { 22099 {
21946 int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); 22100 int top_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
22101 int bot_scroll_margin = top_scroll_margin;
21947 int cursor_height = MATRIX_ROW (w->desired_matrix, w->cursor.vpos)->height; 22102 int cursor_height = MATRIX_ROW (w->desired_matrix, w->cursor.vpos)->height;
21948 22103
21949 if ((w->cursor.y < this_scroll_margin 22104 if (window_wants_header_line (w))
22105 top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w);
22106 if (window_wants_tab_line (w))
22107 top_scroll_margin += CURRENT_TAB_LINE_HEIGHT (w);
22108
22109 if ((w->cursor.y < top_scroll_margin
21950 && CHARPOS (start) > BEGV) 22110 && CHARPOS (start) > BEGV)
21951 /* Old redisplay didn't take scroll margin into account at the bottom, 22111 /* Old redisplay didn't take scroll margin into account at the bottom,
21952 but then global-hl-line-mode doesn't scroll. KFS 2004-06-14 */ 22112 but then global-hl-line-mode doesn't scroll. KFS 2004-06-14 */
21953 || (w->cursor.y 22113 || (w->cursor.y
21954 + (cursor_row_fully_visible_p (w, false, true, true) 22114 + (cursor_row_fully_visible_p (w, false, true, true)
21955 ? 1 22115 ? 1
21956 : cursor_height + this_scroll_margin)) > it.last_visible_y) 22116 : cursor_height + bot_scroll_margin)) > it.last_visible_y)
21957 { 22117 {
21958 w->cursor.vpos = -1; 22118 w->cursor.vpos = -1;
21959 clear_glyph_matrix (w->desired_matrix); 22119 clear_glyph_matrix (w->desired_matrix);
@@ -24112,6 +24272,7 @@ display_count_lines_logically (ptrdiff_t start_byte, ptrdiff_t limit_byte,
24112 ptrdiff_t val; 24272 ptrdiff_t val;
24113 specpdl_ref pdl_count = SPECPDL_INDEX (); 24273 specpdl_ref pdl_count = SPECPDL_INDEX ();
24114 record_unwind_protect (save_restriction_restore, save_restriction_save ()); 24274 record_unwind_protect (save_restriction_restore, save_restriction_save ());
24275 labeled_restrictions_remove_in_current_buffer ();
24115 Fwiden (); 24276 Fwiden ();
24116 val = display_count_lines (start_byte, limit_byte, count, byte_pos_ptr); 24277 val = display_count_lines (start_byte, limit_byte, count, byte_pos_ptr);
24117 unbind_to (pdl_count, Qnil); 24278 unbind_to (pdl_count, Qnil);
@@ -28057,9 +28218,8 @@ decode_mode_spec (struct window *w, register int c, int field_width,
28057 ptrdiff_t position; 28218 ptrdiff_t position;
28058 ptrdiff_t distance 28219 ptrdiff_t distance
28059 = (line_number_display_limit_width < 0 ? 0 28220 = (line_number_display_limit_width < 0 ? 0
28060 : INT_MULTIPLY_WRAPV (line_number_display_limit_width, 28221 : ckd_mul (&distance, line_number_display_limit_width,
28061 height * 2 + 30, 28222 height * 2 + 30)
28062 &distance)
28063 ? PTRDIFF_MAX : distance); 28223 ? PTRDIFF_MAX : distance);
28064 28224
28065 if (startpos - distance > limit) 28225 if (startpos - distance > limit)
@@ -36517,7 +36677,7 @@ This is used for internal purposes. */);
36517 Vinhibit_redisplay = Qnil; 36677 Vinhibit_redisplay = Qnil;
36518 36678
36519 DEFVAR_LISP ("global-mode-string", Vglobal_mode_string, 36679 DEFVAR_LISP ("global-mode-string", Vglobal_mode_string,
36520 doc: /* String (or mode line construct) included (normally) in `mode-line-format'. */); 36680 doc: /* String (or mode line construct) included (normally) in `mode-line-misc-info'. */);
36521 Vglobal_mode_string = Qnil; 36681 Vglobal_mode_string = Qnil;
36522 36682
36523 DEFVAR_LISP ("overlay-arrow-position", Voverlay_arrow_position, 36683 DEFVAR_LISP ("overlay-arrow-position", Voverlay_arrow_position,
diff --git a/src/xfns.c b/src/xfns.c
index 9e004f6a678..234a48c908f 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -4252,9 +4252,9 @@ x_window (struct frame *f, long window_prompting)
4252 4252
4253#ifdef HAVE_X_I18N 4253#ifdef HAVE_X_I18N
4254 FRAME_XIC (f) = NULL; 4254 FRAME_XIC (f) = NULL;
4255 if (use_xim) 4255 if (FRAME_DISPLAY_INFO (f)->use_xim)
4256 create_frame_xic (f); 4256 create_frame_xic (f);
4257#endif 4257#endif /* HAVE_X_I18N */
4258 4258
4259 f->output_data.x->wm_hints.input = True; 4259 f->output_data.x->wm_hints.input = True;
4260 f->output_data.x->wm_hints.flags |= InputHint; 4260 f->output_data.x->wm_hints.flags |= InputHint;
@@ -4355,32 +4355,32 @@ x_window (struct frame *f)
4355 4355
4356#ifdef HAVE_X_I18N 4356#ifdef HAVE_X_I18N
4357 FRAME_XIC (f) = NULL; 4357 FRAME_XIC (f) = NULL;
4358 if (use_xim) 4358 if (FRAME_DISPLAY_INFO (f)->use_xim)
4359 { 4359 {
4360 block_input (); 4360 block_input ();
4361 create_frame_xic (f); 4361 create_frame_xic (f);
4362 if (FRAME_XIC (f)) 4362 if (FRAME_XIC (f))
4363 { 4363 {
4364 /* XIM server might require some X events. */ 4364 /* XIM server might require some X events. */
4365 unsigned long fevent = NoEventMask; 4365 unsigned long fevent = NoEventMask;
4366 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL); 4366 XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
4367 4367
4368 if (fevent != NoEventMask) 4368 if (fevent != NoEventMask)
4369 { 4369 {
4370 XSetWindowAttributes attributes; 4370 XSetWindowAttributes attributes;
4371 XWindowAttributes wattr; 4371 XWindowAttributes wattr;
4372 unsigned long attribute_mask; 4372 unsigned long attribute_mask;
4373 4373
4374 XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), 4374 XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4375 &wattr); 4375 &wattr);
4376 attributes.event_mask = wattr.your_event_mask | fevent; 4376 attributes.event_mask = wattr.your_event_mask | fevent;
4377 attribute_mask = CWEventMask; 4377 attribute_mask = CWEventMask;
4378 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), 4378 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4379 attribute_mask, &attributes); 4379 attribute_mask, &attributes);
4380 } 4380 }
4381 } 4381 }
4382 unblock_input (); 4382 unblock_input ();
4383 } 4383 }
4384#endif 4384#endif
4385 4385
4386 append_wm_protocols (FRAME_DISPLAY_INFO (f), f); 4386 append_wm_protocols (FRAME_DISPLAY_INFO (f), f);
@@ -4427,7 +4427,7 @@ x_window (struct frame *f)
4427 initial_set_up_x_back_buffer (f); 4427 initial_set_up_x_back_buffer (f);
4428 4428
4429#ifdef HAVE_X_I18N 4429#ifdef HAVE_X_I18N
4430 if (use_xim) 4430 if (FRAME_DISPLAY_INFO (f)->use_xim)
4431 { 4431 {
4432 create_frame_xic (f); 4432 create_frame_xic (f);
4433 if (FRAME_XIC (f)) 4433 if (FRAME_XIC (f))
diff --git a/src/xml.c b/src/xml.c
index b55ac62cdd3..b4c849e6a65 100644
--- a/src/xml.c
+++ b/src/xml.c
@@ -280,7 +280,10 @@ DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region,
280If START is nil, it defaults to `point-min'. If END is nil, it 280If START is nil, it defaults to `point-min'. If END is nil, it
281defaults to `point-max'. 281defaults to `point-max'.
282 282
283If BASE-URL is non-nil, it is used to expand relative URLs. 283If BASE-URL is non-nil, it is used if and when reporting errors and
284warnings from the underlying libxml2 library. Currently, errors and
285warnings from the library are suppressed, so this argument is largely
286ignored.
284 287
285If you want comments to be stripped, use the `xml-remove-comments' 288If you want comments to be stripped, use the `xml-remove-comments'
286function to strip comments before calling this function. */) 289function to strip comments before calling this function. */)
@@ -298,7 +301,10 @@ DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region,
298If START is nil, it defaults to `point-min'. If END is nil, it 301If START is nil, it defaults to `point-min'. If END is nil, it
299defaults to `point-max'. 302defaults to `point-max'.
300 303
301If BASE-URL is non-nil, it is used to expand relative URLs. 304If BASE-URL is non-nil, it is used if and when reporting errors and
305warnings from the underlying libxml2 library. Currently, errors and
306warnings from the library are suppressed, so this argument is largely
307ignored.
302 308
303If you want comments to be stripped, use the `xml-remove-comments' 309If you want comments to be stripped, use the `xml-remove-comments'
304function to strip comments before calling this function. */) 310function to strip comments before calling this function. */)
diff --git a/src/xselect.c b/src/xselect.c
index 0586e46870b..40be6d4c00c 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -744,13 +744,13 @@ selection_data_size (struct selection_data *data)
744 return (size_t) data->size; 744 return (size_t) data->size;
745 745
746 case 16: 746 case 16:
747 if (INT_MULTIPLY_WRAPV (data->size, 2, &scratch)) 747 if (ckd_mul (&scratch, data->size, 2))
748 return SIZE_MAX; 748 return SIZE_MAX;
749 749
750 return scratch; 750 return scratch;
751 751
752 case 32: 752 case 32:
753 if (INT_MULTIPLY_WRAPV (data->size, 4, &scratch)) 753 if (ckd_mul (&scratch, data->size, 4))
754 return SIZE_MAX; 754 return SIZE_MAX;
755 755
756 return scratch; 756 return scratch;
@@ -3027,7 +3027,7 @@ x_property_data_to_lisp (struct frame *f, const unsigned char *data,
3027{ 3027{
3028 ptrdiff_t format_bytes = format >> 3; 3028 ptrdiff_t format_bytes = format >> 3;
3029 ptrdiff_t data_bytes; 3029 ptrdiff_t data_bytes;
3030 if (INT_MULTIPLY_WRAPV (size, format_bytes, &data_bytes)) 3030 if (ckd_mul (&data_bytes, size, format_bytes))
3031 memory_full (SIZE_MAX); 3031 memory_full (SIZE_MAX);
3032 return selection_data_to_lisp_data (FRAME_DISPLAY_INFO (f), data, 3032 return selection_data_to_lisp_data (FRAME_DISPLAY_INFO (f), data,
3033 data_bytes, type, format); 3033 data_bytes, type, format);
diff --git a/src/xsmfns.c b/src/xsmfns.c
index 799c9fd1053..3cf5165242e 100644
--- a/src/xsmfns.c
+++ b/src/xsmfns.c
@@ -223,7 +223,7 @@ smc_save_yourself_CB (SmcConn smcConn,
223 props[props_idx]->name = xstrdup (SmRestartCommand); 223 props[props_idx]->name = xstrdup (SmRestartCommand);
224 props[props_idx]->type = xstrdup (SmLISTofARRAY8); 224 props[props_idx]->type = xstrdup (SmLISTofARRAY8);
225 /* /path/to/emacs, --smid=xxx --no-splash --chdir=dir ... */ 225 /* /path/to/emacs, --smid=xxx --no-splash --chdir=dir ... */
226 if (INT_ADD_WRAPV (initial_argc, 3, &i)) 226 if (ckd_add (&i, initial_argc, 3))
227 memory_full (SIZE_MAX); 227 memory_full (SIZE_MAX);
228 props[props_idx]->num_vals = i; 228 props[props_idx]->num_vals = i;
229 vp = xnmalloc (i, sizeof *vp); 229 vp = xnmalloc (i, sizeof *vp);
diff --git a/src/xterm.c b/src/xterm.c
index 70bcb67d80d..0450230efe6 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -798,13 +798,6 @@ typedef int (*Emacs_XIOErrorHandler) (Display *);
798#define USE_CAIRO_XCB_SURFACE 798#define USE_CAIRO_XCB_SURFACE
799#endif 799#endif
800 800
801/* Default to using XIM if available. */
802#ifdef USE_XIM
803bool use_xim = true;
804#else
805bool use_xim = false; /* configure --without-xim */
806#endif
807
808#if XCB_SHAPE_MAJOR_VERSION > 1 \ 801#if XCB_SHAPE_MAJOR_VERSION > 1 \
809 || (XCB_SHAPE_MAJOR_VERSION == 1 && \ 802 || (XCB_SHAPE_MAJOR_VERSION == 1 && \
810 XCB_SHAPE_MINOR_VERSION >= 1) 803 XCB_SHAPE_MINOR_VERSION >= 1)
@@ -2322,13 +2315,10 @@ xm_setup_dnd_targets (struct x_display_info *dpyinfo,
2322 target_count = header.target_list_count; 2315 target_count = header.target_list_count;
2323 rc = false; 2316 rc = false;
2324 2317
2325 if (INT_ADD_WRAPV (header.target_list_count, 1, 2318 if (ckd_add (&header.target_list_count, header.target_list_count, 1)
2326 &header.target_list_count) 2319 || ckd_mul (&size, ntargets, 4)
2327 || INT_MULTIPLY_WRAPV (ntargets, 4, &size) 2320 || ckd_add (&header.total_data_size, header.total_data_size, size)
2328 || INT_ADD_WRAPV (header.total_data_size, size, 2321 || ckd_add (&header.total_data_size, header.total_data_size, 2))
2329 &header.total_data_size)
2330 || INT_ADD_WRAPV (header.total_data_size, 2,
2331 &header.total_data_size))
2332 { 2322 {
2333 /* Overflow, remove every entry from the targets table 2323 /* Overflow, remove every entry from the targets table
2334 and add one for our current targets list. This 2324 and add one for our current targets list. This
@@ -6949,8 +6939,7 @@ x_sync_get_monotonic_time (struct x_display_info *dpyinfo,
6949 return 0; 6939 return 0;
6950 6940
6951 uint_fast64_t t; 6941 uint_fast64_t t;
6952 return (INT_SUBTRACT_WRAPV (timestamp, dpyinfo->server_time_offset, &t) 6942 return ckd_sub (&t, timestamp, dpyinfo->server_time_offset) ? 0 : t;
6953 ? 0 : t);
6954} 6943}
6955 6944
6956# ifndef CLOCK_MONOTONIC 6945# ifndef CLOCK_MONOTONIC
@@ -6968,8 +6957,8 @@ x_sync_current_monotonic_time (void)
6968 return (((clock_gettime (CLOCK_MONOTONIC, &time) != 0 6957 return (((clock_gettime (CLOCK_MONOTONIC, &time) != 0
6969 && (CLOCK_MONOTONIC == CLOCK_REALTIME 6958 && (CLOCK_MONOTONIC == CLOCK_REALTIME
6970 || clock_gettime (CLOCK_REALTIME, &time) != 0)) 6959 || clock_gettime (CLOCK_REALTIME, &time) != 0))
6971 || INT_MULTIPLY_WRAPV (time.tv_sec, 1000000, &t) 6960 || ckd_mul (&t, time.tv_sec, 1000000)
6972 || INT_ADD_WRAPV (t, time.tv_nsec / 1000, &t)) 6961 || ckd_add (&t, t, time.tv_nsec / 1000))
6973 ? 0 : t); 6962 ? 0 : t);
6974} 6963}
6975 6964
@@ -6990,8 +6979,7 @@ x_sync_note_frame_times (struct x_display_info *dpyinfo,
6990 time = x_sync_get_monotonic_time (dpyinfo, low | (high << 32)); 6979 time = x_sync_get_monotonic_time (dpyinfo, low | (high << 32));
6991 6980
6992 if (!time || !output->temp_frame_time 6981 if (!time || !output->temp_frame_time
6993 || INT_SUBTRACT_WRAPV (time, output->temp_frame_time, 6982 || ckd_sub (&output->last_frame_time, time, output->temp_frame_time))
6994 &output->last_frame_time))
6995 output->last_frame_time = 0; 6983 output->last_frame_time = 0;
6996 6984
6997#ifdef FRAME_DEBUG 6985#ifdef FRAME_DEBUG
@@ -7967,7 +7955,7 @@ x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time,
7967 7955
7968 dpyinfo->server_time_monotonic_p 7956 dpyinfo->server_time_monotonic_p
7969 = (monotonic_time != 0 7957 = (monotonic_time != 0
7970 && !INT_SUBTRACT_WRAPV (time, monotonic_ms, &diff_ms) 7958 && !ckd_sub (&diff_ms, time, monotonic_ms)
7971 && -500 < diff_ms && diff_ms < 500); 7959 && -500 < diff_ms && diff_ms < 500);
7972 7960
7973 if (!dpyinfo->server_time_monotonic_p) 7961 if (!dpyinfo->server_time_monotonic_p)
@@ -7976,10 +7964,9 @@ x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time,
7976 time to estimate the monotonic time on the X server. */ 7964 time to estimate the monotonic time on the X server. */
7977 7965
7978 if (!monotonic_time 7966 if (!monotonic_time
7979 || INT_MULTIPLY_WRAPV (time, 1000, &dpyinfo->server_time_offset) 7967 || ckd_mul (&dpyinfo->server_time_offset, time, 1000)
7980 || INT_SUBTRACT_WRAPV (dpyinfo->server_time_offset, 7968 || ckd_sub (&dpyinfo->server_time_offset,
7981 monotonic_time, 7969 dpyinfo->server_time_offset, monotonic_time))
7982 &dpyinfo->server_time_offset))
7983 dpyinfo->server_time_offset = 0; 7970 dpyinfo->server_time_offset = 0;
7984 7971
7985 /* If the server time is reasonably close to the monotonic 7972 /* If the server time is reasonably close to the monotonic
@@ -7988,18 +7975,18 @@ x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time,
7988 actual time in ms. */ 7975 actual time in ms. */
7989 7976
7990 monotonic_ms = monotonic_ms & 0xffffffff; 7977 monotonic_ms = monotonic_ms & 0xffffffff;
7991 if (!INT_SUBTRACT_WRAPV (time, monotonic_ms, &diff_ms) 7978 if (!ckd_sub (&diff_ms, time, monotonic_ms)
7992 && -500 < diff_ms && diff_ms < 500) 7979 && -500 < diff_ms && diff_ms < 500)
7993 { 7980 {
7994 /* The server timestamp overflowed. Make the time 7981 /* The server timestamp overflowed. Make the time
7995 offset exactly how much it overflowed by. */ 7982 offset exactly how much it overflowed by. */
7996 7983
7997 if (INT_SUBTRACT_WRAPV (monotonic_time / 1000, monotonic_ms, 7984 if (ckd_sub (&dpyinfo->server_time_offset,
7998 &dpyinfo->server_time_offset) 7985 monotonic_time / 1000, monotonic_ms)
7999 || INT_MULTIPLY_WRAPV (dpyinfo->server_time_offset, 7986 || ckd_mul (&dpyinfo->server_time_offset,
8000 1000, &dpyinfo->server_time_offset) 7987 dpyinfo->server_time_offset, 1000)
8001 || INT_SUBTRACT_WRAPV (0, dpyinfo->server_time_offset, 7988 || ckd_sub (&dpyinfo->server_time_offset,
8002 &dpyinfo->server_time_offset)) 7989 0, dpyinfo->server_time_offset))
8003 dpyinfo->server_time_offset = 0; 7990 dpyinfo->server_time_offset = 0;
8004 } 7991 }
8005 } 7992 }
@@ -21178,14 +21165,28 @@ handle_one_xevent (struct x_display_info *dpyinfo,
21178 x_cr_update_surface_desired_size (any, 21165 x_cr_update_surface_desired_size (any,
21179 configureEvent.xconfigure.width, 21166 configureEvent.xconfigure.width,
21180 configureEvent.xconfigure.height); 21167 configureEvent.xconfigure.height);
21181 if (f || (any && configureEvent.xconfigure.window == FRAME_X_WINDOW (any)))
21182 x_update_opaque_region (f ? f : any, &configureEvent);
21183#endif 21168#endif
21169
21170#if !defined USE_X_TOOLKIT && !defined USE_GTK
21171
21172 /* Make the new size of the frame its opaque region. This is a
21173 region describing areas of the window which are always
21174 guaranteed to be completely opaque and can be treated as such
21175 by the compositor. It is set to the width and height of the
21176 only window in no-toolkit builds when `alpha_background' is
21177 not set, and is cleared otherwise. */
21178
21179 if (f || (any && configureEvent.xconfigure.window
21180 == FRAME_OUTER_WINDOW (any)))
21181 x_update_opaque_region (f ? f : any, &configureEvent);
21182
21183#endif /* !defined USE_X_TOOLKIT && !defined USE_GTK */
21184
21184#ifdef USE_GTK 21185#ifdef USE_GTK
21185 if (!f 21186 if (!f
21186 && (f = any) 21187 && (f = any)
21187 && configureEvent.xconfigure.window == FRAME_X_WINDOW (f) 21188 && configureEvent.xconfigure.window == FRAME_X_WINDOW (f)
21188 && (FRAME_VISIBLE_P(f) 21189 && (FRAME_VISIBLE_P (f)
21189 || !(configureEvent.xconfigure.width <= 1 21190 || !(configureEvent.xconfigure.width <= 1
21190 && configureEvent.xconfigure.height <= 1))) 21191 && configureEvent.xconfigure.height <= 1)))
21191 { 21192 {
@@ -21212,10 +21213,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
21212 f = 0; 21213 f = 0;
21213 } 21214 }
21214#endif 21215#endif
21215 if (f 21216 if (f && (FRAME_VISIBLE_P (f)
21216 && (FRAME_VISIBLE_P(f) 21217 || !(configureEvent.xconfigure.width <= 1
21217 || !(configureEvent.xconfigure.width <= 1 21218 && configureEvent.xconfigure.height <= 1)))
21218 && configureEvent.xconfigure.height <= 1)))
21219 { 21219 {
21220#ifdef USE_GTK 21220#ifdef USE_GTK
21221 /* For GTK+ don't call x_net_wm_state for the scroll bar 21221 /* For GTK+ don't call x_net_wm_state for the scroll bar
@@ -26659,7 +26659,12 @@ xim_destroy_callback (XIM xim, XPointer client_data, XPointer call_data)
26659 26659
26660 /* No need to call XCloseIM. */ 26660 /* No need to call XCloseIM. */
26661 dpyinfo->xim = NULL; 26661 dpyinfo->xim = NULL;
26662 XFree (dpyinfo->xim_styles); 26662
26663 /* Also free IM values; those are allocated separately upon
26664 XGetIMValues. */
26665 if (dpyinfo->xim_styles)
26666 XFree (dpyinfo->xim_styles);
26667 dpyinfo->xim_styles = NULL;
26663 unblock_input (); 26668 unblock_input ();
26664} 26669}
26665 26670
@@ -26677,10 +26682,20 @@ xim_open_dpy (struct x_display_info *dpyinfo, char *resource_name)
26677 XIM xim; 26682 XIM xim;
26678 const char *locale; 26683 const char *locale;
26679 26684
26680 if (use_xim) 26685 if (dpyinfo->use_xim)
26681 { 26686 {
26682 if (dpyinfo->xim) 26687 if (dpyinfo->xim)
26683 XCloseIM (dpyinfo->xim); 26688 {
26689 XCloseIM (dpyinfo->xim);
26690
26691 /* Free values left over from the last time the IM
26692 connection was established. */
26693
26694 if (dpyinfo->xim_styles)
26695 XFree (dpyinfo->xim_styles);
26696 dpyinfo->xim_styles = NULL;
26697 }
26698
26684 xim = XOpenIM (dpyinfo->display, dpyinfo->rdb, resource_name, 26699 xim = XOpenIM (dpyinfo->display, dpyinfo->rdb, resource_name,
26685 emacs_class); 26700 emacs_class);
26686 dpyinfo->xim = xim; 26701 dpyinfo->xim = xim;
@@ -26709,7 +26724,6 @@ xim_open_dpy (struct x_display_info *dpyinfo, char *resource_name)
26709 build_string (locale)); 26724 build_string (locale));
26710 } 26725 }
26711 } 26726 }
26712
26713 else 26727 else
26714#endif /* HAVE_XIM */ 26728#endif /* HAVE_XIM */
26715 dpyinfo->xim = NULL; 26729 dpyinfo->xim = NULL;
@@ -26778,7 +26792,7 @@ xim_initialize (struct x_display_info *dpyinfo, char *resource_name)
26778{ 26792{
26779 dpyinfo->xim = NULL; 26793 dpyinfo->xim = NULL;
26780#ifdef HAVE_XIM 26794#ifdef HAVE_XIM
26781 if (use_xim) 26795 if (dpyinfo->use_xim)
26782 { 26796 {
26783#ifdef HAVE_X11R6_XIM 26797#ifdef HAVE_X11R6_XIM
26784 struct xim_inst_t *xim_inst = xmalloc (sizeof *xim_inst); 26798 struct xim_inst_t *xim_inst = xmalloc (sizeof *xim_inst);
@@ -26787,15 +26801,19 @@ xim_initialize (struct x_display_info *dpyinfo, char *resource_name)
26787 dpyinfo->xim_callback_data = xim_inst; 26801 dpyinfo->xim_callback_data = xim_inst;
26788 xim_inst->dpyinfo = dpyinfo; 26802 xim_inst->dpyinfo = dpyinfo;
26789 xim_inst->resource_name = xstrdup (resource_name); 26803 xim_inst->resource_name = xstrdup (resource_name);
26790 ret = XRegisterIMInstantiateCallback 26804
26791 (dpyinfo->display, dpyinfo->rdb, xim_inst->resource_name, 26805 /* The last argument is XPointer in XFree86 but (XPointer *) on
26792 emacs_class, xim_instantiate_callback, 26806 Tru64, at least, but the configure test doesn't work because
26793 /* This is XPointer in XFree86 but (XPointer *) on Tru64, at 26807 xim_instantiate_callback can either be XIMProc or XIDProc, so
26794 least, but the configure test doesn't work because 26808 just cast to void *. */
26795 xim_instantiate_callback can either be XIMProc or 26809
26796 XIDProc, so just cast to void *. */ 26810 ret = XRegisterIMInstantiateCallback (dpyinfo->display,
26797 (void *) xim_inst); 26811 dpyinfo->rdb,
26798 eassert (ret == True); 26812 xim_inst->resource_name,
26813 emacs_class,
26814 xim_instantiate_callback,
26815 (void *) xim_inst);
26816 eassert (ret);
26799#else /* not HAVE_X11R6_XIM */ 26817#else /* not HAVE_X11R6_XIM */
26800 xim_open_dpy (dpyinfo, resource_name); 26818 xim_open_dpy (dpyinfo, resource_name);
26801#endif /* not HAVE_X11R6_XIM */ 26819#endif /* not HAVE_X11R6_XIM */
@@ -26804,32 +26822,56 @@ xim_initialize (struct x_display_info *dpyinfo, char *resource_name)
26804} 26822}
26805 26823
26806 26824
26807/* Close the connection to the XIM server on display DPYINFO. */ 26825/* Close the connection to the XIM server on display DPYINFO.
26826 Unregister any IM instantiation callback previously installed,
26827 close the connection to the IM server if possible, and free any
26828 retrieved IM values. */
26808 26829
26809static void 26830static void
26810xim_close_dpy (struct x_display_info *dpyinfo) 26831xim_close_dpy (struct x_display_info *dpyinfo)
26811{ 26832{
26812#ifdef HAVE_XIM 26833#ifdef HAVE_XIM
26813 if (use_xim)
26814 {
26815#ifdef HAVE_X11R6_XIM 26834#ifdef HAVE_X11R6_XIM
26816 struct xim_inst_t *xim_inst = dpyinfo->xim_callback_data; 26835 struct xim_inst_t *xim_inst;
26836 Bool rc;
26837
26838 /* If dpyinfo->xim_callback_data is not set, then IM support wasn't
26839 initialized, which can happen if Xlib doesn't understand the C
26840 locale being used. */
26841
26842 if (dpyinfo->xim_callback_data)
26843 {
26844 xim_inst = dpyinfo->xim_callback_data;
26817 26845
26818 if (dpyinfo->display) 26846 if (dpyinfo->display)
26819 { 26847 {
26820 Bool ret = XUnregisterIMInstantiateCallback 26848 rc = XUnregisterIMInstantiateCallback (dpyinfo->display,
26821 (dpyinfo->display, dpyinfo->rdb, xim_inst->resource_name, 26849 dpyinfo->rdb,
26822 emacs_class, xim_instantiate_callback, (void *) xim_inst); 26850 xim_inst->resource_name,
26823 eassert (ret == True); 26851 emacs_class,
26852 xim_instantiate_callback,
26853 (void *) xim_inst);
26854 eassert (rc);
26824 } 26855 }
26856
26825 xfree (xim_inst->resource_name); 26857 xfree (xim_inst->resource_name);
26826 xfree (xim_inst); 26858 xfree (xim_inst);
26827#endif /* HAVE_X11R6_XIM */
26828 if (dpyinfo->display)
26829 XCloseIM (dpyinfo->xim);
26830 dpyinfo->xim = NULL;
26831 XFree (dpyinfo->xim_styles);
26832 } 26859 }
26860#endif /* HAVE_X11R6_XIM */
26861
26862 /* Now close the connection to the input method server. This may
26863 access the display connection, and isn't safe if the display has
26864 already been closed. */
26865
26866 if (dpyinfo->display && dpyinfo->xim)
26867 XCloseIM (dpyinfo->xim);
26868 dpyinfo->xim = NULL;
26869
26870 /* Free the list of XIM styles retrieved. */
26871
26872 if (dpyinfo->xim_styles)
26873 XFree (dpyinfo->xim_styles);
26874 dpyinfo->xim_styles = NULL;
26833#endif /* HAVE_XIM */ 26875#endif /* HAVE_XIM */
26834} 26876}
26835 26877
@@ -30186,7 +30228,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
30186 { 30228 {
30187 static char const at[] = " at "; 30229 static char const at[] = " at ";
30188 ptrdiff_t nbytes = sizeof (title) + sizeof (at); 30230 ptrdiff_t nbytes = sizeof (title) + sizeof (at);
30189 if (INT_ADD_WRAPV (nbytes, SBYTES (system_name), &nbytes)) 30231 if (ckd_add (&nbytes, nbytes, SBYTES (system_name)))
30190 memory_full (SIZE_MAX); 30232 memory_full (SIZE_MAX);
30191 dpyinfo->x_id_name = xmalloc (nbytes); 30233 dpyinfo->x_id_name = xmalloc (nbytes);
30192 sprintf (dpyinfo->x_id_name, "%s%s%s", title, at, SDATA (system_name)); 30234 sprintf (dpyinfo->x_id_name, "%s%s%s", title, at, SDATA (system_name));
@@ -30756,15 +30798,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
30756 30798
30757 dpyinfo->invisible_cursor = make_invisible_cursor (dpyinfo); 30799 dpyinfo->invisible_cursor = make_invisible_cursor (dpyinfo);
30758#if defined HAVE_XFIXES && XFIXES_VERSION >= 40000 30800#if defined HAVE_XFIXES && XFIXES_VERSION >= 40000
30759 dpyinfo->fixes_pointer_blanking = egetenv ("EMACS_XFIXES"); 30801 dpyinfo->fixes_pointer_blanking = (egetenv ("EMACS_XFIXES") != NULL);
30760#endif
30761
30762#ifdef HAVE_X_I18N
30763 /* Avoid initializing input methods if the X library does not
30764 support Emacs's locale. When the current locale is not
30765 supported, decoding input method strings becomes undefined. */
30766 if (XSupportsLocale ())
30767 xim_initialize (dpyinfo, resource_name);
30768#endif 30802#endif
30769 30803
30770 xsettings_initialize (dpyinfo); 30804 xsettings_initialize (dpyinfo);
@@ -30825,25 +30859,33 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
30825 XSynchronize (dpyinfo->display, True); 30859 XSynchronize (dpyinfo->display, True);
30826 } 30860 }
30827 30861
30862#ifdef HAVE_X_I18N
30828 { 30863 {
30829 AUTO_STRING (useXIM, "useXIM"); 30864 AUTO_STRING (useXIM, "useXIM");
30830 AUTO_STRING (UseXIM, "UseXIM"); 30865 AUTO_STRING (UseXIM, "UseXIM");
30831 Lisp_Object value = gui_display_get_resource (dpyinfo, useXIM, UseXIM, 30866 Lisp_Object value = gui_display_get_resource (dpyinfo, useXIM, UseXIM,
30832 Qnil, Qnil); 30867 Qnil, Qnil);
30868
30869 /* `USE_XIM' controls whether Emacs should use X input methods by
30870 default, not whether or not XIM is available. */
30871
30833#ifdef USE_XIM 30872#ifdef USE_XIM
30873 dpyinfo->use_xim = true;
30874
30834 if (STRINGP (value) 30875 if (STRINGP (value)
30835 && (!strcmp (SSDATA (value), "false") 30876 && (!strcmp (SSDATA (value), "false")
30836 || !strcmp (SSDATA (value), "off"))) 30877 || !strcmp (SSDATA (value), "off")))
30837 use_xim = false; 30878 dpyinfo->use_xim = false;
30838#else 30879#else /* !USE_XIM */
30880 dpyinfo->use_xim = false;
30881
30839 if (STRINGP (value) 30882 if (STRINGP (value)
30840 && (!strcmp (SSDATA (value), "true") 30883 && (!strcmp (SSDATA (value), "true")
30841 || !strcmp (SSDATA (value), "on"))) 30884 || !strcmp (SSDATA (value), "on")))
30842 use_xim = true; 30885 dpyinfo->use_xim = true;
30843#endif 30886#endif /* USE_XIM */
30844 } 30887 }
30845 30888
30846#ifdef HAVE_X_I18N
30847 { 30889 {
30848 AUTO_STRING (inputStyle, "inputStyle"); 30890 AUTO_STRING (inputStyle, "inputStyle");
30849 AUTO_STRING (InputStyle, "InputStyle"); 30891 AUTO_STRING (InputStyle, "InputStyle");
@@ -30865,10 +30907,19 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
30865#ifdef USE_GTK 30907#ifdef USE_GTK
30866 else if (!strcmp (SSDATA (value), "native")) 30908 else if (!strcmp (SSDATA (value), "native"))
30867 dpyinfo->prefer_native_input = true; 30909 dpyinfo->prefer_native_input = true;
30868#endif 30910#endif /* HAVE_GTK */
30869 } 30911 }
30870 } 30912 }
30871#endif 30913
30914 /* Now that defaults have been set up, initialize input method
30915 support. */
30916
30917 /* Avoid initializing input methods if the X library does not
30918 support Emacs's locale. When the current locale is not
30919 supported, decoding input method strings becomes undefined. */
30920 if (XSupportsLocale ())
30921 xim_initialize (dpyinfo, resource_name);
30922#endif /* HAVE_X_I18N */
30872 30923
30873#ifdef HAVE_X_SM 30924#ifdef HAVE_X_SM
30874 /* Only do this for the very first display in the Emacs session. 30925 /* Only do this for the very first display in the Emacs session.
@@ -31261,14 +31312,22 @@ x_delete_terminal (struct terminal *terminal)
31261#ifdef HAVE_X_I18N 31312#ifdef HAVE_X_I18N
31262 /* We must close our connection to the XIM server before closing the 31313 /* We must close our connection to the XIM server before closing the
31263 X display. */ 31314 X display. */
31264 if (dpyinfo->xim) 31315 xim_close_dpy (dpyinfo);
31265 xim_close_dpy (dpyinfo);
31266#endif 31316#endif
31267 31317
31318 /* Destroy all bitmap images created on the display. */
31319 image_destroy_all_bitmaps (dpyinfo);
31320
31321 /* Free the storage allocated to hold bitmap records. */
31322 xfree (dpyinfo->bitmaps);
31323
31324 /* In case someone decides to use `bitmaps' again... */
31325 dpyinfo->bitmaps = NULL;
31326 dpyinfo->bitmaps_last = 0;
31327
31268 /* Normally, the display is available... */ 31328 /* Normally, the display is available... */
31269 if (dpyinfo->display) 31329 if (dpyinfo->display)
31270 { 31330 {
31271 image_destroy_all_bitmaps (dpyinfo);
31272 XSetCloseDownMode (dpyinfo->display, DestroyAll); 31331 XSetCloseDownMode (dpyinfo->display, DestroyAll);
31273 31332
31274 /* Delete the scratch cursor GC, should it exist. */ 31333 /* Delete the scratch cursor GC, should it exist. */
diff --git a/src/xterm.h b/src/xterm.h
index 28ae00ca190..34a713ea2ca 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -649,7 +649,11 @@ struct x_display_info
649 649
650 /* The named coding system to use for this input method. */ 650 /* The named coding system to use for this input method. */
651 Lisp_Object xim_coding; 651 Lisp_Object xim_coding;
652#endif 652
653 /* Whether or not X input methods should be used on this
654 display. */
655 bool use_xim;
656#endif /* HAVE_X_I18N */
653 657
654 /* A cache mapping color names to RGB values. */ 658 /* A cache mapping color names to RGB values. */
655 struct color_name_cache_entry **color_names; 659 struct color_name_cache_entry **color_names;
@@ -922,11 +926,6 @@ struct x_display_info
922#endif 926#endif
923}; 927};
924 928
925#ifdef HAVE_X_I18N
926/* Whether or not to use XIM if we have it. */
927extern bool use_xim;
928#endif
929
930#ifdef HAVE_XINPUT2 929#ifdef HAVE_XINPUT2
931/* Defined in xmenu.c. */ 930/* Defined in xmenu.c. */
932extern int popup_activated_flag; 931extern int popup_activated_flag;
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-13 09:12:36 +0000