aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorStephen Leake2019-09-10 03:37:51 -0700
committerStephen Leake2019-09-10 03:37:51 -0700
commit3d442312889ef2d14c07282d0aff6199d00cc165 (patch)
tree74034ca2dded6ed233d0701b4cb5c10a0b5e9034 /src
parentac1a2e260e8ece34500b5879f766b4e54ee57b94 (diff)
parent74e9799bd89484b8d15bdd6597c68fc00d07e7f7 (diff)
downloademacs-3d442312889ef2d14c07282d0aff6199d00cc165.tar.gz
emacs-3d442312889ef2d14c07282d0aff6199d00cc165.zip
Merge commit '74e9799bd89484b8d15bdd6597c68fc00d07e7f7'
Diffstat (limited to 'src')
-rw-r--r--src/alloc.c146
-rw-r--r--src/bignum.c15
-rw-r--r--src/bignum.h19
-rw-r--r--src/buffer.c10
-rw-r--r--src/buffer.h671
-rw-r--r--src/coding.c5
-rw-r--r--src/composite.c7
-rw-r--r--src/conf_post.h43
-rw-r--r--src/data.c139
-rw-r--r--src/dbusbind.c37
-rw-r--r--src/emacs.c3
-rw-r--r--src/floatfns.c14
-rw-r--r--src/fns.c82
-rw-r--r--src/font.c7
-rw-r--r--src/frame.c16
-rw-r--r--src/ftfont.c2
-rw-r--r--src/ftfont.h1
-rw-r--r--src/gnutls.c215
-rw-r--r--src/image.c35
-rw-r--r--src/keyboard.c4
-rw-r--r--src/keymap.c4
-rw-r--r--src/lisp.h10
-rw-r--r--src/lread.c71
-rw-r--r--src/mini-gmp.c10
-rw-r--r--src/minibuf.c3
-rw-r--r--src/pdumper.c219
-rw-r--r--src/pdumper.h16
-rw-r--r--src/process.c104
-rw-r--r--src/sound.c6
-rw-r--r--src/sysdep.c6
-rw-r--r--src/sysstdio.h1
-rw-r--r--src/systime.h2
-rw-r--r--src/timefns.c163
-rw-r--r--src/w32.c2
-rw-r--r--src/xdisp.c20
-rw-r--r--src/xterm.c1
36 files changed, 1381 insertions, 728 deletions
diff --git a/src/alloc.c b/src/alloc.c
index bb8e97f8737..be98cfd5f53 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -297,20 +297,20 @@ static ptrdiff_t pure_bytes_used_non_lisp;
297 297
298static intptr_t garbage_collection_inhibited; 298static intptr_t garbage_collection_inhibited;
299 299
300/* The GC threshold in bytes, the last time it was calculated
301 from gc-cons-threshold and gc-cons-percentage. */
302static intmax_t gc_threshold;
303
300/* If nonzero, this is a warning delivered by malloc and not yet 304/* If nonzero, this is a warning delivered by malloc and not yet
301 displayed. */ 305 displayed. */
302 306
303const char *pending_malloc_warning; 307const char *pending_malloc_warning;
304 308
305#if 0 /* Normally, pointer sanity only on request... */ 309/* Pointer sanity only on request. FIXME: Code depending on
310 SUSPICIOUS_OBJECT_CHECKING is obsolete; remove it entirely. */
306#ifdef ENABLE_CHECKING 311#ifdef ENABLE_CHECKING
307#define SUSPICIOUS_OBJECT_CHECKING 1 312#define SUSPICIOUS_OBJECT_CHECKING 1
308#endif 313#endif
309#endif
310
311/* ... but unconditionally use SUSPICIOUS_OBJECT_CHECKING while the GC
312 bug is unresolved. */
313#define SUSPICIOUS_OBJECT_CHECKING 1
314 314
315#ifdef SUSPICIOUS_OBJECT_CHECKING 315#ifdef SUSPICIOUS_OBJECT_CHECKING
316struct suspicious_free_record 316struct suspicious_free_record
@@ -327,8 +327,8 @@ static int suspicious_free_history_index;
327static void *find_suspicious_object_in_range (void *begin, void *end); 327static void *find_suspicious_object_in_range (void *begin, void *end);
328static void detect_suspicious_free (void *ptr); 328static void detect_suspicious_free (void *ptr);
329#else 329#else
330# define find_suspicious_object_in_range(begin, end) NULL 330# define find_suspicious_object_in_range(begin, end) ((void *) NULL)
331# define detect_suspicious_free(ptr) (void) 331# define detect_suspicious_free(ptr) ((void) 0)
332#endif 332#endif
333 333
334/* Maximum amount of C stack to save when a GC happens. */ 334/* Maximum amount of C stack to save when a GC happens. */
@@ -4621,11 +4621,11 @@ mark_maybe_pointer (void *p)
4621 4621
4622 if (pdumper_object_p (p)) 4622 if (pdumper_object_p (p))
4623 { 4623 {
4624 enum Lisp_Type type = pdumper_find_object_type (p); 4624 int type = pdumper_find_object_type (p);
4625 if (type != PDUMPER_NO_OBJECT) 4625 if (pdumper_valid_object_type_p (type))
4626 mark_object ((type == Lisp_Symbol) 4626 mark_object (type == Lisp_Symbol
4627 ? make_lisp_symbol(p) 4627 ? make_lisp_symbol (p)
4628 : make_lisp_ptr(p, type)); 4628 : make_lisp_ptr (p, type));
4629 /* See mark_maybe_object for why we can confidently return. */ 4629 /* See mark_maybe_object for why we can confidently return. */
4630 return; 4630 return;
4631 } 4631 }
@@ -5290,9 +5290,10 @@ make_pure_float (double num)
5290 space. */ 5290 space. */
5291 5291
5292static Lisp_Object 5292static Lisp_Object
5293make_pure_bignum (struct Lisp_Bignum *value) 5293make_pure_bignum (Lisp_Object value)
5294{ 5294{
5295 size_t i, nlimbs = mpz_size (value->value); 5295 mpz_t const *n = xbignum_val (value);
5296 size_t i, nlimbs = mpz_size (*n);
5296 size_t nbytes = nlimbs * sizeof (mp_limb_t); 5297 size_t nbytes = nlimbs * sizeof (mp_limb_t);
5297 mp_limb_t *pure_limbs; 5298 mp_limb_t *pure_limbs;
5298 mp_size_t new_size; 5299 mp_size_t new_size;
@@ -5303,10 +5304,10 @@ make_pure_bignum (struct Lisp_Bignum *value)
5303 int limb_alignment = alignof (mp_limb_t); 5304 int limb_alignment = alignof (mp_limb_t);
5304 pure_limbs = pure_alloc (nbytes, - limb_alignment); 5305 pure_limbs = pure_alloc (nbytes, - limb_alignment);
5305 for (i = 0; i < nlimbs; ++i) 5306 for (i = 0; i < nlimbs; ++i)
5306 pure_limbs[i] = mpz_getlimbn (value->value, i); 5307 pure_limbs[i] = mpz_getlimbn (*n, i);
5307 5308
5308 new_size = nlimbs; 5309 new_size = nlimbs;
5309 if (mpz_sgn (value->value) < 0) 5310 if (mpz_sgn (*n) < 0)
5310 new_size = -new_size; 5311 new_size = -new_size;
5311 5312
5312 mpz_roinit_n (b->value, pure_limbs, new_size); 5313 mpz_roinit_n (b->value, pure_limbs, new_size);
@@ -5456,7 +5457,7 @@ purecopy (Lisp_Object obj)
5456 return obj; 5457 return obj;
5457 } 5458 }
5458 else if (BIGNUMP (obj)) 5459 else if (BIGNUMP (obj))
5459 obj = make_pure_bignum (XBIGNUM (obj)); 5460 obj = make_pure_bignum (obj);
5460 else 5461 else
5461 { 5462 {
5462 AUTO_STRING (fmt, "Don't know how to purify: %S"); 5463 AUTO_STRING (fmt, "Don't know how to purify: %S");
@@ -5784,6 +5785,77 @@ mark_and_sweep_weak_table_contents (void)
5784 } 5785 }
5785} 5786}
5786 5787
5788/* Return the number of bytes to cons between GCs, assuming
5789 gc-cons-threshold is THRESHOLD and gc-cons-percentage is
5790 PERCENTAGE. */
5791static intmax_t
5792consing_threshold (intmax_t threshold, Lisp_Object percentage)
5793{
5794 if (!NILP (Vmemory_full))
5795 return memory_full_cons_threshold;
5796 else
5797 {
5798 threshold = max (threshold, GC_DEFAULT_THRESHOLD / 10);
5799 if (FLOATP (percentage))
5800 {
5801 double tot = (XFLOAT_DATA (percentage)
5802 * total_bytes_of_live_objects ());
5803 if (threshold < tot)
5804 {
5805 if (tot < INTMAX_MAX)
5806 threshold = tot;
5807 else
5808 threshold = INTMAX_MAX;
5809 }
5810 }
5811 return threshold;
5812 }
5813}
5814
5815/* Adjust consing_until_gc, assuming gc-cons-threshold is THRESHOLD and
5816 gc-cons-percentage is PERCENTAGE. */
5817static Lisp_Object
5818bump_consing_until_gc (intmax_t threshold, Lisp_Object percentage)
5819{
5820 /* If consing_until_gc is negative leave it alone, since this prevents
5821 negative integer overflow and a GC would have been done soon anyway. */
5822 if (0 <= consing_until_gc)
5823 {
5824 threshold = consing_threshold (threshold, percentage);
5825 intmax_t sum;
5826 if (INT_ADD_WRAPV (consing_until_gc, threshold - gc_threshold, &sum))
5827 {
5828 /* Scale the threshold down so that consing_until_gc does
5829 not overflow. */
5830 sum = INTMAX_MAX;
5831 threshold = INTMAX_MAX - consing_until_gc + gc_threshold;
5832 }
5833 consing_until_gc = sum;
5834 gc_threshold = threshold;
5835 }
5836
5837 return Qnil;
5838}
5839
5840/* Watch changes to gc-cons-threshold. */
5841static Lisp_Object
5842watch_gc_cons_threshold (Lisp_Object symbol, Lisp_Object newval,
5843 Lisp_Object operation, Lisp_Object where)
5844{
5845 intmax_t threshold;
5846 if (! (INTEGERP (newval) && integer_to_intmax (newval, &threshold)))
5847 return Qnil;
5848 return bump_consing_until_gc (threshold, Vgc_cons_percentage);
5849}
5850
5851/* Watch changes to gc-cons-percentage. */
5852static Lisp_Object
5853watch_gc_cons_percentage (Lisp_Object symbol, Lisp_Object newval,
5854 Lisp_Object operation, Lisp_Object where)
5855{
5856 return bump_consing_until_gc (gc_cons_threshold, newval);
5857}
5858
5787/* Subroutine of Fgarbage_collect that does most of the work. */ 5859/* Subroutine of Fgarbage_collect that does most of the work. */
5788static bool 5860static bool
5789garbage_collect_1 (struct gcstat *gcst) 5861garbage_collect_1 (struct gcstat *gcst)
@@ -5926,25 +5998,8 @@ garbage_collect_1 (struct gcstat *gcst)
5926 5998
5927 unblock_input (); 5999 unblock_input ();
5928 6000
5929 if (!NILP (Vmemory_full)) 6001 consing_until_gc = gc_threshold
5930 consing_until_gc = memory_full_cons_threshold; 6002 = consing_threshold (gc_cons_threshold, Vgc_cons_percentage);
5931 else
5932 {
5933 intmax_t threshold = max (gc_cons_threshold, GC_DEFAULT_THRESHOLD / 10);
5934 if (FLOATP (Vgc_cons_percentage))
5935 {
5936 double tot = (XFLOAT_DATA (Vgc_cons_percentage)
5937 * total_bytes_of_live_objects ());
5938 if (threshold < tot)
5939 {
5940 if (tot < INTMAX_MAX)
5941 threshold = tot;
5942 else
5943 threshold = INTMAX_MAX;
5944 }
5945 }
5946 consing_until_gc = threshold;
5947 }
5948 6003
5949 if (garbage_collection_messages && NILP (Vmemory_full)) 6004 if (garbage_collection_messages && NILP (Vmemory_full))
5950 { 6005 {
@@ -7365,6 +7420,7 @@ do hash-consing of the objects allocated to pure space. */);
7365 DEFSYM (Qheap, "heap"); 7420 DEFSYM (Qheap, "heap");
7366 DEFSYM (QAutomatic_GC, "Automatic GC"); 7421 DEFSYM (QAutomatic_GC, "Automatic GC");
7367 7422
7423 DEFSYM (Qgc_cons_percentage, "gc-cons-percentage");
7368 DEFSYM (Qgc_cons_threshold, "gc-cons-threshold"); 7424 DEFSYM (Qgc_cons_threshold, "gc-cons-threshold");
7369 DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots"); 7425 DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots");
7370 7426
@@ -7398,6 +7454,22 @@ N should be nonnegative. */);
7398 defsubr (&Smemory_info); 7454 defsubr (&Smemory_info);
7399 defsubr (&Smemory_use_counts); 7455 defsubr (&Smemory_use_counts);
7400 defsubr (&Ssuspicious_object); 7456 defsubr (&Ssuspicious_object);
7457
7458 Lisp_Object watcher;
7459
7460 static union Aligned_Lisp_Subr Swatch_gc_cons_threshold =
7461 {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },
7462 { .a4 = watch_gc_cons_threshold },
7463 4, 4, "watch_gc_cons_threshold", 0, 0}};
7464 XSETSUBR (watcher, &Swatch_gc_cons_threshold.s);
7465 Fadd_variable_watcher (Qgc_cons_threshold, watcher);
7466
7467 static union Aligned_Lisp_Subr Swatch_gc_cons_percentage =
7468 {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },
7469 { .a4 = watch_gc_cons_percentage },
7470 4, 4, "watch_gc_cons_percentage", 0, 0}};
7471 XSETSUBR (watcher, &Swatch_gc_cons_percentage.s);
7472 Fadd_variable_watcher (Qgc_cons_percentage, watcher);
7401} 7473}
7402 7474
7403#ifdef HAVE_X_WINDOWS 7475#ifdef HAVE_X_WINDOWS
diff --git a/src/bignum.c b/src/bignum.c
index 3883d3a3944..167b73eee02 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -31,9 +31,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
31 storage is exhausted. Admittedly this is not ideal. An mpz value 31 storage is exhausted. Admittedly this is not ideal. An mpz value
32 in a temporary is made permanent by mpz_swapping it with a bignum's 32 in a temporary is made permanent by mpz_swapping it with a bignum's
33 value. Although typically at most two temporaries are needed, 33 value. Although typically at most two temporaries are needed,
34 time_arith, rounddiv_q and rounding_driver each need four. */ 34 rounddiv_q and rounding_driver both need four and time_arith needs
35 five. */
35 36
36mpz_t mpz[4]; 37mpz_t mpz[5];
37 38
38static void * 39static void *
39xrealloc_for_gmp (void *ptr, size_t ignore, size_t size) 40xrealloc_for_gmp (void *ptr, size_t ignore, size_t size)
@@ -62,7 +63,7 @@ init_bignum (void)
62double 63double
63bignum_to_double (Lisp_Object n) 64bignum_to_double (Lisp_Object n)
64{ 65{
65 return mpz_get_d_rounded (XBIGNUM (n)->value); 66 return mpz_get_d_rounded (*xbignum_val (n));
66} 67}
67 68
68/* Return D, converted to a Lisp integer. Discard any fraction. 69/* Return D, converted to a Lisp integer. Discard any fraction.
@@ -263,13 +264,13 @@ intmax_t
263bignum_to_intmax (Lisp_Object x) 264bignum_to_intmax (Lisp_Object x)
264{ 265{
265 intmax_t i; 266 intmax_t i;
266 return mpz_to_intmax (XBIGNUM (x)->value, &i) ? i : 0; 267 return mpz_to_intmax (*xbignum_val (x), &i) ? i : 0;
267} 268}
268uintmax_t 269uintmax_t
269bignum_to_uintmax (Lisp_Object x) 270bignum_to_uintmax (Lisp_Object x)
270{ 271{
271 uintmax_t i; 272 uintmax_t i;
272 return mpz_to_uintmax (XBIGNUM (x)->value, &i) ? i : 0; 273 return mpz_to_uintmax (*xbignum_val (x), &i) ? i : 0;
273} 274}
274 275
275/* Yield an upper bound on the buffer size needed to contain a C 276/* Yield an upper bound on the buffer size needed to contain a C
@@ -283,7 +284,7 @@ mpz_bufsize (mpz_t const num, int base)
283ptrdiff_t 284ptrdiff_t
284bignum_bufsize (Lisp_Object num, int base) 285bignum_bufsize (Lisp_Object num, int base)
285{ 286{
286 return mpz_bufsize (XBIGNUM (num)->value, base); 287 return mpz_bufsize (*xbignum_val (num), base);
287} 288}
288 289
289/* Convert NUM to a nearest double, as opposed to mpz_get_d which 290/* Convert NUM to a nearest double, as opposed to mpz_get_d which
@@ -317,7 +318,7 @@ ptrdiff_t
317bignum_to_c_string (char *buf, ptrdiff_t size, Lisp_Object num, int base) 318bignum_to_c_string (char *buf, ptrdiff_t size, Lisp_Object num, int base)
318{ 319{
319 eassert (bignum_bufsize (num, abs (base)) == size); 320 eassert (bignum_bufsize (num, abs (base)) == size);
320 mpz_get_str (buf, base, XBIGNUM (num)->value); 321 mpz_get_str (buf, base, *xbignum_val (num));
321 ptrdiff_t n = size - 2; 322 ptrdiff_t n = size - 2;
322 return !buf[n - 1] ? n - 1 : n + !!buf[n]; 323 return !buf[n - 1] ? n - 1 : n + !!buf[n];
323} 324}
diff --git a/src/bignum.h b/src/bignum.h
index a9c7a0a09a8..bf7b3669537 100644
--- a/src/bignum.h
+++ b/src/bignum.h
@@ -41,7 +41,7 @@ struct Lisp_Bignum
41 mpz_t value; 41 mpz_t value;
42} GCALIGNED_STRUCT; 42} GCALIGNED_STRUCT;
43 43
44extern mpz_t mpz[4]; 44extern mpz_t mpz[5];
45 45
46extern void init_bignum (void); 46extern void init_bignum (void);
47extern Lisp_Object make_integer_mpz (void); 47extern Lisp_Object make_integer_mpz (void);
@@ -80,6 +80,19 @@ mpz_set_uintmax (mpz_t result, uintmax_t v)
80 mpz_set_uintmax_slow (result, v); 80 mpz_set_uintmax_slow (result, v);
81} 81}
82 82
83/* Return a pointer to the mpz_t value represented by the bignum I.
84 It is const because the value should not change. */
85INLINE mpz_t const *
86bignum_val (struct Lisp_Bignum const *i)
87{
88 return &i->value;
89}
90INLINE mpz_t const *
91xbignum_val (Lisp_Object i)
92{
93 return bignum_val (XBIGNUM (i));
94}
95
83/* Return a pointer to an mpz_t that is equal to the Lisp integer I. 96/* Return a pointer to an mpz_t that is equal to the Lisp integer I.
84 If I is a bignum this returns a pointer to I's representation; 97 If I is a bignum this returns a pointer to I's representation;
85 otherwise this sets *TMP to I's value and returns TMP. */ 98 otherwise this sets *TMP to I's value and returns TMP. */
@@ -91,7 +104,7 @@ bignum_integer (mpz_t *tmp, Lisp_Object i)
91 mpz_set_intmax (*tmp, XFIXNUM (i)); 104 mpz_set_intmax (*tmp, XFIXNUM (i));
92 return tmp; 105 return tmp;
93 } 106 }
94 return &XBIGNUM (i)->value; 107 return xbignum_val (i);
95} 108}
96 109
97/* Set RESULT to the value stored in the Lisp integer I. If I is a 110/* Set RESULT to the value stored in the Lisp integer I. If I is a
@@ -103,7 +116,7 @@ mpz_set_integer (mpz_t result, Lisp_Object i)
103 if (FIXNUMP (i)) 116 if (FIXNUMP (i))
104 mpz_set_intmax (result, XFIXNUM (i)); 117 mpz_set_intmax (result, XFIXNUM (i));
105 else 118 else
106 mpz_set (result, XBIGNUM (i)->value); 119 mpz_set (result, *xbignum_val (i));
107} 120}
108 121
109INLINE_HEADER_END 122INLINE_HEADER_END
diff --git a/src/buffer.c b/src/buffer.c
index ea785bbcd70..77e8b6bb779 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -105,7 +105,7 @@ static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];
105 105
106/* Number of per-buffer variables used. */ 106/* Number of per-buffer variables used. */
107 107
108int last_per_buffer_idx; 108static int last_per_buffer_idx;
109 109
110static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay, 110static void call_overlay_mod_hooks (Lisp_Object list, Lisp_Object overlay,
111 bool after, Lisp_Object arg1, 111 bool after, Lisp_Object arg1,
@@ -655,6 +655,12 @@ set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
655 b->overlays_after = o; 655 b->overlays_after = o;
656} 656}
657 657
658bool
659valid_per_buffer_idx (int idx)
660{
661 return 0 <= idx && idx < last_per_buffer_idx;
662}
663
658/* Clone per-buffer values of buffer FROM. 664/* Clone per-buffer values of buffer FROM.
659 665
660 Buffer TO gets the same per-buffer values as FROM, with the 666 Buffer TO gets the same per-buffer values as FROM, with the
@@ -4568,7 +4574,7 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after,
4568 prop_i = copy[i++]; 4574 prop_i = copy[i++];
4569 overlay_i = copy[i++]; 4575 overlay_i = copy[i++];
4570 /* It is possible that the recorded overlay has been deleted 4576 /* It is possible that the recorded overlay has been deleted
4571 (which makes it's markers' buffers be nil), or that (due to 4577 (which makes its markers' buffers be nil), or that (due to
4572 some bug) it belongs to a different buffer. Only run this 4578 some bug) it belongs to a different buffer. Only run this
4573 hook if the overlay belongs to the current buffer. */ 4579 hook if the overlay belongs to the current buffer. */
4574 if (XMARKER (OVERLAY_START (overlay_i))->buffer == current_buffer) 4580 if (XMARKER (OVERLAY_START (overlay_i))->buffer == current_buffer)
diff --git a/src/buffer.h b/src/buffer.h
index 2080a6f40b7..82d9350bfc2 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -31,12 +31,11 @@ INLINE_HEADER_BEGIN
31 31
32/* Accessing the parameters of the current buffer. */ 32/* Accessing the parameters of the current buffer. */
33 33
34/* These macros come in pairs, one for the char position 34/* These constants and macros come in pairs, one for the char position
35 and one for the byte position. */ 35 and one for the byte position. */
36 36
37/* Position of beginning of buffer. */ 37/* Position of beginning of buffer. */
38#define BEG (1) 38enum { BEG = 1, BEG_BYTE = BEG };
39#define BEG_BYTE (BEG)
40 39
41/* Position of beginning of accessible range of buffer. */ 40/* Position of beginning of accessible range of buffer. */
42#define BEGV (current_buffer->begv) 41#define BEGV (current_buffer->begv)
@@ -96,59 +95,7 @@ INLINE_HEADER_BEGIN
96 95
97/* Modification count as of last visit or save. */ 96/* Modification count as of last visit or save. */
98#define SAVE_MODIFF (current_buffer->text->save_modiff) 97#define SAVE_MODIFF (current_buffer->text->save_modiff)
99
100/* BUFFER_CEILING_OF (resp. BUFFER_FLOOR_OF), when applied to n, return
101 the max (resp. min) p such that
102
103 BYTE_POS_ADDR (p) - BYTE_POS_ADDR (n) == p - n */
104
105#define BUFFER_CEILING_OF(BYTEPOS) \
106 (((BYTEPOS) < GPT_BYTE && GPT < ZV ? GPT_BYTE : ZV_BYTE) - 1)
107#define BUFFER_FLOOR_OF(BYTEPOS) \
108 (BEGV <= GPT && GPT_BYTE <= (BYTEPOS) ? GPT_BYTE : BEGV_BYTE)
109 98
110/* Similar macros to operate on a specified buffer.
111 Note that many of these evaluate the buffer argument more than once. */
112
113/* Position of beginning of buffer. */
114#define BUF_BEG(buf) (BEG)
115#define BUF_BEG_BYTE(buf) (BEG_BYTE)
116
117/* The BUF_BEGV[_BYTE], BUF_ZV[_BYTE], and BUF_PT[_BYTE] macros cannot
118 be used for assignment; use SET_BUF_* macros below for that. */
119
120/* Position of beginning of accessible range of buffer. */
121#define BUF_BEGV(buf) \
122 (buf == current_buffer ? BEGV \
123 : NILP (BVAR (buf, begv_marker)) ? buf->begv \
124 : marker_position (BVAR (buf, begv_marker)))
125
126#define BUF_BEGV_BYTE(buf) \
127 (buf == current_buffer ? BEGV_BYTE \
128 : NILP (BVAR (buf, begv_marker)) ? buf->begv_byte \
129 : marker_byte_position (BVAR (buf, begv_marker)))
130
131/* Position of point in buffer. */
132#define BUF_PT(buf) \
133 (buf == current_buffer ? PT \
134 : NILP (BVAR (buf, pt_marker)) ? buf->pt \
135 : marker_position (BVAR (buf, pt_marker)))
136
137#define BUF_PT_BYTE(buf) \
138 (buf == current_buffer ? PT_BYTE \
139 : NILP (BVAR (buf, pt_marker)) ? buf->pt_byte \
140 : marker_byte_position (BVAR (buf, pt_marker)))
141
142/* Position of end of accessible range of buffer. */
143#define BUF_ZV(buf) \
144 (buf == current_buffer ? ZV \
145 : NILP (BVAR (buf, zv_marker)) ? buf->zv \
146 : marker_position (BVAR (buf, zv_marker)))
147
148#define BUF_ZV_BYTE(buf) \
149 (buf == current_buffer ? ZV_BYTE \
150 : NILP (BVAR (buf, zv_marker)) ? buf->zv_byte \
151 : marker_byte_position (BVAR (buf, zv_marker)))
152 99
153/* Position of gap in buffer. */ 100/* Position of gap in buffer. */
154#define BUF_GPT(buf) ((buf)->text->gpt) 101#define BUF_GPT(buf) ((buf)->text->gpt)
@@ -161,15 +108,6 @@ INLINE_HEADER_BEGIN
161/* Address of beginning of buffer. */ 108/* Address of beginning of buffer. */
162#define BUF_BEG_ADDR(buf) ((buf)->text->beg) 109#define BUF_BEG_ADDR(buf) ((buf)->text->beg)
163 110
164/* Address of beginning of gap of buffer. */
165#define BUF_GPT_ADDR(buf) ((buf)->text->beg + (buf)->text->gpt_byte - BEG_BYTE)
166
167/* Address of end of buffer. */
168#define BUF_Z_ADDR(buf) ((buf)->text->beg + (buf)->text->gap_size + (buf)->text->z_byte - BEG_BYTE)
169
170/* Address of end of gap in buffer. */
171#define BUF_GAP_END_ADDR(buf) ((buf)->text->beg + (buf)->text->gpt_byte + (buf)->text->gap_size - BEG_BYTE)
172
173/* Size of gap. */ 111/* Size of gap. */
174#define BUF_GAP_SIZE(buf) ((buf)->text->gap_size) 112#define BUF_GAP_SIZE(buf) ((buf)->text->gap_size)
175 113
@@ -209,43 +147,8 @@ INLINE_HEADER_BEGIN
209 BUF_OVERLAY_UNCHANGED_MODIFIED (current_buffer) 147 BUF_OVERLAY_UNCHANGED_MODIFIED (current_buffer)
210#define BEG_UNCHANGED BUF_BEG_UNCHANGED (current_buffer) 148#define BEG_UNCHANGED BUF_BEG_UNCHANGED (current_buffer)
211#define END_UNCHANGED BUF_END_UNCHANGED (current_buffer) 149#define END_UNCHANGED BUF_END_UNCHANGED (current_buffer)
212
213/* Compute how many characters at the top and bottom of BUF are
214 unchanged when the range START..END is modified. This computation
215 must be done each time BUF is modified. */
216
217#define BUF_COMPUTE_UNCHANGED(buf, start, end) \
218 do \
219 { \
220 if (BUF_UNCHANGED_MODIFIED (buf) == BUF_MODIFF (buf) \
221 && (BUF_OVERLAY_UNCHANGED_MODIFIED (buf) \
222 == BUF_OVERLAY_MODIFF (buf))) \
223 { \
224 BUF_BEG_UNCHANGED (buf) = (start) - BUF_BEG (buf); \
225 BUF_END_UNCHANGED (buf) = BUF_Z (buf) - (end); \
226 } \
227 else \
228 { \
229 if (BUF_Z (buf) - (end) < BUF_END_UNCHANGED (buf)) \
230 BUF_END_UNCHANGED (buf) = BUF_Z (buf) - (end); \
231 if ((start) - BUF_BEG (buf) < BUF_BEG_UNCHANGED (buf)) \
232 BUF_BEG_UNCHANGED (buf) = (start) - BUF_BEG (buf); \
233 } \
234 } \
235 while (false)
236
237 150
238/* Macros to set PT in the current buffer, or another buffer. */ 151/* Functions to set PT in the current buffer, or another buffer. */
239
240#define SET_PT(position) (set_point (position))
241#define TEMP_SET_PT(position) (temp_set_point (current_buffer, (position)))
242
243#define SET_PT_BOTH(position, byte) (set_point_both (position, byte))
244#define TEMP_SET_PT_BOTH(position, byte) \
245 (temp_set_point_both (current_buffer, (position), (byte)))
246
247#define BUF_TEMP_SET_PT(buffer, position) \
248 (temp_set_point ((buffer), (position)))
249 152
250extern void set_point (ptrdiff_t); 153extern void set_point (ptrdiff_t);
251extern void temp_set_point (struct buffer *, ptrdiff_t); 154extern void temp_set_point (struct buffer *, ptrdiff_t);
@@ -255,39 +158,32 @@ extern void temp_set_point_both (struct buffer *,
255extern void set_point_from_marker (Lisp_Object); 158extern void set_point_from_marker (Lisp_Object);
256extern void enlarge_buffer_text (struct buffer *, ptrdiff_t); 159extern void enlarge_buffer_text (struct buffer *, ptrdiff_t);
257 160
161INLINE void
162SET_PT (ptrdiff_t position)
163{
164 set_point (position);
165}
166INLINE void
167TEMP_SET_PT (ptrdiff_t position)
168{
169 temp_set_point (current_buffer, position);
170}
171INLINE void
172SET_PT_BOTH (ptrdiff_t position, ptrdiff_t byte)
173{
174 set_point_both (position, byte);
175}
176INLINE void
177TEMP_SET_PT_BOTH (ptrdiff_t position, ptrdiff_t byte)
178{
179 temp_set_point_both (current_buffer, position, byte);
180}
181INLINE void
182BUF_TEMP_SET_PT (struct buffer *buffer, ptrdiff_t position)
183{
184 temp_set_point (buffer, position);
185}
258 186
259/* Macros for setting the BEGV, ZV or PT of a given buffer.
260
261 The ..._BOTH macros take both a charpos and a bytepos,
262 which must correspond to each other.
263
264 The macros without ..._BOTH take just a charpos,
265 and compute the bytepos from it. */
266
267#define SET_BUF_BEGV(buf, charpos) \
268 ((buf)->begv_byte = buf_charpos_to_bytepos ((buf), (charpos)), \
269 (buf)->begv = (charpos))
270
271#define SET_BUF_ZV(buf, charpos) \
272 ((buf)->zv_byte = buf_charpos_to_bytepos ((buf), (charpos)), \
273 (buf)->zv = (charpos))
274
275#define SET_BUF_BEGV_BOTH(buf, charpos, byte) \
276 ((buf)->begv = (charpos), \
277 (buf)->begv_byte = (byte))
278
279#define SET_BUF_ZV_BOTH(buf, charpos, byte) \
280 ((buf)->zv = (charpos), \
281 (buf)->zv_byte = (byte))
282
283#define SET_BUF_PT_BOTH(buf, charpos, byte) \
284 ((buf)->pt = (charpos), \
285 (buf)->pt_byte = (byte))
286
287/* Macros to access a character or byte in the current buffer,
288 or convert between a byte position and an address.
289 These macros do not check that the position is in range. */
290
291/* Maximum number of bytes in a buffer. 187/* Maximum number of bytes in a buffer.
292 A buffer cannot contain more bytes than a 1-origin fixnum can represent, 188 A buffer cannot contain more bytes than a 1-origin fixnum can represent,
293 nor can it be so large that C pointer arithmetic stops working. 189 nor can it be so large that C pointer arithmetic stops working.
@@ -298,115 +194,21 @@ extern void enlarge_buffer_text (struct buffer *, ptrdiff_t);
298/* Maximum gap size after compact_buffer, in bytes. Also 194/* Maximum gap size after compact_buffer, in bytes. Also
299 used in make_gap_larger to get some extra reserved space. */ 195 used in make_gap_larger to get some extra reserved space. */
300 196
301#define GAP_BYTES_DFL 2000 197enum { GAP_BYTES_DFL = 2000 };
302 198
303/* Minimum gap size after compact_buffer, in bytes. Also 199/* Minimum gap size after compact_buffer, in bytes. Also
304 used in make_gap_smaller to avoid too small gap size. */ 200 used in make_gap_smaller to avoid too small gap size. */
305 201
306#define GAP_BYTES_MIN 20 202enum { GAP_BYTES_MIN = 20 };
307
308/* Return the address of byte position N in current buffer. */
309
310#define BYTE_POS_ADDR(n) \
311 (((n) >= GPT_BYTE ? GAP_SIZE : 0) + (n) + BEG_ADDR - BEG_BYTE)
312
313/* Return the address of char position N. */
314
315#define CHAR_POS_ADDR(n) \
316 (((n) >= GPT ? GAP_SIZE : 0) \
317 + buf_charpos_to_bytepos (current_buffer, n) \
318 + BEG_ADDR - BEG_BYTE)
319
320/* Convert a character position to a byte position. */
321
322#define CHAR_TO_BYTE(charpos) \
323 (buf_charpos_to_bytepos (current_buffer, charpos))
324
325/* Convert a byte position to a character position. */
326
327#define BYTE_TO_CHAR(bytepos) \
328 (buf_bytepos_to_charpos (current_buffer, bytepos))
329 203
330/* For those very rare cases where you may have a "random" pointer into 204/* For those very rare cases where you may have a "random" pointer into
331 the middle of a multibyte char, this moves to the next boundary. */ 205 the middle of a multibyte char, this moves to the next boundary. */
332extern ptrdiff_t advance_to_char_boundary (ptrdiff_t byte_pos); 206extern ptrdiff_t advance_to_char_boundary (ptrdiff_t byte_pos);
333 207
334/* Convert PTR, the address of a byte in the buffer, into a byte position. */ 208/* Return the byte at byte position N.
335 209 Do not check that the position is in range. */
336#define PTR_BYTE_POS(ptr) \
337 ((ptr) - (current_buffer)->text->beg \
338 - (ptr - (current_buffer)->text->beg <= GPT_BYTE - BEG_BYTE ? 0 : GAP_SIZE) \
339 + BEG_BYTE)
340
341/* Return character at byte position POS. See the caveat WARNING for
342 FETCH_MULTIBYTE_CHAR below. */
343
344#define FETCH_CHAR(pos) \
345 (!NILP (BVAR (current_buffer, enable_multibyte_characters)) \
346 ? FETCH_MULTIBYTE_CHAR ((pos)) \
347 : FETCH_BYTE ((pos)))
348
349/* Return the byte at byte position N. */
350 210
351#define FETCH_BYTE(n) *(BYTE_POS_ADDR ((n))) 211#define FETCH_BYTE(n) *(BYTE_POS_ADDR ((n)))
352
353/* Return character at byte position POS. If the current buffer is unibyte
354 and the character is not ASCII, make the returning character
355 multibyte. */
356
357#define FETCH_CHAR_AS_MULTIBYTE(pos) \
358 (!NILP (BVAR (current_buffer, enable_multibyte_characters)) \
359 ? FETCH_MULTIBYTE_CHAR ((pos)) \
360 : UNIBYTE_TO_CHAR (FETCH_BYTE ((pos))))
361
362
363/* Macros for accessing a character or byte,
364 or converting between byte positions and addresses,
365 in a specified buffer. */
366
367/* Return the address of character at byte position POS in buffer BUF.
368 Note that both arguments can be computed more than once. */
369
370#define BUF_BYTE_ADDRESS(buf, pos) \
371 ((buf)->text->beg + (pos) - BEG_BYTE \
372 + ((pos) >= (buf)->text->gpt_byte ? (buf)->text->gap_size : 0))
373
374/* Return the address of character at char position POS in buffer BUF.
375 Note that both arguments can be computed more than once. */
376
377#define BUF_CHAR_ADDRESS(buf, pos) \
378 ((buf)->text->beg + buf_charpos_to_bytepos ((buf), (pos)) - BEG_BYTE \
379 + ((pos) >= (buf)->text->gpt ? (buf)->text->gap_size : 0))
380
381/* Convert PTR, the address of a char in buffer BUF,
382 into a character position. */
383
384#define BUF_PTR_BYTE_POS(buf, ptr) \
385 ((ptr) - (buf)->text->beg \
386 - (ptr - (buf)->text->beg <= BUF_GPT_BYTE (buf) - BEG_BYTE \
387 ? 0 : BUF_GAP_SIZE ((buf))) \
388 + BEG_BYTE)
389
390/* Return the character at byte position POS in buffer BUF. */
391
392#define BUF_FETCH_CHAR(buf, pos) \
393 (!NILP (buf->enable_multibyte_characters) \
394 ? BUF_FETCH_MULTIBYTE_CHAR ((buf), (pos)) \
395 : BUF_FETCH_BYTE ((buf), (pos)))
396
397/* Return character at byte position POS in buffer BUF. If BUF is
398 unibyte and the character is not ASCII, make the returning
399 character multibyte. */
400
401#define BUF_FETCH_CHAR_AS_MULTIBYTE(buf, pos) \
402 (! NILP (BVAR ((buf), enable_multibyte_characters)) \
403 ? BUF_FETCH_MULTIBYTE_CHAR ((buf), (pos)) \
404 : UNIBYTE_TO_CHAR (BUF_FETCH_BYTE ((buf), (pos))))
405
406/* Return the byte at byte position N in buffer BUF. */
407
408#define BUF_FETCH_BYTE(buf, n) \
409 *(BUF_BYTE_ADDRESS ((buf), (n)))
410 212
411/* Define the actual buffer data structures. */ 213/* Define the actual buffer data structures. */
412 214
@@ -482,6 +284,13 @@ struct buffer_text
482 284
483#define BVAR(buf, field) ((buf)->field ## _) 285#define BVAR(buf, field) ((buf)->field ## _)
484 286
287/* Max number of builtin per-buffer variables. */
288enum { MAX_PER_BUFFER_VARS = 50 };
289
290/* Special values for struct buffer.modtime. */
291enum { NONEXISTENT_MODTIME_NSECS = -1 };
292enum { UNKNOWN_MODTIME_NSECS = -2 };
293
485/* This is the structure that the buffer Lisp object points to. */ 294/* This is the structure that the buffer Lisp object points to. */
486 295
487struct buffer 296struct buffer
@@ -796,7 +605,6 @@ struct buffer
796 for a buffer-local variable is stored in that variable's slot 605 for a buffer-local variable is stored in that variable's slot
797 in buffer_local_flags as a Lisp integer. If the index is -1, 606 in buffer_local_flags as a Lisp integer. If the index is -1,
798 this means the variable is always local in all buffers. */ 607 this means the variable is always local in all buffers. */
799#define MAX_PER_BUFFER_VARS 50
800 char local_flags[MAX_PER_BUFFER_VARS]; 608 char local_flags[MAX_PER_BUFFER_VARS];
801 609
802 /* Set to the modtime of the visited file when read or written. 610 /* Set to the modtime of the visited file when read or written.
@@ -804,8 +612,6 @@ struct buffer
804 visited file was nonexistent. modtime.tv_nsec == 612 visited file was nonexistent. modtime.tv_nsec ==
805 UNKNOWN_MODTIME_NSECS means visited file modtime unknown; 613 UNKNOWN_MODTIME_NSECS means visited file modtime unknown;
806 in no case complain about any mismatch on next save attempt. */ 614 in no case complain about any mismatch on next save attempt. */
807#define NONEXISTENT_MODTIME_NSECS (-1)
808#define UNKNOWN_MODTIME_NSECS (-2)
809 struct timespec modtime; 615 struct timespec modtime;
810 616
811 /* Size of the file when modtime was set. This is used to detect the 617 /* Size of the file when modtime was set. This is used to detect the
@@ -1018,49 +824,281 @@ bset_width_table (struct buffer *b, Lisp_Object val)
1018 b->width_table_ = val; 824 b->width_table_ = val;
1019} 825}
1020 826
827/* BUFFER_CEILING_OF (resp. BUFFER_FLOOR_OF), when applied to n, return
828 the max (resp. min) p such that
829
830 BYTE_POS_ADDR (p) - BYTE_POS_ADDR (n) == p - n */
831
832INLINE ptrdiff_t
833BUFFER_CEILING_OF (ptrdiff_t bytepos)
834{
835 return (bytepos < GPT_BYTE && GPT < ZV ? GPT_BYTE : ZV_BYTE) - 1;
836}
837
838INLINE ptrdiff_t
839BUFFER_FLOOR_OF (ptrdiff_t bytepos)
840{
841 return BEGV <= GPT && GPT_BYTE <= bytepos ? GPT_BYTE : BEGV_BYTE;
842}
843
844/* The BUF_BEGV[_BYTE], BUF_ZV[_BYTE], and BUF_PT[_BYTE] functions cannot
845 be used for assignment; use SET_BUF_* functions below for that. */
846
847/* Position of beginning of accessible range of buffer. */
848INLINE ptrdiff_t
849BUF_BEGV (struct buffer *buf)
850{
851 return (buf == current_buffer ? BEGV
852 : NILP (BVAR (buf, begv_marker)) ? buf->begv
853 : marker_position (BVAR (buf, begv_marker)));
854}
855
856INLINE ptrdiff_t
857BUF_BEGV_BYTE (struct buffer *buf)
858{
859 return (buf == current_buffer ? BEGV_BYTE
860 : NILP (BVAR (buf, begv_marker)) ? buf->begv_byte
861 : marker_byte_position (BVAR (buf, begv_marker)));
862}
863
864/* Position of point in buffer. */
865INLINE ptrdiff_t
866BUF_PT (struct buffer *buf)
867{
868 return (buf == current_buffer ? PT
869 : NILP (BVAR (buf, pt_marker)) ? buf->pt
870 : marker_position (BVAR (buf, pt_marker)));
871}
872
873INLINE ptrdiff_t
874BUF_PT_BYTE (struct buffer *buf)
875{
876 return (buf == current_buffer ? PT_BYTE
877 : NILP (BVAR (buf, pt_marker)) ? buf->pt_byte
878 : marker_byte_position (BVAR (buf, pt_marker)));
879}
880
881/* Position of end of accessible range of buffer. */
882INLINE ptrdiff_t
883BUF_ZV (struct buffer *buf)
884{
885 return (buf == current_buffer ? ZV
886 : NILP (BVAR (buf, zv_marker)) ? buf->zv
887 : marker_position (BVAR (buf, zv_marker)));
888}
889
890INLINE ptrdiff_t
891BUF_ZV_BYTE (struct buffer *buf)
892{
893 return (buf == current_buffer ? ZV_BYTE
894 : NILP (BVAR (buf, zv_marker)) ? buf->zv_byte
895 : marker_byte_position (BVAR (buf, zv_marker)));
896}
897
898/* Similar functions to operate on a specified buffer. */
899
900/* Position of beginning of buffer. */
901INLINE ptrdiff_t
902BUF_BEG (struct buffer *buf)
903{
904 return BEG;
905}
906
907INLINE ptrdiff_t
908BUF_BEG_BYTE (struct buffer *buf)
909{
910 return BEG_BYTE;
911}
912
913/* Address of beginning of gap of buffer. */
914INLINE unsigned char *
915BUF_GPT_ADDR (struct buffer *buf)
916{
917 return buf->text->beg + buf->text->gpt_byte - BEG_BYTE;
918}
919
920/* Address of end of buffer. */
921INLINE unsigned char *
922BUF_Z_ADDR (struct buffer *buf)
923{
924 return buf->text->beg + buf->text->gap_size + buf->text->z_byte - BEG_BYTE;
925}
926
927/* Address of end of gap in buffer. */
928INLINE unsigned char *
929BUF_GAP_END_ADDR (struct buffer *buf)
930{
931 return buf->text->beg + buf->text->gpt_byte + buf->text->gap_size - BEG_BYTE;
932}
933
934/* Compute how many characters at the top and bottom of BUF are
935 unchanged when the range START..END is modified. This computation
936 must be done each time BUF is modified. */
937
938INLINE void
939BUF_COMPUTE_UNCHANGED (struct buffer *buf, ptrdiff_t start, ptrdiff_t end)
940{
941 if (BUF_UNCHANGED_MODIFIED (buf) == BUF_MODIFF (buf)
942 && (BUF_OVERLAY_UNCHANGED_MODIFIED (buf)
943 == BUF_OVERLAY_MODIFF (buf)))
944 {
945 buf->text->beg_unchanged = start - BUF_BEG (buf);
946 buf->text->end_unchanged = BUF_Z (buf) - (end);
947 }
948 else
949 {
950 if (BUF_Z (buf) - end < BUF_END_UNCHANGED (buf))
951 buf->text->end_unchanged = BUF_Z (buf) - end;
952 if (start - BUF_BEG (buf) < BUF_BEG_UNCHANGED (buf))
953 buf->text->beg_unchanged = start - BUF_BEG (buf);
954 }
955}
956
957/* Functions for setting the BEGV, ZV or PT of a given buffer.
958
959 The ..._BOTH functions take both a charpos and a bytepos,
960 which must correspond to each other.
961
962 The functions without ..._BOTH take just a charpos,
963 and compute the bytepos from it. */
964
965INLINE void
966SET_BUF_BEGV (struct buffer *buf, ptrdiff_t charpos)
967{
968 buf->begv_byte = buf_charpos_to_bytepos (buf, charpos);
969 buf->begv = charpos;
970}
971
972INLINE void
973SET_BUF_ZV (struct buffer *buf, ptrdiff_t charpos)
974{
975 buf->zv_byte = buf_charpos_to_bytepos (buf, charpos);
976 buf->zv = charpos;
977}
978
979INLINE void
980SET_BUF_BEGV_BOTH (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t byte)
981{
982 buf->begv = charpos;
983 buf->begv_byte = byte;
984}
985
986INLINE void
987SET_BUF_ZV_BOTH (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t byte)
988{
989 buf->zv = charpos;
990 buf->zv_byte = byte;
991}
992
993INLINE void
994SET_BUF_PT_BOTH (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t byte)
995{
996 buf->pt = charpos;
997 buf->pt_byte = byte;
998}
999
1000/* Functions to access a character or byte in the current buffer,
1001 or convert between a byte position and an address.
1002 These functions do not check that the position is in range. */
1003
1004/* Return the address of byte position N in current buffer. */
1005
1006INLINE unsigned char *
1007BYTE_POS_ADDR (ptrdiff_t n)
1008{
1009 return (n < GPT_BYTE ? 0 : GAP_SIZE) + n + BEG_ADDR - BEG_BYTE;
1010}
1011
1012/* Return the address of char position N. */
1013
1014INLINE unsigned char *
1015CHAR_POS_ADDR (ptrdiff_t n)
1016{
1017 return ((n < GPT ? 0 : GAP_SIZE)
1018 + buf_charpos_to_bytepos (current_buffer, n)
1019 + BEG_ADDR - BEG_BYTE);
1020}
1021
1022/* Convert a character position to a byte position. */
1023
1024INLINE ptrdiff_t
1025CHAR_TO_BYTE (ptrdiff_t charpos)
1026{
1027 return buf_charpos_to_bytepos (current_buffer, charpos);
1028}
1029
1030/* Convert a byte position to a character position. */
1031
1032INLINE ptrdiff_t
1033BYTE_TO_CHAR (ptrdiff_t bytepos)
1034{
1035 return buf_bytepos_to_charpos (current_buffer, bytepos);
1036}
1037
1038/* Convert PTR, the address of a byte in the buffer, into a byte position. */
1039
1040INLINE ptrdiff_t
1041PTR_BYTE_POS (unsigned char const *ptr)
1042{
1043 ptrdiff_t byte = ptr - current_buffer->text->beg;
1044 return byte - (byte <= GPT_BYTE - BEG_BYTE ? 0 : GAP_SIZE) + BEG_BYTE;
1045}
1046
1021/* Number of Lisp_Objects at the beginning of struct buffer. 1047/* Number of Lisp_Objects at the beginning of struct buffer.
1022 If you add, remove, or reorder Lisp_Objects within buffer 1048 If you add, remove, or reorder Lisp_Objects within buffer
1023 structure, make sure that this is still correct. */ 1049 structure, make sure that this is still correct. */
1024 1050
1025#define BUFFER_LISP_SIZE \ 1051enum { BUFFER_LISP_SIZE = PSEUDOVECSIZE (struct buffer,
1026 PSEUDOVECSIZE (struct buffer, cursor_in_non_selected_windows_) 1052 cursor_in_non_selected_windows_) };
1027 1053
1028/* Allocated size of the struct buffer part beyond leading 1054/* Allocated size of the struct buffer part beyond leading
1029 Lisp_Objects, in word_size units. */ 1055 Lisp_Objects, in word_size units. */
1030 1056
1031#define BUFFER_REST_SIZE (VECSIZE (struct buffer) - BUFFER_LISP_SIZE) 1057enum { BUFFER_REST_SIZE = VECSIZE (struct buffer) - BUFFER_LISP_SIZE };
1032 1058
1033/* Initialize the pseudovector header of buffer object. BUFFER_LISP_SIZE 1059/* Initialize the pseudovector header of buffer object. BUFFER_LISP_SIZE
1034 is required for GC, but BUFFER_REST_SIZE is set up just to be consistent 1060 is required for GC, but BUFFER_REST_SIZE is set up just to be consistent
1035 with other pseudovectors. */ 1061 with other pseudovectors. */
1036 1062
1037#define BUFFER_PVEC_INIT(b) \ 1063INLINE void
1038 XSETPVECTYPESIZE (b, PVEC_BUFFER, BUFFER_LISP_SIZE, BUFFER_REST_SIZE) 1064BUFFER_PVEC_INIT (struct buffer *b)
1065{
1066 XSETPVECTYPESIZE (b, PVEC_BUFFER, BUFFER_LISP_SIZE, BUFFER_REST_SIZE);
1067}
1039 1068
1040/* Convenient check whether buffer B is live. */ 1069/* Convenient check whether buffer B is live. */
1041 1070
1042#define BUFFER_LIVE_P(b) (!NILP (BVAR (b, name))) 1071INLINE bool
1072BUFFER_LIVE_P (struct buffer *b)
1073{
1074 return !NILP (BVAR (b, name));
1075}
1043 1076
1044/* Convenient check whether buffer B is hidden (i.e. its name 1077/* Convenient check whether buffer B is hidden (i.e. its name
1045 starts with a space). Caller must ensure that B is live. */ 1078 starts with a space). Caller must ensure that B is live. */
1046 1079
1047#define BUFFER_HIDDEN_P(b) (SREF (BVAR (b, name), 0) == ' ') 1080INLINE bool
1081BUFFER_HIDDEN_P (struct buffer *b)
1082{
1083 return SREF (BVAR (b, name), 0) == ' ';
1084}
1048 1085
1049/* Verify indirection counters. */ 1086/* Verify indirection counters. */
1050 1087
1051#define BUFFER_CHECK_INDIRECTION(b) \ 1088INLINE void
1052 do { \ 1089BUFFER_CHECK_INDIRECTION (struct buffer *b)
1053 if (BUFFER_LIVE_P (b)) \ 1090{
1054 { \ 1091 if (BUFFER_LIVE_P (b))
1055 if (b->base_buffer) \ 1092 {
1056 { \ 1093 if (b->base_buffer)
1057 eassert (b->indirections == -1); \ 1094 {
1058 eassert (b->base_buffer->indirections > 0); \ 1095 eassert (b->indirections == -1);
1059 } \ 1096 eassert (b->base_buffer->indirections > 0);
1060 else \ 1097 }
1061 eassert (b->indirections >= 0); \ 1098 else
1062 } \ 1099 eassert (b->indirections >= 0);
1063 } while (false) 1100 }
1101}
1064 1102
1065/* Chain of all buffers, including killed ones. */ 1103/* Chain of all buffers, including killed ones. */
1066 1104
@@ -1157,7 +1195,9 @@ record_unwind_current_buffer (void)
1157 1195
1158/* Get overlays at POSN into array OVERLAYS with NOVERLAYS elements. 1196/* Get overlays at POSN into array OVERLAYS with NOVERLAYS elements.
1159 If NEXTP is non-NULL, return next overlay there. 1197 If NEXTP is non-NULL, return next overlay there.
1160 See overlay_at arg CHANGE_REQ for meaning of CHRQ arg. */ 1198 See overlay_at arg CHANGE_REQ for meaning of CHRQ arg.
1199 This macro might evaluate its args multiple times,
1200 and it treat some args as lvalues. */
1161 1201
1162#define GET_OVERLAYS_AT(posn, overlays, noverlays, nextp, chrq) \ 1202#define GET_OVERLAYS_AT(posn, overlays, noverlays, nextp, chrq) \
1163 do { \ 1203 do { \
@@ -1207,6 +1247,10 @@ buffer_has_overlays (void)
1207{ 1247{
1208 return current_buffer->overlays_before || current_buffer->overlays_after; 1248 return current_buffer->overlays_before || current_buffer->overlays_after;
1209} 1249}
1250
1251/* Functions for accessing a character or byte,
1252 or converting between byte positions and addresses,
1253 in a specified buffer. */
1210 1254
1211/* Return character code of multi-byte form at byte position POS. If POS 1255/* Return character code of multi-byte form at byte position POS. If POS
1212 doesn't point the head of valid multi-byte form, only the byte at 1256 doesn't point the head of valid multi-byte form, only the byte at
@@ -1232,6 +1276,80 @@ BUF_FETCH_MULTIBYTE_CHAR (struct buffer *buf, ptrdiff_t pos)
1232 return STRING_CHAR (p); 1276 return STRING_CHAR (p);
1233} 1277}
1234 1278
1279/* Return character at byte position POS.
1280 If the current buffer is unibyte and the character is not ASCII,
1281 make the returning character multibyte. */
1282
1283INLINE int
1284FETCH_CHAR_AS_MULTIBYTE (ptrdiff_t pos)
1285{
1286 return (!NILP (BVAR (current_buffer, enable_multibyte_characters))
1287 ? FETCH_MULTIBYTE_CHAR (pos)
1288 : UNIBYTE_TO_CHAR (FETCH_BYTE (pos)));
1289}
1290
1291/* Return character at byte position POS.
1292 See the caveat WARNING for FETCH_MULTIBYTE_CHAR above. */
1293
1294INLINE int
1295FETCH_CHAR (ptrdiff_t pos)
1296{
1297 return (!NILP (BVAR (current_buffer, enable_multibyte_characters))
1298 ? FETCH_MULTIBYTE_CHAR (pos)
1299 : FETCH_BYTE (pos));
1300}
1301
1302/* Return the address of character at byte position POS in buffer BUF.
1303 Note that both arguments can be computed more than once. */
1304
1305INLINE unsigned char *
1306BUF_BYTE_ADDRESS (struct buffer *buf, ptrdiff_t pos)
1307{
1308 return (buf->text->beg + pos - BEG_BYTE
1309 + (pos < buf->text->gpt_byte ? 0 : buf->text->gap_size));
1310}
1311
1312/* Return the address of character at char position POS in buffer BUF.
1313 Note that both arguments can be computed more than once. */
1314
1315INLINE unsigned char *
1316BUF_CHAR_ADDRESS (struct buffer *buf, ptrdiff_t pos)
1317{
1318 return (buf->text->beg + buf_charpos_to_bytepos (buf, pos) - BEG_BYTE
1319 + (pos < buf->text->gpt ? 0 : buf->text->gap_size));
1320}
1321
1322/* Convert PTR, the address of a char in buffer BUF,
1323 into a character position. */
1324
1325INLINE ptrdiff_t
1326BUF_PTR_BYTE_POS (struct buffer *buf, unsigned char *ptr)
1327{
1328 ptrdiff_t byte = ptr - buf->text->beg;
1329 return (byte - (byte <= BUF_GPT_BYTE (buf) - BEG_BYTE ? 0 : BUF_GAP_SIZE (buf))
1330 + BEG_BYTE);
1331}
1332
1333/* Return the byte at byte position N in buffer BUF. */
1334
1335INLINE unsigned char
1336BUF_FETCH_BYTE (struct buffer *buf, ptrdiff_t n)
1337{
1338 return *BUF_BYTE_ADDRESS (buf, n);
1339}
1340
1341/* Return character at byte position POS in buffer BUF. If BUF is
1342 unibyte and the character is not ASCII, make the returning
1343 character multibyte. */
1344
1345INLINE int
1346BUF_FETCH_CHAR_AS_MULTIBYTE (struct buffer *buf, ptrdiff_t pos)
1347{
1348 return (! NILP (BVAR (buf, enable_multibyte_characters))
1349 ? BUF_FETCH_MULTIBYTE_CHAR (buf, pos)
1350 : UNIBYTE_TO_CHAR (BUF_FETCH_BYTE (buf, pos)));
1351}
1352
1235/* Return number of windows showing B. */ 1353/* Return number of windows showing B. */
1236 1354
1237INLINE int 1355INLINE int
@@ -1260,18 +1378,17 @@ buffer_window_count (struct buffer *b)
1260/* Return the actual buffer position for the marker P. 1378/* Return the actual buffer position for the marker P.
1261 We assume you know which buffer it's pointing into. */ 1379 We assume you know which buffer it's pointing into. */
1262 1380
1263#define OVERLAY_POSITION(P) \ 1381INLINE ptrdiff_t
1264 (MARKERP (P) ? marker_position (P) : (emacs_abort (), 0)) 1382OVERLAY_POSITION (Lisp_Object p)
1383{
1384 return marker_position (p);
1385}
1265 1386
1266 1387
1267/*********************************************************************** 1388/***********************************************************************
1268 Buffer-local Variables 1389 Buffer-local Variables
1269 ***********************************************************************/ 1390 ***********************************************************************/
1270 1391
1271/* Number of per-buffer variables used. */
1272
1273extern int last_per_buffer_idx;
1274
1275/* Return the offset in bytes of member VAR of struct buffer 1392/* Return the offset in bytes of member VAR of struct buffer
1276 from the start of a buffer structure. */ 1393 from the start of a buffer structure. */
1277 1394
@@ -1296,23 +1413,27 @@ extern int last_per_buffer_idx;
1296#define PER_BUFFER_VAR_IDX(VAR) \ 1413#define PER_BUFFER_VAR_IDX(VAR) \
1297 PER_BUFFER_IDX (PER_BUFFER_VAR_OFFSET (VAR)) 1414 PER_BUFFER_IDX (PER_BUFFER_VAR_OFFSET (VAR))
1298 1415
1416extern bool valid_per_buffer_idx (int);
1417
1299/* Value is true if the variable with index IDX has a local value 1418/* Value is true if the variable with index IDX has a local value
1300 in buffer B. */ 1419 in buffer B. */
1301 1420
1302#define PER_BUFFER_VALUE_P(B, IDX) \ 1421INLINE bool
1303 (((IDX) < 0 || IDX >= last_per_buffer_idx) \ 1422PER_BUFFER_VALUE_P (struct buffer *b, int idx)
1304 ? (emacs_abort (), false) \ 1423{
1305 : ((B)->local_flags[IDX] != 0)) 1424 eassert (valid_per_buffer_idx (idx));
1425 return b->local_flags[idx];
1426}
1306 1427
1307/* Set whether per-buffer variable with index IDX has a buffer-local 1428/* Set whether per-buffer variable with index IDX has a buffer-local
1308 value in buffer B. VAL zero means it hasn't. */ 1429 value in buffer B. VAL zero means it hasn't. */
1309 1430
1310#define SET_PER_BUFFER_VALUE_P(B, IDX, VAL) \ 1431INLINE void
1311 do { \ 1432SET_PER_BUFFER_VALUE_P (struct buffer *b, int idx, bool val)
1312 if ((IDX) < 0 || (IDX) >= last_per_buffer_idx) \ 1433{
1313 emacs_abort (); \ 1434 eassert (valid_per_buffer_idx (idx));
1314 (B)->local_flags[IDX] = (VAL); \ 1435 b->local_flags[idx] = val;
1315 } while (false) 1436}
1316 1437
1317/* Return the index value of the per-buffer variable at offset OFFSET 1438/* Return the index value of the per-buffer variable at offset OFFSET
1318 in the buffer structure. 1439 in the buffer structure.
@@ -1332,11 +1453,13 @@ extern int last_per_buffer_idx;
1332 new buffer. 1453 new buffer.
1333 1454
1334 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is 1455 If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
1335 zero, that is a bug */ 1456 zero, that is a bug. */
1336 1457
1337 1458INLINE int
1338#define PER_BUFFER_IDX(OFFSET) \ 1459PER_BUFFER_IDX (ptrdiff_t offset)
1339 XFIXNUM (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_flags)) 1460{
1461 return XFIXNUM (*(Lisp_Object *) (offset + (char *) &buffer_local_flags));
1462}
1340 1463
1341/* Functions to get and set default value of the per-buffer 1464/* Functions to get and set default value of the per-buffer
1342 variable at offset OFFSET in the buffer structure. */ 1465 variable at offset OFFSET in the buffer structure. */
diff --git a/src/coding.c b/src/coding.c
index 2ddd34eb7b6..c0408fbce48 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -9842,7 +9842,10 @@ encode_string_utf_8 (Lisp_Object string, Lisp_Object buffer,
9842 If BUFFER is Qnil, return a multibyte string from the decoded result. 9842 If BUFFER is Qnil, return a multibyte string from the decoded result.
9843 As a special case, return STRING itself in the following cases: 9843 As a special case, return STRING itself in the following cases:
9844 1. STRING contains only ASCII characters. 9844 1. STRING contains only ASCII characters.
9845 2. NOCOPY, and STRING contains only valid UTF-8 sequences. 9845 2. NOCOPY is true, and STRING contains only valid UTF-8 sequences.
9846
9847 For maximum speed, always specify NOCOPY true when STRING is
9848 guaranteed to contain only valid UTF-8 sequences.
9846 9849
9847 HANDLE-8-BIT and HANDLE-OVER-UNI specify how to handle a invalid 9850 HANDLE-8-BIT and HANDLE-OVER-UNI specify how to handle a invalid
9848 byte sequence. The former is for an 1-byte invalid sequence that 9851 byte sequence. The former is for an 1-byte invalid sequence that
diff --git a/src/composite.c b/src/composite.c
index a6606d5fc45..efbd055cef2 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -919,16 +919,17 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos,
919} 919}
920 920
921/* 1 iff the character C is composable. Characters of general 921/* 1 iff the character C is composable. Characters of general
922 category Z? or C? are not composable except for ZWNJ and ZWJ. */ 922 category Z? or C? are not composable except for ZWNJ and ZWJ,
923 and characters of category Zs. */
923 924
924static bool 925static bool
925char_composable_p (int c) 926char_composable_p (int c)
926{ 927{
927 Lisp_Object val; 928 Lisp_Object val;
928 return (c > ' ' 929 return (c >= ' '
929 && (c == ZERO_WIDTH_NON_JOINER || c == ZERO_WIDTH_JOINER 930 && (c == ZERO_WIDTH_NON_JOINER || c == ZERO_WIDTH_JOINER
930 || (val = CHAR_TABLE_REF (Vunicode_category_table, c), 931 || (val = CHAR_TABLE_REF (Vunicode_category_table, c),
931 (FIXNUMP (val) && (XFIXNUM (val) <= UNICODE_CATEGORY_So))))); 932 (FIXNUMP (val) && (XFIXNUM (val) <= UNICODE_CATEGORY_Zs)))));
932} 933}
933 934
934/* Update cmp_it->stop_pos to the next position after CHARPOS (and 935/* Update cmp_it->stop_pos to the next position after CHARPOS (and
diff --git a/src/conf_post.h b/src/conf_post.h
index 4af1ba9331f..43f98620a4b 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -373,8 +373,13 @@ extern int emacs_setenv_TZ (char const *);
373#undef noinline 373#undef noinline
374#endif 374#endif
375 375
376/* Use Gnulib's extern-inline module for extern inline functions. 376/* INLINE marks functions defined in Emacs-internal C headers.
377 An include file foo.h should prepend FOO_INLINE to function 377 INLINE is implemented via C99-style 'extern inline' if Emacs is built
378 with -DEMACS_EXTERN_INLINE; otherwise it is implemented via 'static'.
379 EMACS_EXTERN_INLINE is no longer the default, as 'static' seems to
380 have better performance with GCC.
381
382 An include file foo.h should prepend INLINE to function
378 definitions, with the following overall pattern: 383 definitions, with the following overall pattern:
379 384
380 [#include any other .h files first.] 385 [#include any other .h files first.]
@@ -399,20 +404,40 @@ extern int emacs_setenv_TZ (char const *);
399 For Emacs, this is done by having emacs.c first '#define INLINE 404 For Emacs, this is done by having emacs.c first '#define INLINE
400 EXTERN_INLINE' and then include every .h file that uses INLINE. 405 EXTERN_INLINE' and then include every .h file that uses INLINE.
401 406
402 The INLINE_HEADER_BEGIN and INLINE_HEADER_END suppress bogus 407 The INLINE_HEADER_BEGIN and INLINE_HEADER_END macros suppress bogus
403 warnings in some GCC versions; see ../m4/extern-inline.m4. 408 warnings in some GCC versions; see ../m4/extern-inline.m4. */
409
410#ifdef EMACS_EXTERN_INLINE
411
412/* Use Gnulib's extern-inline module for extern inline functions.
404 413
405 C99 compilers compile functions like 'incr' as C99-style extern 414 C99 compilers compile functions like 'incr' as C99-style extern
406 inline functions. Buggy GCC implementations do something similar with 415 inline functions. Buggy GCC implementations do something similar with
407 GNU-specific keywords. Buggy non-GCC compilers use static 416 GNU-specific keywords. Buggy non-GCC compilers use static
408 functions, which bloats the code but is good enough. */ 417 functions, which bloats the code but is good enough. */
409 418
410#ifndef INLINE 419# ifndef INLINE
411# define INLINE _GL_INLINE 420# define INLINE _GL_INLINE
421# endif
422# define EXTERN_INLINE _GL_EXTERN_INLINE
423# define INLINE_HEADER_BEGIN _GL_INLINE_HEADER_BEGIN
424# define INLINE_HEADER_END _GL_INLINE_HEADER_END
425
426#else
427
428/* Use 'static' instead of 'extern inline' because 'static' typically
429 has better performance for Emacs. Do not use the 'inline' keyword,
430 as modern compilers inline automatically. ATTRIBUTE_UNUSED
431 pacifies gcc -Wunused-function. */
432
433# ifndef INLINE
434# define INLINE EXTERN_INLINE
435# endif
436# define EXTERN_INLINE static ATTRIBUTE_UNUSED
437# define INLINE_HEADER_BEGIN
438# define INLINE_HEADER_END
439
412#endif 440#endif
413#define EXTERN_INLINE _GL_EXTERN_INLINE
414#define INLINE_HEADER_BEGIN _GL_INLINE_HEADER_BEGIN
415#define INLINE_HEADER_END _GL_INLINE_HEADER_END
416 441
417/* 'int x UNINIT;' is equivalent to 'int x;', except it cajoles GCC 442/* 'int x UNINIT;' is equivalent to 'int x;', except it cajoles GCC
418 into not warning incorrectly about use of an uninitialized variable. */ 443 into not warning incorrectly about use of an uninitialized variable. */
diff --git a/src/data.c b/src/data.c
index cf9f8e56133..1d9222e75a7 100644
--- a/src/data.c
+++ b/src/data.c
@@ -525,7 +525,7 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
525 (Lisp_Object object) 525 (Lisp_Object object)
526{ 526{
527 return ((FIXNUMP (object) ? 0 <= XFIXNUM (object) 527 return ((FIXNUMP (object) ? 0 <= XFIXNUM (object)
528 : BIGNUMP (object) && 0 <= mpz_sgn (XBIGNUM (object)->value)) 528 : BIGNUMP (object) && 0 <= mpz_sgn (*xbignum_val (object)))
529 ? Qt : Qnil); 529 ? Qt : Qnil);
530} 530}
531 531
@@ -771,10 +771,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
771 if (AUTOLOADP (function)) 771 if (AUTOLOADP (function))
772 Fput (symbol, Qautoload, XCDR (function)); 772 Fput (symbol, Qautoload, XCDR (function));
773 773
774 /* Convert to eassert or remove after GC bug is found. In the 774 eassert (valid_lisp_object_p (definition));
775 meantime, check unconditionally, at a slight perf hit. */
776 if (! valid_lisp_object_p (definition))
777 emacs_abort ();
778 775
779 set_symbol_function (symbol, definition); 776 set_symbol_function (symbol, definition);
780 777
@@ -2481,7 +2478,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
2481 else if (isnan (f1)) 2478 else if (isnan (f1))
2482 lt = eq = gt = false; 2479 lt = eq = gt = false;
2483 else 2480 else
2484 i2 = mpz_cmp_d (XBIGNUM (num2)->value, f1); 2481 i2 = mpz_cmp_d (*xbignum_val (num2), f1);
2485 } 2482 }
2486 else if (FIXNUMP (num1)) 2483 else if (FIXNUMP (num1))
2487 { 2484 {
@@ -2502,7 +2499,7 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
2502 i2 = XFIXNUM (num2); 2499 i2 = XFIXNUM (num2);
2503 } 2500 }
2504 else 2501 else
2505 i2 = mpz_sgn (XBIGNUM (num2)->value); 2502 i2 = mpz_sgn (*xbignum_val (num2));
2506 } 2503 }
2507 else if (FLOATP (num2)) 2504 else if (FLOATP (num2))
2508 { 2505 {
@@ -2510,12 +2507,12 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
2510 if (isnan (f2)) 2507 if (isnan (f2))
2511 lt = eq = gt = false; 2508 lt = eq = gt = false;
2512 else 2509 else
2513 i1 = mpz_cmp_d (XBIGNUM (num1)->value, f2); 2510 i1 = mpz_cmp_d (*xbignum_val (num1), f2);
2514 } 2511 }
2515 else if (FIXNUMP (num2)) 2512 else if (FIXNUMP (num2))
2516 i1 = mpz_sgn (XBIGNUM (num1)->value); 2513 i1 = mpz_sgn (*xbignum_val (num1));
2517 else 2514 else
2518 i1 = mpz_cmp (XBIGNUM (num1)->value, XBIGNUM (num2)->value); 2515 i1 = mpz_cmp (*xbignum_val (num1), *xbignum_val (num2));
2519 2516
2520 if (eq) 2517 if (eq)
2521 { 2518 {
@@ -3005,7 +3002,7 @@ usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */)
3005 return make_int (-XFIXNUM (a)); 3002 return make_int (-XFIXNUM (a));
3006 if (FLOATP (a)) 3003 if (FLOATP (a))
3007 return make_float (-XFLOAT_DATA (a)); 3004 return make_float (-XFLOAT_DATA (a));
3008 mpz_neg (mpz[0], XBIGNUM (a)->value); 3005 mpz_neg (mpz[0], *xbignum_val (a));
3009 return make_integer_mpz (); 3006 return make_integer_mpz ();
3010 } 3007 }
3011 return arith_driver (Asub, nargs, args, a); 3008 return arith_driver (Asub, nargs, args, a);
@@ -3058,58 +3055,67 @@ usage: (/ NUMBER &rest DIVISORS) */)
3058 return arith_driver (Adiv, nargs, args, a); 3055 return arith_driver (Adiv, nargs, args, a);
3059} 3056}
3060 3057
3061DEFUN ("%", Frem, Srem, 2, 2, 0, 3058/* Return NUM % DEN (or NUM mod DEN, if MODULO). NUM and DEN must be
3062 doc: /* Return remainder of X divided by Y. 3059 integers. */
3063Both must be integers or markers. */) 3060static Lisp_Object
3064 (register Lisp_Object x, Lisp_Object y) 3061integer_remainder (Lisp_Object num, Lisp_Object den, bool modulo)
3065{
3066 CHECK_INTEGER_COERCE_MARKER (x);
3067 CHECK_INTEGER_COERCE_MARKER (y);
3068
3069 /* A bignum can never be 0, so don't check that case. */
3070 if (EQ (y, make_fixnum (0)))
3071 xsignal0 (Qarith_error);
3072
3073 if (FIXNUMP (x) && FIXNUMP (y))
3074 return make_fixnum (XFIXNUM (x) % XFIXNUM (y));
3075 else
3076 {
3077 mpz_tdiv_r (mpz[0],
3078 *bignum_integer (&mpz[0], x),
3079 *bignum_integer (&mpz[1], y));
3080 return make_integer_mpz ();
3081 }
3082}
3083
3084/* Return X mod Y. Both must be integers and Y must be nonzero. */
3085Lisp_Object
3086integer_mod (Lisp_Object x, Lisp_Object y)
3087{ 3062{
3088 if (FIXNUMP (x) && FIXNUMP (y)) 3063 if (FIXNUMP (den))
3089 { 3064 {
3090 EMACS_INT i1 = XFIXNUM (x), i2 = XFIXNUM (y); 3065 EMACS_INT d = XFIXNUM (den);
3066 if (d == 0)
3067 xsignal0 (Qarith_error);
3091 3068
3092 i1 %= i2; 3069 EMACS_INT r;
3070 bool have_r = false;
3071 if (FIXNUMP (num))
3072 {
3073 r = XFIXNUM (num) % d;
3074 have_r = true;
3075 }
3076 else if (eabs (d) <= ULONG_MAX)
3077 {
3078 mpz_t const *n = xbignum_val (num);
3079 bool neg_n = mpz_sgn (*n) < 0;
3080 r = mpz_tdiv_ui (*n, eabs (d));
3081 if (neg_n)
3082 r = -r;
3083 have_r = true;
3084 }
3093 3085
3094 /* If the "remainder" comes out with the wrong sign, fix it. */ 3086 if (have_r)
3095 if (i2 < 0 ? i1 > 0 : i1 < 0) 3087 {
3096 i1 += i2; 3088 /* If MODULO and the remainder has the wrong sign, fix it. */
3089 if (modulo && (d < 0 ? r > 0 : r < 0))
3090 r += d;
3097 3091
3098 return make_fixnum (i1); 3092 return make_fixnum (r);
3093 }
3099 } 3094 }
3100 else
3101 {
3102 mpz_t const *ym = bignum_integer (&mpz[1], y);
3103 bool neg_y = mpz_sgn (*ym) < 0;
3104 mpz_mod (mpz[0], *bignum_integer (&mpz[0], x), *ym);
3105 3095
3106 /* Fix the sign if needed. */ 3096 mpz_t const *d = bignum_integer (&mpz[1], den);
3107 int sgn_r = mpz_sgn (mpz[0]); 3097 mpz_t *r = &mpz[0];
3108 if (neg_y ? sgn_r > 0 : sgn_r < 0) 3098 mpz_tdiv_r (*r, *bignum_integer (&mpz[0], num), *d);
3109 mpz_add (mpz[0], mpz[0], *ym);
3110 3099
3111 return make_integer_mpz (); 3100 if (modulo)
3101 {
3102 /* If the remainder has the wrong sign, fix it. */
3103 int sgn_r = mpz_sgn (*r);
3104 if (mpz_sgn (*d) < 0 ? sgn_r > 0 : sgn_r < 0)
3105 mpz_add (*r, *r, *d);
3112 } 3106 }
3107
3108 return make_integer_mpz ();
3109}
3110
3111DEFUN ("%", Frem, Srem, 2, 2, 0,
3112 doc: /* Return remainder of X divided by Y.
3113Both must be integers or markers. */)
3114 (register Lisp_Object x, Lisp_Object y)
3115{
3116 CHECK_INTEGER_COERCE_MARKER (x);
3117 CHECK_INTEGER_COERCE_MARKER (y);
3118 return integer_remainder (x, y, false);
3113} 3119}
3114 3120
3115DEFUN ("mod", Fmod, Smod, 2, 2, 0, 3121DEFUN ("mod", Fmod, Smod, 2, 2, 0,
@@ -3120,12 +3126,9 @@ Both X and Y must be numbers or markers. */)
3120{ 3126{
3121 CHECK_NUMBER_COERCE_MARKER (x); 3127 CHECK_NUMBER_COERCE_MARKER (x);
3122 CHECK_NUMBER_COERCE_MARKER (y); 3128 CHECK_NUMBER_COERCE_MARKER (y);
3123 3129 if (FLOATP (x) || FLOATP (y))
3124 /* A bignum can never be 0, so don't check that case. */ 3130 return fmod_float (x, y);
3125 if (EQ (y, make_fixnum (0))) 3131 return integer_remainder (x, y, true);
3126 xsignal0 (Qarith_error);
3127
3128 return (FLOATP (x) || FLOATP (y) ? fmod_float : integer_mod) (x, y);
3129} 3132}
3130 3133
3131static Lisp_Object 3134static Lisp_Object
@@ -3214,7 +3217,7 @@ representation. */)
3214 3217
3215 if (BIGNUMP (value)) 3218 if (BIGNUMP (value))
3216 { 3219 {
3217 mpz_t *nonneg = &XBIGNUM (value)->value; 3220 mpz_t const *nonneg = xbignum_val (value);
3218 if (mpz_sgn (*nonneg) < 0) 3221 if (mpz_sgn (*nonneg) < 0)
3219 { 3222 {
3220 mpz_com (mpz[0], *nonneg); 3223 mpz_com (mpz[0], *nonneg);
@@ -3245,10 +3248,10 @@ In this case, the sign bit is duplicated. */)
3245 { 3248 {
3246 if (EQ (value, make_fixnum (0))) 3249 if (EQ (value, make_fixnum (0)))
3247 return value; 3250 return value;
3248 if (mpz_sgn (XBIGNUM (count)->value) < 0) 3251 if (mpz_sgn (*xbignum_val (count)) < 0)
3249 { 3252 {
3250 EMACS_INT v = (FIXNUMP (value) ? XFIXNUM (value) 3253 EMACS_INT v = (FIXNUMP (value) ? XFIXNUM (value)
3251 : mpz_sgn (XBIGNUM (value)->value)); 3254 : mpz_sgn (*xbignum_val (value)));
3252 return make_fixnum (v < 0 ? -1 : 0); 3255 return make_fixnum (v < 0 ? -1 : 0);
3253 } 3256 }
3254 overflow_error (); 3257 overflow_error ();
@@ -3291,8 +3294,8 @@ expt_integer (Lisp_Object x, Lisp_Object y)
3291 if (TYPE_RANGED_FIXNUMP (unsigned long, y)) 3294 if (TYPE_RANGED_FIXNUMP (unsigned long, y))
3292 exp = XFIXNUM (y); 3295 exp = XFIXNUM (y);
3293 else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (y) 3296 else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (y)
3294 && mpz_fits_ulong_p (XBIGNUM (y)->value)) 3297 && mpz_fits_ulong_p (*xbignum_val (y)))
3295 exp = mpz_get_ui (XBIGNUM (y)->value); 3298 exp = mpz_get_ui (*xbignum_val (y));
3296 else 3299 else
3297 overflow_error (); 3300 overflow_error ();
3298 3301
@@ -3311,7 +3314,7 @@ Markers are converted to integers. */)
3311 return make_int (XFIXNUM (number) + 1); 3314 return make_int (XFIXNUM (number) + 1);
3312 if (FLOATP (number)) 3315 if (FLOATP (number))
3313 return (make_float (1.0 + XFLOAT_DATA (number))); 3316 return (make_float (1.0 + XFLOAT_DATA (number)));
3314 mpz_add_ui (mpz[0], XBIGNUM (number)->value, 1); 3317 mpz_add_ui (mpz[0], *xbignum_val (number), 1);
3315 return make_integer_mpz (); 3318 return make_integer_mpz ();
3316} 3319}
3317 3320
@@ -3326,7 +3329,7 @@ Markers are converted to integers. */)
3326 return make_int (XFIXNUM (number) - 1); 3329 return make_int (XFIXNUM (number) - 1);
3327 if (FLOATP (number)) 3330 if (FLOATP (number))
3328 return (make_float (-1.0 + XFLOAT_DATA (number))); 3331 return (make_float (-1.0 + XFLOAT_DATA (number)));
3329 mpz_sub_ui (mpz[0], XBIGNUM (number)->value, 1); 3332 mpz_sub_ui (mpz[0], *xbignum_val (number), 1);
3330 return make_integer_mpz (); 3333 return make_integer_mpz ();
3331} 3334}
3332 3335
@@ -3337,7 +3340,7 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
3337 CHECK_INTEGER (number); 3340 CHECK_INTEGER (number);
3338 if (FIXNUMP (number)) 3341 if (FIXNUMP (number))
3339 return make_fixnum (~XFIXNUM (number)); 3342 return make_fixnum (~XFIXNUM (number));
3340 mpz_com (mpz[0], XBIGNUM (number)->value); 3343 mpz_com (mpz[0], *xbignum_val (number));
3341 return make_integer_mpz (); 3344 return make_integer_mpz ();
3342} 3345}
3343 3346
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 90ba461c6bc..7f4c8717f42 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -728,22 +728,27 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
728 strcpy (signature, DBUS_TYPE_STRING_AS_STRING); 728 strcpy (signature, DBUS_TYPE_STRING_AS_STRING);
729 729
730 else 730 else
731 /* If the element type is DBUS_TYPE_SIGNATURE, and this is 731 {
732 the only element, the value of this element is used as 732 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
733 the array's element signature. */ 733 the only element, the value of this element is used as
734 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)) 734 the array's element signature. */
735 == DBUS_TYPE_SIGNATURE) 735 if (CONSP (object) && (XD_OBJECT_TO_DBUS_TYPE (XCAR (object))
736 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object))) 736 == DBUS_TYPE_SIGNATURE))
737 && NILP (CDR_SAFE (XD_NEXT_VALUE (object)))) 737 {
738 { 738 Lisp_Object val = XD_NEXT_VALUE (object);
739 lispstpcpy (signature, CAR_SAFE (XD_NEXT_VALUE (object))); 739 if (CONSP (val) && STRINGP (XCAR (val)) && NILP (XCDR (val))
740 object = CDR_SAFE (XD_NEXT_VALUE (object)); 740 && SBYTES (XCAR (val)) < DBUS_MAXIMUM_SIGNATURE_LENGTH)
741 } 741 {
742 742 lispstpcpy (signature, XCAR (val));
743 else 743 object = Qnil;
744 xd_signature (signature, 744 }
745 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)), 745 }
746 dtype, CAR_SAFE (XD_NEXT_VALUE (object))); 746
747 if (!NILP (object))
748 xd_signature (signature,
749 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
750 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
751 }
747 752
748 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature, 753 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
749 XD_OBJECT_TO_STRING (object)); 754 XD_OBJECT_TO_STRING (object));
diff --git a/src/emacs.c b/src/emacs.c
index cc5818393a3..53572d7f0c8 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -2084,8 +2084,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
2084 2084
2085 /* Enter editor command loop. This never returns. */ 2085 /* Enter editor command loop. This never returns. */
2086 Frecursive_edit (); 2086 Frecursive_edit ();
2087 /* NOTREACHED */ 2087 eassume (false);
2088 return 0;
2089} 2088}
2090 2089
2091/* Sort the args so we can find the most important ones 2090/* Sort the args so we can find the most important ones
diff --git a/src/floatfns.c b/src/floatfns.c
index a913aad5aac..9049185307c 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -48,6 +48,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
48 48
49#include <count-leading-zeros.h> 49#include <count-leading-zeros.h>
50 50
51/* Emacs needs proper handling of +/-inf; correct printing as well as
52 important packages depend on it. Make sure the user didn't specify
53 -ffinite-math-only, either directly or implicitly with -Ofast or
54 -ffast-math. */
55#if defined __FINITE_MATH_ONLY__ && __FINITE_MATH_ONLY__
56 #error Emacs cannot be built with -ffinite-math-only
57#endif
58
51/* Check that X is a floating point number. */ 59/* Check that X is a floating point number. */
52 60
53static void 61static void
@@ -268,9 +276,9 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
268 } 276 }
269 else 277 else
270 { 278 {
271 if (mpz_sgn (XBIGNUM (arg)->value) < 0) 279 if (mpz_sgn (*xbignum_val (arg)) < 0)
272 { 280 {
273 mpz_neg (mpz[0], XBIGNUM (arg)->value); 281 mpz_neg (mpz[0], *xbignum_val (arg));
274 arg = make_integer_mpz (); 282 arg = make_integer_mpz ();
275 } 283 }
276 } 284 }
@@ -315,7 +323,7 @@ This is the same as the exponent of a float. */)
315 value = ivalue - 1; 323 value = ivalue - 1;
316 } 324 }
317 else if (!FIXNUMP (arg)) 325 else if (!FIXNUMP (arg))
318 value = mpz_sizeinbase (XBIGNUM (arg)->value, 2) - 1; 326 value = mpz_sizeinbase (*xbignum_val (arg), 2) - 1;
319 else 327 else
320 { 328 {
321 EMACS_INT i = XFIXNUM (arg); 329 EMACS_INT i = XFIXNUM (arg);
diff --git a/src/fns.c b/src/fns.c
index 920addeaf13..df921e28f3b 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -47,7 +47,6 @@ static void sort_vector_copy (Lisp_Object, ptrdiff_t,
47enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; 47enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES };
48static bool internal_equal (Lisp_Object, Lisp_Object, 48static bool internal_equal (Lisp_Object, Lisp_Object,
49 enum equal_kind, int, Lisp_Object); 49 enum equal_kind, int, Lisp_Object);
50static EMACS_UINT sxhash_bignum (struct Lisp_Bignum *);
51 50
52DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, 51DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
53 doc: /* Return the argument unchanged. */ 52 doc: /* Return the argument unchanged. */
@@ -1444,7 +1443,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
1444 } 1443 }
1445 else 1444 else
1446 { 1445 {
1447 if (mpz_sgn (XBIGNUM (n)->value) < 0) 1446 if (mpz_sgn (*xbignum_val (n)) < 0)
1448 return tail; 1447 return tail;
1449 num = large_num; 1448 num = large_num;
1450 } 1449 }
@@ -1482,11 +1481,11 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
1482 CYCLE_LENGTH. */ 1481 CYCLE_LENGTH. */
1483 /* Add N mod CYCLE_LENGTH to NUM. */ 1482 /* Add N mod CYCLE_LENGTH to NUM. */
1484 if (cycle_length <= ULONG_MAX) 1483 if (cycle_length <= ULONG_MAX)
1485 num += mpz_tdiv_ui (XBIGNUM (n)->value, cycle_length); 1484 num += mpz_tdiv_ui (*xbignum_val (n), cycle_length);
1486 else 1485 else
1487 { 1486 {
1488 mpz_set_intmax (mpz[0], cycle_length); 1487 mpz_set_intmax (mpz[0], cycle_length);
1489 mpz_tdiv_r (mpz[0], XBIGNUM (n)->value, mpz[0]); 1488 mpz_tdiv_r (mpz[0], *xbignum_val (n), mpz[0]);
1490 intptr_t iz; 1489 intptr_t iz;
1491 mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, mpz[0]); 1490 mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, mpz[0]);
1492 num += iz; 1491 num += iz;
@@ -1595,7 +1594,7 @@ The value is actually the tail of LIST whose car is ELT. */)
1595 { 1594 {
1596 Lisp_Object tem = XCAR (tail); 1595 Lisp_Object tem = XCAR (tail);
1597 if (BIGNUMP (tem) 1596 if (BIGNUMP (tem)
1598 && mpz_cmp (XBIGNUM (elt)->value, XBIGNUM (tem)->value) == 0) 1597 && mpz_cmp (*xbignum_val (elt), *xbignum_val (tem)) == 0)
1599 return tail; 1598 return tail;
1600 } 1599 }
1601 } 1600 }
@@ -2307,7 +2306,7 @@ This differs from numeric comparison: (eql 0.0 -0.0) returns nil and
2307 return FLOATP (obj2) && same_float (obj1, obj2) ? Qt : Qnil; 2306 return FLOATP (obj2) && same_float (obj1, obj2) ? Qt : Qnil;
2308 else if (BIGNUMP (obj1)) 2307 else if (BIGNUMP (obj1))
2309 return ((BIGNUMP (obj2) 2308 return ((BIGNUMP (obj2)
2310 && mpz_cmp (XBIGNUM (obj1)->value, XBIGNUM (obj2)->value) == 0) 2309 && mpz_cmp (*xbignum_val (obj1), *xbignum_val (obj2)) == 0)
2311 ? Qt : Qnil); 2310 ? Qt : Qnil);
2312 else 2311 else
2313 return EQ (obj1, obj2) ? Qt : Qnil; 2312 return EQ (obj1, obj2) ? Qt : Qnil;
@@ -2437,7 +2436,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
2437 if (ASIZE (o2) != size) 2436 if (ASIZE (o2) != size)
2438 return false; 2437 return false;
2439 if (BIGNUMP (o1)) 2438 if (BIGNUMP (o1))
2440 return mpz_cmp (XBIGNUM (o1)->value, XBIGNUM (o2)->value) == 0; 2439 return mpz_cmp (*xbignum_val (o1), *xbignum_val (o2)) == 0;
2441 if (OVERLAYP (o1)) 2440 if (OVERLAYP (o1))
2442 { 2441 {
2443 if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2), 2442 if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2),
@@ -2951,9 +2950,12 @@ suppressed. */)
2951 But not more than once in any file, 2950 But not more than once in any file,
2952 and not when we aren't loading or reading from a file. */ 2951 and not when we aren't loading or reading from a file. */
2953 if (!from_file) 2952 if (!from_file)
2954 for (tem = Vcurrent_load_list; CONSP (tem); tem = XCDR (tem)) 2953 {
2955 if (NILP (XCDR (tem)) && STRINGP (XCAR (tem))) 2954 Lisp_Object tail = Vcurrent_load_list;
2956 from_file = 1; 2955 FOR_EACH_TAIL_SAFE (tail)
2956 if (NILP (XCDR (tail)) && STRINGP (XCAR (tail)))
2957 from_file = true;
2958 }
2957 2959
2958 if (from_file) 2960 if (from_file)
2959 { 2961 {
@@ -3278,11 +3280,11 @@ static ptrdiff_t base64_encode_1 (const char *, char *, ptrdiff_t, bool, bool,
3278static ptrdiff_t base64_decode_1 (const char *, char *, ptrdiff_t, bool, 3280static ptrdiff_t base64_decode_1 (const char *, char *, ptrdiff_t, bool,
3279 bool, ptrdiff_t *); 3281 bool, ptrdiff_t *);
3280 3282
3281Lisp_Object base64_encode_region_1 (Lisp_Object, Lisp_Object, bool, 3283static Lisp_Object base64_encode_region_1 (Lisp_Object, Lisp_Object, bool,
3282 bool, bool); 3284 bool, bool);
3283 3285
3284Lisp_Object base64_encode_string_1(Lisp_Object, bool, 3286static Lisp_Object base64_encode_string_1 (Lisp_Object, bool,
3285 bool, bool); 3287 bool, bool);
3286 3288
3287 3289
3288DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region, 3290DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region,
@@ -3293,7 +3295,7 @@ Optional third argument NO-LINE-BREAK means do not break long lines
3293into shorter lines. */) 3295into shorter lines. */)
3294 (Lisp_Object beg, Lisp_Object end, Lisp_Object no_line_break) 3296 (Lisp_Object beg, Lisp_Object end, Lisp_Object no_line_break)
3295{ 3297{
3296 return base64_encode_region_1(beg, end, NILP (no_line_break), true, false); 3298 return base64_encode_region_1 (beg, end, NILP (no_line_break), true, false);
3297} 3299}
3298 3300
3299 3301
@@ -3306,10 +3308,10 @@ Optional second argument NO-PAD means do not add padding char =.
3306This produces the URL variant of base 64 encoding defined in RFC 4648. */) 3308This produces the URL variant of base 64 encoding defined in RFC 4648. */)
3307 (Lisp_Object beg, Lisp_Object end, Lisp_Object no_pad) 3309 (Lisp_Object beg, Lisp_Object end, Lisp_Object no_pad)
3308{ 3310{
3309 return base64_encode_region_1(beg, end, false, NILP(no_pad), true); 3311 return base64_encode_region_1 (beg, end, false, NILP(no_pad), true);
3310} 3312}
3311 3313
3312Lisp_Object 3314static Lisp_Object
3313base64_encode_region_1 (Lisp_Object beg, Lisp_Object end, bool line_break, 3315base64_encode_region_1 (Lisp_Object beg, Lisp_Object end, bool line_break,
3314 bool pad, bool base64url) 3316 bool pad, bool base64url)
3315{ 3317{
@@ -3374,11 +3376,11 @@ into shorter lines. */)
3374 (Lisp_Object string, Lisp_Object no_line_break) 3376 (Lisp_Object string, Lisp_Object no_line_break)
3375{ 3377{
3376 3378
3377 return base64_encode_string_1(string, NILP (no_line_break), true, false); 3379 return base64_encode_string_1 (string, NILP (no_line_break), true, false);
3378} 3380}
3379 3381
3380DEFUN ("base64url-encode-string", Fbase64url_encode_string, Sbase64url_encode_string, 3382DEFUN ("base64url-encode-string", Fbase64url_encode_string,
3381 1, 2, 0, 3383 Sbase64url_encode_string, 1, 2, 0,
3382 doc: /* Base64url-encode STRING and return the result. 3384 doc: /* Base64url-encode STRING and return the result.
3383Optional second argument NO-PAD means do not add padding char =. 3385Optional second argument NO-PAD means do not add padding char =.
3384 3386
@@ -3386,12 +3388,12 @@ This produces the URL variant of base 64 encoding defined in RFC 4648. */)
3386 (Lisp_Object string, Lisp_Object no_pad) 3388 (Lisp_Object string, Lisp_Object no_pad)
3387{ 3389{
3388 3390
3389 return base64_encode_string_1(string, false, NILP(no_pad), true); 3391 return base64_encode_string_1 (string, false, NILP(no_pad), true);
3390} 3392}
3391 3393
3392Lisp_Object 3394static Lisp_Object
3393base64_encode_string_1(Lisp_Object string, bool line_break, 3395base64_encode_string_1 (Lisp_Object string, bool line_break,
3394 bool pad, bool base64url) 3396 bool pad, bool base64url)
3395{ 3397{
3396 ptrdiff_t allength, length, encoded_length; 3398 ptrdiff_t allength, length, encoded_length;
3397 char *encoded; 3399 char *encoded;
@@ -3508,9 +3510,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length,
3508 { 3510 {
3509 *e++ = b64_value_to_char[value]; 3511 *e++ = b64_value_to_char[value];
3510 if (pad) 3512 if (pad)
3511 { 3513 *e++ = '=';
3512 *e++ = '=';
3513 }
3514 break; 3514 break;
3515 } 3515 }
3516 3516
@@ -4196,21 +4196,20 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
4196 new_size); 4196 new_size);
4197 ptrdiff_t next_size = ASIZE (next); 4197 ptrdiff_t next_size = ASIZE (next);
4198 for (ptrdiff_t i = old_size; i < next_size - 1; i++) 4198 for (ptrdiff_t i = old_size; i < next_size - 1; i++)
4199 gc_aset (next, i, make_fixnum (i + 1)); 4199 ASET (next, i, make_fixnum (i + 1));
4200 gc_aset (next, next_size - 1, make_fixnum (-1)); 4200 ASET (next, next_size - 1, make_fixnum (-1));
4201 ptrdiff_t index_size = hash_index_size (h, next_size);
4202 4201
4203 /* Build the new&larger key_and_value vector, making sure the new 4202 /* Build the new&larger key_and_value vector, making sure the new
4204 fields are initialized to `unbound`. */ 4203 fields are initialized to `unbound`. */
4205 Lisp_Object key_and_value 4204 Lisp_Object key_and_value
4206 = larger_vecalloc (h->key_and_value, 2 * (next_size - old_size), 4205 = larger_vecalloc (h->key_and_value, 2 * (next_size - old_size),
4207 2 * next_size); 4206 2 * next_size);
4208 for (ptrdiff_t i = ASIZE (h->key_and_value); 4207 for (ptrdiff_t i = 2 * old_size; i < 2 * next_size; i++)
4209 i < ASIZE (key_and_value); i++)
4210 ASET (key_and_value, i, Qunbound); 4208 ASET (key_and_value, i, Qunbound);
4211 4209
4212 Lisp_Object hash = larger_vector (h->hash, next_size - old_size, 4210 Lisp_Object hash = larger_vector (h->hash, next_size - old_size,
4213 next_size); 4211 next_size);
4212 ptrdiff_t index_size = hash_index_size (h, next_size);
4214 h->index = make_vector (index_size, make_fixnum (-1)); 4213 h->index = make_vector (index_size, make_fixnum (-1));
4215 h->key_and_value = key_and_value; 4214 h->key_and_value = key_and_value;
4216 h->hash = hash; 4215 h->hash = hash;
@@ -4402,17 +4401,17 @@ hash_clear (struct Lisp_Hash_Table *h)
4402{ 4401{
4403 if (h->count > 0) 4402 if (h->count > 0)
4404 { 4403 {
4405 ptrdiff_t i, size = HASH_TABLE_SIZE (h); 4404 ptrdiff_t size = HASH_TABLE_SIZE (h);
4406 4405 if (!hash_rehash_needed_p (h))
4407 for (i = 0; i < size; ++i) 4406 memclear (XVECTOR (h->hash)->contents, size * word_size);
4407 for (ptrdiff_t i = 0; i < size; i++)
4408 { 4408 {
4409 set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1); 4409 set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1);
4410 set_hash_key_slot (h, i, Qunbound); 4410 set_hash_key_slot (h, i, Qunbound);
4411 set_hash_value_slot (h, i, Qnil); 4411 set_hash_value_slot (h, i, Qnil);
4412 set_hash_hash_slot (h, i, Qnil);
4413 } 4412 }
4414 4413
4415 for (i = 0; i < ASIZE (h->index); ++i) 4414 for (ptrdiff_t i = 0; i < ASIZE (h->index); i++)
4416 ASET (h->index, i, make_fixnum (-1)); 4415 ASET (h->index, i, make_fixnum (-1));
4417 4416
4418 h->next_free = 0; 4417 h->next_free = 0;
@@ -4640,13 +4639,14 @@ sxhash_bool_vector (Lisp_Object vec)
4640/* Return a hash for a bignum. */ 4639/* Return a hash for a bignum. */
4641 4640
4642static EMACS_UINT 4641static EMACS_UINT
4643sxhash_bignum (struct Lisp_Bignum *bignum) 4642sxhash_bignum (Lisp_Object bignum)
4644{ 4643{
4645 size_t i, nlimbs = mpz_size (bignum->value); 4644 mpz_t const *n = xbignum_val (bignum);
4645 size_t i, nlimbs = mpz_size (*n);
4646 EMACS_UINT hash = 0; 4646 EMACS_UINT hash = 0;
4647 4647
4648 for (i = 0; i < nlimbs; ++i) 4648 for (i = 0; i < nlimbs; ++i)
4649 hash = sxhash_combine (hash, mpz_getlimbn (bignum->value, i)); 4649 hash = sxhash_combine (hash, mpz_getlimbn (*n, i));
4650 4650
4651 return SXHASH_REDUCE (hash); 4651 return SXHASH_REDUCE (hash);
4652} 4652}
@@ -4680,7 +4680,7 @@ sxhash (Lisp_Object obj, int depth)
4680 /* This can be everything from a vector to an overlay. */ 4680 /* This can be everything from a vector to an overlay. */
4681 case Lisp_Vectorlike: 4681 case Lisp_Vectorlike:
4682 if (BIGNUMP (obj)) 4682 if (BIGNUMP (obj))
4683 hash = sxhash_bignum (XBIGNUM (obj)); 4683 hash = sxhash_bignum (obj);
4684 else if (VECTORP (obj) || RECORDP (obj)) 4684 else if (VECTORP (obj) || RECORDP (obj))
4685 /* According to the CL HyperSpec, two arrays are equal only if 4685 /* According to the CL HyperSpec, two arrays are equal only if
4686 they are `eq', except for strings and bit-vectors. In 4686 they are `eq', except for strings and bit-vectors. In
diff --git a/src/font.c b/src/font.c
index ce85e0bb4ad..935dd64e648 100644
--- a/src/font.c
+++ b/src/font.c
@@ -5509,7 +5509,14 @@ and cannot switch to a smaller font for those characters, set
5509this variable non-nil. 5509this variable non-nil.
5510Disabling compaction of font caches might enlarge the Emacs memory 5510Disabling compaction of font caches might enlarge the Emacs memory
5511footprint in sessions that use lots of different fonts. */); 5511footprint in sessions that use lots of different fonts. */);
5512
5513#ifdef WINDOWSNT
5514 /* Compacting font caches causes slow redisplay on Windows with many
5515 large fonts, so we disable it by default. */
5516 inhibit_compacting_font_caches = 1;
5517#else
5512 inhibit_compacting_font_caches = 0; 5518 inhibit_compacting_font_caches = 0;
5519#endif
5513 5520
5514 DEFVAR_BOOL ("xft-ignore-color-fonts", 5521 DEFVAR_BOOL ("xft-ignore-color-fonts",
5515 Vxft_ignore_color_fonts, 5522 Vxft_ignore_color_fonts,
diff --git a/src/frame.c b/src/frame.c
index 50a7f138b81..1d42d0cb4de 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -3492,7 +3492,7 @@ DEFUN ("frame-bottom-divider-width", Fbottom_divider_width, Sbottom_divider_widt
3492} 3492}
3493 3493
3494DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 4, 3494DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 4,
3495 "(list (selected-frame) current-prefix-arg)", 3495 "(list (selected-frame) (prefix-numeric-value current-prefix-arg))",
3496 doc: /* Set text height of frame FRAME to HEIGHT lines. 3496 doc: /* Set text height of frame FRAME to HEIGHT lines.
3497Optional third arg PRETEND non-nil means that redisplay should use 3497Optional third arg PRETEND non-nil means that redisplay should use
3498HEIGHT lines but that the idea of the actual height of the frame should 3498HEIGHT lines but that the idea of the actual height of the frame should
@@ -3521,7 +3521,7 @@ currenly selected frame will be set to this height. */)
3521} 3521}
3522 3522
3523DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 4, 3523DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 4,
3524 "(list (selected-frame) current-prefix-arg)", 3524 "(list (selected-frame) (prefix-numeric-value current-prefix-arg))",
3525 doc: /* Set text width of frame FRAME to WIDTH columns. 3525 doc: /* Set text width of frame FRAME to WIDTH columns.
3526Optional third arg PRETEND non-nil means that redisplay should use WIDTH 3526Optional third arg PRETEND non-nil means that redisplay should use WIDTH
3527columns but that the idea of the actual width of the frame should not 3527columns but that the idea of the actual width of the frame should not
@@ -5327,9 +5327,11 @@ or a list (- N) meaning -N pixels relative to bottom/right corner.
5327On Nextstep, this just calls `ns-parse-geometry'. */) 5327On Nextstep, this just calls `ns-parse-geometry'. */)
5328 (Lisp_Object string) 5328 (Lisp_Object string)
5329{ 5329{
5330 int geometry, x, y; 5330 /* x and y don't need initialization, as they are not accessed
5331 unless XParseGeometry sets them, in which case it always returns
5332 a non-zero value. */
5333 int x UNINIT, y UNINIT;
5331 unsigned int width, height; 5334 unsigned int width, height;
5332 Lisp_Object result;
5333 5335
5334 CHECK_STRING (string); 5336 CHECK_STRING (string);
5335 5337
@@ -5337,9 +5339,9 @@ On Nextstep, this just calls `ns-parse-geometry'. */)
5337 if (strchr (SSDATA (string), ' ') != NULL) 5339 if (strchr (SSDATA (string), ' ') != NULL)
5338 return call1 (Qns_parse_geometry, string); 5340 return call1 (Qns_parse_geometry, string);
5339#endif 5341#endif
5340 geometry = XParseGeometry (SSDATA (string), 5342 int geometry = XParseGeometry (SSDATA (string),
5341 &x, &y, &width, &height); 5343 &x, &y, &width, &height);
5342 result = Qnil; 5344 Lisp_Object result = Qnil;
5343 if (geometry & XValue) 5345 if (geometry & XValue)
5344 { 5346 {
5345 Lisp_Object element; 5347 Lisp_Object element;
diff --git a/src/ftfont.c b/src/ftfont.c
index 16b18de6867..77a4cf5de5c 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -433,7 +433,7 @@ ftfont_lookup_cache (Lisp_Object key, enum ftfont_cache_for cache_for)
433 return cache; 433 return cache;
434} 434}
435 435
436FcCharSet * 436static FcCharSet *
437ftfont_get_fc_charset (Lisp_Object entity) 437ftfont_get_fc_charset (Lisp_Object entity)
438{ 438{
439 Lisp_Object val, cache; 439 Lisp_Object val, cache;
diff --git a/src/ftfont.h b/src/ftfont.h
index b2280e9aab9..f771dc159b0 100644
--- a/src/ftfont.h
+++ b/src/ftfont.h
@@ -41,7 +41,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
41#endif /* HAVE_M17N_FLT */ 41#endif /* HAVE_M17N_FLT */
42#endif /* HAVE_LIBOTF */ 42#endif /* HAVE_LIBOTF */
43 43
44extern FcCharSet *ftfont_get_fc_charset (Lisp_Object);
45extern void ftfont_fix_match (FcPattern *, FcPattern *); 44extern void ftfont_fix_match (FcPattern *, FcPattern *);
46extern void ftfont_add_rendering_parameters (FcPattern *, Lisp_Object); 45extern void ftfont_add_rendering_parameters (FcPattern *, Lisp_Object);
47extern FcPattern *ftfont_entity_pattern (Lisp_Object, int); 46extern FcPattern *ftfont_entity_pattern (Lisp_Object, int);
diff --git a/src/gnutls.c b/src/gnutls.c
index 267ba9aba35..d43534b5ae1 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -44,6 +44,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
44# define HAVE_GNUTLS_EXT__DUMBFW 44# define HAVE_GNUTLS_EXT__DUMBFW
45#endif 45#endif
46 46
47#if GNUTLS_VERSION_NUMBER >= 0x030400
48# define HAVE_GNUTLS_ETM_STATUS
49#endif
50
51#if GNUTLS_VERSION_NUMBER < 0x030600
52# define HAVE_GNUTLS_COMPRESSION_GET
53#endif
54
47/* gnutls_mac_get_nonce_size was added in GnuTLS 3.2.0, but was 55/* gnutls_mac_get_nonce_size was added in GnuTLS 3.2.0, but was
48 exported only since 3.3.0. */ 56 exported only since 3.3.0. */
49#if GNUTLS_VERSION_NUMBER >= 0x030300 57#if GNUTLS_VERSION_NUMBER >= 0x030300
@@ -159,6 +167,8 @@ DEF_DLL_FN (int, gnutls_x509_crt_check_hostname,
159DEF_DLL_FN (int, gnutls_x509_crt_check_issuer, 167DEF_DLL_FN (int, gnutls_x509_crt_check_issuer,
160 (gnutls_x509_crt_t, gnutls_x509_crt_t)); 168 (gnutls_x509_crt_t, gnutls_x509_crt_t));
161DEF_DLL_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t)); 169DEF_DLL_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
170DEF_DLL_FN (int, gnutls_x509_crt_export,
171 (gnutls_x509_crt_t, gnutls_x509_crt_fmt_t, void *, size_t *));
162DEF_DLL_FN (int, gnutls_x509_crt_import, 172DEF_DLL_FN (int, gnutls_x509_crt_import,
163 (gnutls_x509_crt_t, const gnutls_datum_t *, 173 (gnutls_x509_crt_t, const gnutls_datum_t *,
164 gnutls_x509_crt_fmt_t)); 174 gnutls_x509_crt_fmt_t));
@@ -180,6 +190,9 @@ DEF_DLL_FN (int, gnutls_x509_crt_get_dn,
180 (gnutls_x509_crt_t, char *, size_t *)); 190 (gnutls_x509_crt_t, char *, size_t *));
181DEF_DLL_FN (int, gnutls_x509_crt_get_pk_algorithm, 191DEF_DLL_FN (int, gnutls_x509_crt_get_pk_algorithm,
182 (gnutls_x509_crt_t, unsigned int *)); 192 (gnutls_x509_crt_t, unsigned int *));
193DEF_DLL_FN (int, gnutls_x509_crt_print,
194 (gnutls_x509_crt_t, gnutls_certificate_print_formats_t,
195 gnutls_datum_t *));
183DEF_DLL_FN (const char *, gnutls_pk_algorithm_get_name, 196DEF_DLL_FN (const char *, gnutls_pk_algorithm_get_name,
184 (gnutls_pk_algorithm_t)); 197 (gnutls_pk_algorithm_t));
185DEF_DLL_FN (int, gnutls_pk_bits_to_sec_param, 198DEF_DLL_FN (int, gnutls_pk_bits_to_sec_param,
@@ -208,6 +221,13 @@ DEF_DLL_FN (const char *, gnutls_cipher_get_name,
208 (gnutls_cipher_algorithm_t)); 221 (gnutls_cipher_algorithm_t));
209DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t)); 222DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t));
210DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t)); 223DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t));
224#ifdef HAVE_GNUTLS_COMPRESSION_GET
225DEF_DLL_FN (gnutls_compression_method_t, gnutls_compression_get,
226 (gnutls_session_t));
227DEF_DLL_FN (const char *, gnutls_compression_get_name,
228 (gnutls_compression_method_t));
229#endif
230DEF_DLL_FN (unsigned, gnutls_safe_renegotiation_status, (gnutls_session_t));
211 231
212# ifdef HAVE_GNUTLS3 232# ifdef HAVE_GNUTLS3
213DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t)); 233DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t));
@@ -250,6 +270,9 @@ DEF_DLL_FN (int, gnutls_aead_cipher_decrypt,
250 (gnutls_aead_cipher_hd_t, const void *, size_t, const void *, 270 (gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
251 size_t, size_t, const void *, size_t, void *, size_t *)); 271 size_t, size_t, const void *, size_t, void *, size_t *));
252# endif 272# endif
273# ifdef HAVE_GNUTLS_ETM_STATUS
274DEF_DLL_FN (unsigned, gnutls_session_etm_status, (gnutls_session_t));
275# endif
253DEF_DLL_FN (int, gnutls_hmac_init, 276DEF_DLL_FN (int, gnutls_hmac_init,
254 (gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t)); 277 (gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t));
255DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t)); 278DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t));
@@ -267,6 +290,7 @@ DEF_DLL_FN (const char *, gnutls_ext_get_name, (unsigned int));
267# endif 290# endif
268# endif /* HAVE_GNUTLS3 */ 291# endif /* HAVE_GNUTLS3 */
269 292
293static gnutls_free_function *gnutls_free_func;
270 294
271static bool 295static bool
272init_gnutls_functions (void) 296init_gnutls_functions (void)
@@ -322,6 +346,7 @@ init_gnutls_functions (void)
322 LOAD_DLL_FN (library, gnutls_x509_crt_check_hostname); 346 LOAD_DLL_FN (library, gnutls_x509_crt_check_hostname);
323 LOAD_DLL_FN (library, gnutls_x509_crt_check_issuer); 347 LOAD_DLL_FN (library, gnutls_x509_crt_check_issuer);
324 LOAD_DLL_FN (library, gnutls_x509_crt_deinit); 348 LOAD_DLL_FN (library, gnutls_x509_crt_deinit);
349 LOAD_DLL_FN (library, gnutls_x509_crt_export);
325 LOAD_DLL_FN (library, gnutls_x509_crt_import); 350 LOAD_DLL_FN (library, gnutls_x509_crt_import);
326 LOAD_DLL_FN (library, gnutls_x509_crt_init); 351 LOAD_DLL_FN (library, gnutls_x509_crt_init);
327 LOAD_DLL_FN (library, gnutls_x509_crt_get_fingerprint); 352 LOAD_DLL_FN (library, gnutls_x509_crt_get_fingerprint);
@@ -332,6 +357,7 @@ init_gnutls_functions (void)
332 LOAD_DLL_FN (library, gnutls_x509_crt_get_expiration_time); 357 LOAD_DLL_FN (library, gnutls_x509_crt_get_expiration_time);
333 LOAD_DLL_FN (library, gnutls_x509_crt_get_dn); 358 LOAD_DLL_FN (library, gnutls_x509_crt_get_dn);
334 LOAD_DLL_FN (library, gnutls_x509_crt_get_pk_algorithm); 359 LOAD_DLL_FN (library, gnutls_x509_crt_get_pk_algorithm);
360 LOAD_DLL_FN (library, gnutls_x509_crt_print);
335 LOAD_DLL_FN (library, gnutls_pk_algorithm_get_name); 361 LOAD_DLL_FN (library, gnutls_pk_algorithm_get_name);
336 LOAD_DLL_FN (library, gnutls_pk_bits_to_sec_param); 362 LOAD_DLL_FN (library, gnutls_pk_bits_to_sec_param);
337 LOAD_DLL_FN (library, gnutls_x509_crt_get_issuer_unique_id); 363 LOAD_DLL_FN (library, gnutls_x509_crt_get_issuer_unique_id);
@@ -349,6 +375,11 @@ init_gnutls_functions (void)
349 LOAD_DLL_FN (library, gnutls_cipher_get_name); 375 LOAD_DLL_FN (library, gnutls_cipher_get_name);
350 LOAD_DLL_FN (library, gnutls_mac_get); 376 LOAD_DLL_FN (library, gnutls_mac_get);
351 LOAD_DLL_FN (library, gnutls_mac_get_name); 377 LOAD_DLL_FN (library, gnutls_mac_get_name);
378# ifdef HAVE_GNUTLS_COMPRESSION_GET
379 LOAD_DLL_FN (library, gnutls_compression_get);
380 LOAD_DLL_FN (library, gnutls_compression_get_name);
381# endif
382 LOAD_DLL_FN (library, gnutls_safe_renegotiation_status);
352# ifdef HAVE_GNUTLS3 383# ifdef HAVE_GNUTLS3
353 LOAD_DLL_FN (library, gnutls_rnd); 384 LOAD_DLL_FN (library, gnutls_rnd);
354 LOAD_DLL_FN (library, gnutls_mac_list); 385 LOAD_DLL_FN (library, gnutls_mac_list);
@@ -380,6 +411,9 @@ init_gnutls_functions (void)
380 LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt); 411 LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt);
381 LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt); 412 LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt);
382# endif 413# endif
414# ifdef HAVE_GNUTLS_ETM_STATUS
415 LOAD_DLL_FN (library, gnutls_session_etm_status);
416# endif
383 LOAD_DLL_FN (library, gnutls_hmac_init); 417 LOAD_DLL_FN (library, gnutls_hmac_init);
384 LOAD_DLL_FN (library, gnutls_hmac_get_len); 418 LOAD_DLL_FN (library, gnutls_hmac_get_len);
385 LOAD_DLL_FN (library, gnutls_hmac); 419 LOAD_DLL_FN (library, gnutls_hmac);
@@ -395,6 +429,13 @@ init_gnutls_functions (void)
395# endif 429# endif
396# endif /* HAVE_GNUTLS3 */ 430# endif /* HAVE_GNUTLS3 */
397 431
432 /* gnutls_free is a variable inside GnuTLS, whose value is the
433 "free" function. So it needs special handling. */
434 gnutls_free_func = (gnutls_free_function *) GetProcAddress (library,
435 "gnutls_free");
436 if (!gnutls_free_func)
437 return false;
438
398 max_log_level = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX); 439 max_log_level = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX);
399 { 440 {
400 Lisp_Object name = CAR_SAFE (Fget (Qgnutls, QCloaded_from)); 441 Lisp_Object name = CAR_SAFE (Fget (Qgnutls, QCloaded_from));
@@ -437,6 +478,11 @@ init_gnutls_functions (void)
437# define gnutls_kx_get_name fn_gnutls_kx_get_name 478# define gnutls_kx_get_name fn_gnutls_kx_get_name
438# define gnutls_mac_get fn_gnutls_mac_get 479# define gnutls_mac_get fn_gnutls_mac_get
439# define gnutls_mac_get_name fn_gnutls_mac_get_name 480# define gnutls_mac_get_name fn_gnutls_mac_get_name
481# ifdef HAVE_GNUTLS_COMPRESSION_GET
482# define gnutls_compression_get fn_gnutls_compression_get
483# define gnutls_compression_get_name fn_gnutls_compression_get_name
484# endif
485# define gnutls_safe_renegotiation_status fn_gnutls_safe_renegotiation_status
440# define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name 486# define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name
441# define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param 487# define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param
442# define gnutls_priority_set_direct fn_gnutls_priority_set_direct 488# define gnutls_priority_set_direct fn_gnutls_priority_set_direct
@@ -456,6 +502,7 @@ init_gnutls_functions (void)
456# define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname 502# define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname
457# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer 503# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer
458# define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit 504# define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit
505# define gnutls_x509_crt_export fn_gnutls_x509_crt_export
459# define gnutls_x509_crt_get_activation_time fn_gnutls_x509_crt_get_activation_time 506# define gnutls_x509_crt_get_activation_time fn_gnutls_x509_crt_get_activation_time
460# define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn 507# define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn
461# define gnutls_x509_crt_get_expiration_time fn_gnutls_x509_crt_get_expiration_time 508# define gnutls_x509_crt_get_expiration_time fn_gnutls_x509_crt_get_expiration_time
@@ -464,6 +511,7 @@ init_gnutls_functions (void)
464# define gnutls_x509_crt_get_issuer_unique_id fn_gnutls_x509_crt_get_issuer_unique_id 511# define gnutls_x509_crt_get_issuer_unique_id fn_gnutls_x509_crt_get_issuer_unique_id
465# define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id 512# define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id
466# define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm 513# define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm
514# define gnutls_x509_crt_print fn_gnutls_x509_crt_print
467# define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial 515# define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial
468# define gnutls_x509_crt_get_signature_algorithm fn_gnutls_x509_crt_get_signature_algorithm 516# define gnutls_x509_crt_get_signature_algorithm fn_gnutls_x509_crt_get_signature_algorithm
469# define gnutls_x509_crt_get_subject_unique_id fn_gnutls_x509_crt_get_subject_unique_id 517# define gnutls_x509_crt_get_subject_unique_id fn_gnutls_x509_crt_get_subject_unique_id
@@ -501,6 +549,9 @@ init_gnutls_functions (void)
501# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init 549# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init
502# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit 550# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit
503# endif 551# endif
552# ifdef HAVE_GNUTLS_ETM_STATUS
553# define gnutls_session_etm_status fn_gnutls_session_etm_status
554# endif
504# define gnutls_hmac_init fn_gnutls_hmac_init 555# define gnutls_hmac_init fn_gnutls_hmac_init
505# define gnutls_hmac_get_len fn_gnutls_hmac_get_len 556# define gnutls_hmac_get_len fn_gnutls_hmac_get_len
506# define gnutls_hmac fn_gnutls_hmac 557# define gnutls_hmac fn_gnutls_hmac
@@ -516,6 +567,11 @@ init_gnutls_functions (void)
516# endif 567# endif
517# endif /* HAVE_GNUTLS3 */ 568# endif /* HAVE_GNUTLS3 */
518 569
570/* gnutls_free_func is a data pointer to a variable which holds an
571 address of a function. We use #undef because MinGW64 defines
572 gnutls_free as a macro as well in the GnuTLS headers. */
573# undef gnutls_free
574# define gnutls_free (*gnutls_free_func)
519 575
520/* This wrapper is called from fns.c, which doesn't know about the 576/* This wrapper is called from fns.c, which doesn't know about the
521 LOAD_DLL_FN stuff above. */ 577 LOAD_DLL_FN stuff above. */
@@ -1041,7 +1097,35 @@ gnutls_hex_string (unsigned char *buf, ptrdiff_t buf_size, const char *prefix)
1041} 1097}
1042 1098
1043static Lisp_Object 1099static Lisp_Object
1044gnutls_certificate_details (gnutls_x509_crt_t cert) 1100emacs_gnutls_certificate_export_pem (gnutls_x509_crt_t cert)
1101{
1102 size_t size = 0;
1103 int err = gnutls_x509_crt_export (cert, GNUTLS_X509_FMT_PEM, NULL, &size);
1104 check_memory_full (err);
1105
1106 if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
1107 {
1108 USE_SAFE_ALLOCA;
1109 char *buf = SAFE_ALLOCA (size);
1110 err = gnutls_x509_crt_export (cert, GNUTLS_X509_FMT_PEM, buf, &size);
1111 check_memory_full (err);
1112
1113 if (err < GNUTLS_E_SUCCESS)
1114 error ("GnuTLS certificate export error: %s",
1115 emacs_gnutls_strerror (err));
1116
1117 Lisp_Object result = build_string (buf);
1118 SAFE_FREE ();
1119 return result;
1120 }
1121 else if (err < GNUTLS_E_SUCCESS)
1122 error ("GnuTLS certificate export error: %s", emacs_gnutls_strerror (err));
1123
1124 return Qnil;
1125}
1126
1127static Lisp_Object
1128emacs_gnutls_certificate_details (gnutls_x509_crt_t cert)
1045{ 1129{
1046 Lisp_Object res = Qnil; 1130 Lisp_Object res = Qnil;
1047 int err; 1131 int err;
@@ -1209,6 +1293,10 @@ gnutls_certificate_details (gnutls_x509_crt_t cert)
1209 xfree (buf); 1293 xfree (buf);
1210 } 1294 }
1211 1295
1296 /* PEM */
1297 res = nconc2 (res, list2 (intern (":pem"),
1298 emacs_gnutls_certificate_export_pem(cert)));
1299
1212 return res; 1300 return res;
1213} 1301}
1214 1302
@@ -1246,6 +1334,29 @@ DEFUN ("gnutls-peer-status-warning-describe", Fgnutls_peer_status_warning_descri
1246 if (EQ (status_symbol, intern (":no-host-match"))) 1334 if (EQ (status_symbol, intern (":no-host-match")))
1247 return build_string ("certificate host does not match hostname"); 1335 return build_string ("certificate host does not match hostname");
1248 1336
1337 if (EQ (status_symbol, intern (":signature-failure")))
1338 return build_string ("certificate signature could not be verified");
1339
1340 if (EQ (status_symbol, intern (":revocation-data-superseded")))
1341 return build_string ("certificate revocation data are old and have been "
1342 "superseded");
1343
1344 if (EQ (status_symbol, intern (":revocation-data-issued-in-future")))
1345 return build_string ("certificate revocation data have a future issue date");
1346
1347 if (EQ (status_symbol, intern (":signer-constraints-failure")))
1348 return build_string ("certificate signer constraints were violated");
1349
1350 if (EQ (status_symbol, intern (":purpose-mismatch")))
1351 return build_string ("certificate does not match the intended purpose");
1352
1353 if (EQ (status_symbol, intern (":missing-ocsp-status")))
1354 return build_string ("certificate requires the server to send a OCSP "
1355 "certificate status, but no status was received");
1356
1357 if (EQ (status_symbol, intern (":invalid-ocsp-status")))
1358 return build_string ("the received OCSP certificate status is invalid");
1359
1249 return Qnil; 1360 return Qnil;
1250} 1361}
1251 1362
@@ -1297,6 +1408,35 @@ returned as the :certificate entry. */)
1297 if (verification & GNUTLS_CERT_EXPIRED) 1408 if (verification & GNUTLS_CERT_EXPIRED)
1298 warnings = Fcons (intern (":expired"), warnings); 1409 warnings = Fcons (intern (":expired"), warnings);
1299 1410
1411#if GNUTLS_VERSION_NUMBER >= 0x030100
1412 if (verification & GNUTLS_CERT_SIGNATURE_FAILURE)
1413 warnings = Fcons (intern (":signature-failure"), warnings);
1414
1415# if GNUTLS_VERSION_NUMBER >= 0x030114
1416 if (verification & GNUTLS_CERT_REVOCATION_DATA_SUPERSEDED)
1417 warnings = Fcons (intern (":revocation-data-superseded"), warnings);
1418
1419 if (verification & GNUTLS_CERT_REVOCATION_DATA_ISSUED_IN_FUTURE)
1420 warnings = Fcons (intern (":revocation-data-issued-in-future"), warnings);
1421
1422 if (verification & GNUTLS_CERT_SIGNER_CONSTRAINTS_FAILURE)
1423 warnings = Fcons (intern (":signer-constraints-failure"), warnings);
1424
1425# if GNUTLS_VERSION_NUMBER >= 0x030400
1426 if (verification & GNUTLS_CERT_PURPOSE_MISMATCH)
1427 warnings = Fcons (intern (":purpose-mismatch"), warnings);
1428
1429# if GNUTLS_VERSION_NUMBER >= 0x030501
1430 if (verification & GNUTLS_CERT_MISSING_OCSP_STATUS)
1431 warnings = Fcons (intern (":missing-ocsp-status"), warnings);
1432
1433 if (verification & GNUTLS_CERT_INVALID_OCSP_STATUS)
1434 warnings = Fcons (intern (":invalid-ocsp-status"), warnings);
1435# endif
1436# endif
1437# endif
1438#endif
1439
1300 if (XPROCESS (proc)->gnutls_extra_peer_verification & 1440 if (XPROCESS (proc)->gnutls_extra_peer_verification &
1301 CERTIFICATE_NOT_MATCHING) 1441 CERTIFICATE_NOT_MATCHING)
1302 warnings = Fcons (intern (":no-host-match"), warnings); 1442 warnings = Fcons (intern (":no-host-match"), warnings);
@@ -1319,7 +1459,7 @@ returned as the :certificate entry. */)
1319 1459
1320 /* Return all the certificates in a list. */ 1460 /* Return all the certificates in a list. */
1321 for (int i = 0; i < XPROCESS (proc)->gnutls_certificates_length; i++) 1461 for (int i = 0; i < XPROCESS (proc)->gnutls_certificates_length; i++)
1322 certs = nconc2 (certs, list1 (gnutls_certificate_details 1462 certs = nconc2 (certs, list1 (emacs_gnutls_certificate_details
1323 (XPROCESS (proc)->gnutls_certificates[i]))); 1463 (XPROCESS (proc)->gnutls_certificates[i])));
1324 1464
1325 result = nconc2 (result, list2 (intern (":certificates"), certs)); 1465 result = nconc2 (result, list2 (intern (":certificates"), certs));
@@ -1347,10 +1487,10 @@ returned as the :certificate entry. */)
1347 (gnutls_kx_get (state))))); 1487 (gnutls_kx_get (state)))));
1348 1488
1349 /* Protocol name. */ 1489 /* Protocol name. */
1490 gnutls_protocol_t proto = gnutls_protocol_get_version (state);
1350 result = nconc2 1491 result = nconc2
1351 (result, list2 (intern (":protocol"), 1492 (result, list2 (intern (":protocol"),
1352 build_string (gnutls_protocol_get_name 1493 build_string (gnutls_protocol_get_name (proto))));
1353 (gnutls_protocol_get_version (state)))));
1354 1494
1355 /* Cipher name. */ 1495 /* Cipher name. */
1356 result = nconc2 1496 result = nconc2
@@ -1364,6 +1504,26 @@ returned as the :certificate entry. */)
1364 build_string (gnutls_mac_get_name 1504 build_string (gnutls_mac_get_name
1365 (gnutls_mac_get (state))))); 1505 (gnutls_mac_get (state)))));
1366 1506
1507 /* Compression name. */
1508#ifdef HAVE_GNUTLS_COMPRESSION_GET
1509 result = nconc2
1510 (result, list2 (intern (":compression"),
1511 build_string (gnutls_compression_get_name
1512 (gnutls_compression_get (state)))));
1513#endif
1514
1515 /* Encrypt-then-MAC. */
1516#ifdef HAVE_GNUTLS_ETM_STATUS
1517 result = nconc2
1518 (result, list2 (intern (":encrypt-then-mac"),
1519 gnutls_session_etm_status (state) ? Qt : Qnil));
1520#endif
1521
1522 /* Renegotiation Indication */
1523 if (proto <= GNUTLS_TLS1_2)
1524 result = nconc2
1525 (result, list2 (intern (":safe-renegotiation"),
1526 gnutls_safe_renegotiation_status (state) ? Qt : Qnil));
1367 1527
1368 return result; 1528 return result;
1369} 1529}
@@ -1425,6 +1585,52 @@ boot_error (struct Lisp_Process *p, const char *m, ...)
1425 va_end (ap); 1585 va_end (ap);
1426} 1586}
1427 1587
1588DEFUN ("gnutls-format-certificate", Fgnutls_format_certificate,
1589 Sgnutls_format_certificate, 1, 1, 0,
1590 doc: /* Format a X.509 certificate to a string.
1591
1592Given a PEM-encoded X.509 certificate CERT, returns a human-readable
1593string representation. */)
1594 (Lisp_Object cert)
1595{
1596 CHECK_STRING (cert);
1597
1598 int err;
1599 gnutls_x509_crt_t crt;
1600
1601 err = gnutls_x509_crt_init (&crt);
1602 check_memory_full (err);
1603 if (err < GNUTLS_E_SUCCESS)
1604 error ("gnutls-format-certificate error: %s", emacs_gnutls_strerror (err));
1605
1606 gnutls_datum_t crt_data = { SDATA (cert), strlen (SSDATA (cert)) };
1607 err = gnutls_x509_crt_import (crt, &crt_data, GNUTLS_X509_FMT_PEM);
1608 check_memory_full (err);
1609 if (err < GNUTLS_E_SUCCESS)
1610 {
1611 gnutls_x509_crt_deinit (crt);
1612 error ("gnutls-format-certificate error: %s",
1613 emacs_gnutls_strerror (err));
1614 }
1615
1616 gnutls_datum_t out;
1617 err = gnutls_x509_crt_print (crt, GNUTLS_CRT_PRINT_FULL, &out);
1618 check_memory_full (err);
1619 if (err < GNUTLS_E_SUCCESS)
1620 {
1621 gnutls_x509_crt_deinit (crt);
1622 error ("gnutls-format-certificate error: %s",
1623 emacs_gnutls_strerror (err));
1624 }
1625
1626 Lisp_Object result = make_string_from_bytes ((char *) out.data, out.size,
1627 out.size);
1628 gnutls_free (out.data);
1629 gnutls_x509_crt_deinit (crt);
1630
1631 return result;
1632}
1633
1428Lisp_Object 1634Lisp_Object
1429gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist) 1635gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist)
1430{ 1636{
@@ -2706,6 +2912,7 @@ syms_of_gnutls (void)
2706 defsubr (&Sgnutls_bye); 2912 defsubr (&Sgnutls_bye);
2707 defsubr (&Sgnutls_peer_status); 2913 defsubr (&Sgnutls_peer_status);
2708 defsubr (&Sgnutls_peer_status_warning_describe); 2914 defsubr (&Sgnutls_peer_status_warning_describe);
2915 defsubr (&Sgnutls_format_certificate);
2709 2916
2710#ifdef HAVE_GNUTLS3 2917#ifdef HAVE_GNUTLS3
2711 defsubr (&Sgnutls_ciphers); 2918 defsubr (&Sgnutls_ciphers);
diff --git a/src/image.c b/src/image.c
index 81d8cb4e2b2..fe7bd90b051 100644
--- a/src/image.c
+++ b/src/image.c
@@ -6234,7 +6234,10 @@ DEF_DLL_FN (void, png_read_info, (png_structp, png_infop));
6234DEF_DLL_FN (png_uint_32, png_get_IHDR, 6234DEF_DLL_FN (png_uint_32, png_get_IHDR,
6235 (png_structp, png_infop, png_uint_32 *, png_uint_32 *, 6235 (png_structp, png_infop, png_uint_32 *, png_uint_32 *,
6236 int *, int *, int *, int *, int *)); 6236 int *, int *, int *, int *, int *));
6237DEF_DLL_FN (png_uint_32, png_get_valid, (png_structp, png_infop, png_uint_32)); 6237# ifdef PNG_tRNS_SUPPORTED
6238DEF_DLL_FN (png_uint_32, png_get_tRNS, (png_structp, png_infop, png_bytep *,
6239 int *, png_color_16p *));
6240# endif
6238DEF_DLL_FN (void, png_set_strip_16, (png_structp)); 6241DEF_DLL_FN (void, png_set_strip_16, (png_structp));
6239DEF_DLL_FN (void, png_set_expand, (png_structp)); 6242DEF_DLL_FN (void, png_set_expand, (png_structp));
6240DEF_DLL_FN (void, png_set_gray_to_rgb, (png_structp)); 6243DEF_DLL_FN (void, png_set_gray_to_rgb, (png_structp));
@@ -6273,7 +6276,9 @@ init_png_functions (void)
6273 LOAD_DLL_FN (library, png_set_sig_bytes); 6276 LOAD_DLL_FN (library, png_set_sig_bytes);
6274 LOAD_DLL_FN (library, png_read_info); 6277 LOAD_DLL_FN (library, png_read_info);
6275 LOAD_DLL_FN (library, png_get_IHDR); 6278 LOAD_DLL_FN (library, png_get_IHDR);
6276 LOAD_DLL_FN (library, png_get_valid); 6279# ifdef PNG_tRNS_SUPPORTED
6280 LOAD_DLL_FN (library, png_get_tRNS);
6281# endif
6277 LOAD_DLL_FN (library, png_set_strip_16); 6282 LOAD_DLL_FN (library, png_set_strip_16);
6278 LOAD_DLL_FN (library, png_set_expand); 6283 LOAD_DLL_FN (library, png_set_expand);
6279 LOAD_DLL_FN (library, png_set_gray_to_rgb); 6284 LOAD_DLL_FN (library, png_set_gray_to_rgb);
@@ -6304,7 +6309,7 @@ init_png_functions (void)
6304# undef png_get_IHDR 6309# undef png_get_IHDR
6305# undef png_get_io_ptr 6310# undef png_get_io_ptr
6306# undef png_get_rowbytes 6311# undef png_get_rowbytes
6307# undef png_get_valid 6312# undef png_get_tRNS
6308# undef png_longjmp 6313# undef png_longjmp
6309# undef png_read_end 6314# undef png_read_end
6310# undef png_read_image 6315# undef png_read_image
@@ -6329,7 +6334,7 @@ init_png_functions (void)
6329# define png_get_IHDR fn_png_get_IHDR 6334# define png_get_IHDR fn_png_get_IHDR
6330# define png_get_io_ptr fn_png_get_io_ptr 6335# define png_get_io_ptr fn_png_get_io_ptr
6331# define png_get_rowbytes fn_png_get_rowbytes 6336# define png_get_rowbytes fn_png_get_rowbytes
6332# define png_get_valid fn_png_get_valid 6337# define png_get_tRNS fn_png_get_tRNS
6333# define png_longjmp fn_png_longjmp 6338# define png_longjmp fn_png_longjmp
6334# define png_read_end fn_png_read_end 6339# define png_read_end fn_png_read_end
6335# define png_read_image fn_png_read_image 6340# define png_read_image fn_png_read_image
@@ -6589,10 +6594,22 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
6589 6594
6590 /* If image contains simply transparency data, we prefer to 6595 /* If image contains simply transparency data, we prefer to
6591 construct a clipping mask. */ 6596 construct a clipping mask. */
6592 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS)) 6597 transparent_p = false;
6593 transparent_p = 1; 6598# ifdef PNG_tRNS_SUPPORTED
6594 else 6599 png_bytep trans_alpha;
6595 transparent_p = 0; 6600 int num_trans;
6601 if (png_get_tRNS (png_ptr, info_ptr, &trans_alpha, &num_trans, NULL))
6602 {
6603 transparent_p = true;
6604 if (trans_alpha)
6605 for (int i = 0; i < num_trans; i++)
6606 if (0 < trans_alpha[i] && trans_alpha[i] < 255)
6607 {
6608 transparent_p = false;
6609 break;
6610 }
6611 }
6612# endif
6596 6613
6597 /* This function is easier to write if we only have to handle 6614 /* This function is easier to write if we only have to handle
6598 one data format: RGB or RGBA with 8 bits per channel. Let's 6615 one data format: RGB or RGBA with 8 bits per channel. Let's
@@ -6680,7 +6697,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
6680 /* Create an image and pixmap serving as mask if the PNG image 6697 /* Create an image and pixmap serving as mask if the PNG image
6681 contains an alpha channel. */ 6698 contains an alpha channel. */
6682 if (channels == 4 6699 if (channels == 4
6683 && !transparent_p 6700 && transparent_p
6684 && !image_create_x_image_and_pixmap (f, img, width, height, 1, 6701 && !image_create_x_image_and_pixmap (f, img, width, height, 1,
6685 &mask_img, 1)) 6702 &mask_img, 1))
6686 { 6703 {
diff --git a/src/keyboard.c b/src/keyboard.c
index 30686a25898..1b9a603ca17 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -8304,6 +8304,10 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
8304 AUTO_STRING (end, ")"); 8304 AUTO_STRING (end, ")");
8305 Lisp_Object orig = PROP (TOOL_BAR_ITEM_HELP); 8305 Lisp_Object orig = PROP (TOOL_BAR_ITEM_HELP);
8306 Lisp_Object desc = Fkey_description (keys, Qnil); 8306 Lisp_Object desc = Fkey_description (keys, Qnil);
8307
8308 if (NILP (orig))
8309 orig = PROP (TOOL_BAR_ITEM_CAPTION);
8310
8307 set_prop (TOOL_BAR_ITEM_HELP, CALLN (Fconcat, orig, beg, desc, end)); 8311 set_prop (TOOL_BAR_ITEM_HELP, CALLN (Fconcat, orig, beg, desc, end));
8308 } 8312 }
8309 8313
diff --git a/src/keymap.c b/src/keymap.c
index 6762915f70c..b1e09a92f20 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -3371,12 +3371,10 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
3371 3371
3372 if (!keymap_p) 3372 if (!keymap_p)
3373 { 3373 {
3374 /* Call Fkey_description first, to avoid GC bug for the other string. */
3375 if (!NILP (prefix) && XFIXNAT (Flength (prefix)) > 0) 3374 if (!NILP (prefix) && XFIXNAT (Flength (prefix)) > 0)
3376 { 3375 {
3377 Lisp_Object tem = Fkey_description (prefix, Qnil);
3378 AUTO_STRING (space, " "); 3376 AUTO_STRING (space, " ");
3379 elt_prefix = concat2 (tem, space); 3377 elt_prefix = concat2 (Fkey_description (prefix, Qnil), space);
3380 } 3378 }
3381 prefix = Qnil; 3379 prefix = Qnil;
3382 } 3380 }
diff --git a/src/lisp.h b/src/lisp.h
index 56ad99b8e39..a7b19ab576e 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2307,7 +2307,7 @@ struct Lisp_Hash_Table
2307 weakness of the table. */ 2307 weakness of the table. */
2308 Lisp_Object weak; 2308 Lisp_Object weak;
2309 2309
2310 /* Vector of hash codes. 2310 /* Vector of hash codes, or nil if the table needs rehashing.
2311 If the I-th entry is unused, then hash[I] should be nil. */ 2311 If the I-th entry is unused, then hash[I] should be nil. */
2312 Lisp_Object hash; 2312 Lisp_Object hash;
2313 2313
@@ -2327,8 +2327,7 @@ struct Lisp_Hash_Table
2327 'index' are special and are either ignored by the GC or traced in 2327 'index' are special and are either ignored by the GC or traced in
2328 a special way (e.g. because of weakness). */ 2328 a special way (e.g. because of weakness). */
2329 2329
2330 /* Number of key/value entries in the table. This number is 2330 /* Number of key/value entries in the table. */
2331 negated if the table needs rehashing. */
2332 ptrdiff_t count; 2331 ptrdiff_t count;
2333 2332
2334 /* Index of first free entry in free list, or -1 if none. */ 2333 /* Index of first free entry in free list, or -1 if none. */
@@ -2413,7 +2412,9 @@ HASH_HASH (const struct Lisp_Hash_Table *h, ptrdiff_t idx)
2413INLINE ptrdiff_t 2412INLINE ptrdiff_t
2414HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h) 2413HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
2415{ 2414{
2416 return ASIZE (h->next); 2415 ptrdiff_t size = ASIZE (h->next);
2416 eassume (0 < size);
2417 return size;
2417} 2418}
2418 2419
2419void hash_table_rehash (struct Lisp_Hash_Table *h); 2420void hash_table_rehash (struct Lisp_Hash_Table *h);
@@ -3614,7 +3615,6 @@ extern void set_default_internal (Lisp_Object, Lisp_Object,
3614extern Lisp_Object expt_integer (Lisp_Object, Lisp_Object); 3615extern Lisp_Object expt_integer (Lisp_Object, Lisp_Object);
3615extern void syms_of_data (void); 3616extern void syms_of_data (void);
3616extern void swap_in_global_binding (struct Lisp_Symbol *); 3617extern void swap_in_global_binding (struct Lisp_Symbol *);
3617extern Lisp_Object integer_mod (Lisp_Object, Lisp_Object);
3618 3618
3619/* Defined in cmds.c */ 3619/* Defined in cmds.c */
3620extern void syms_of_cmds (void); 3620extern void syms_of_cmds (void);
diff --git a/src/lread.c b/src/lread.c
index 1bfbf5aa865..6ae7a0d8ba0 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1064,18 +1064,13 @@ required.
1064This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */) 1064This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
1065 (void) 1065 (void)
1066{ 1066{
1067 Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext; 1067 Lisp_Object lst = Qnil, suffixes = Vload_suffixes;
1068 while (CONSP (suffixes)) 1068 FOR_EACH_TAIL (suffixes)
1069 { 1069 {
1070 Lisp_Object exts = Vload_file_rep_suffixes; 1070 Lisp_Object exts = Vload_file_rep_suffixes;
1071 suffix = XCAR (suffixes); 1071 Lisp_Object suffix = XCAR (suffixes);
1072 suffixes = XCDR (suffixes); 1072 FOR_EACH_TAIL (exts)
1073 while (CONSP (exts)) 1073 lst = Fcons (concat2 (suffix, XCAR (exts)), lst);
1074 {
1075 ext = XCAR (exts);
1076 exts = XCDR (exts);
1077 lst = Fcons (concat2 (suffix, ext), lst);
1078 }
1079 } 1074 }
1080 return Fnreverse (lst); 1075 return Fnreverse (lst);
1081} 1076}
@@ -1290,8 +1285,8 @@ Return t if the file exists and loads successfully. */)
1290 the general case; the second load may do something different. */ 1285 the general case; the second load may do something different. */
1291 { 1286 {
1292 int load_count = 0; 1287 int load_count = 0;
1293 Lisp_Object tem; 1288 Lisp_Object tem = Vloads_in_progress;
1294 for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem)) 1289 FOR_EACH_TAIL_SAFE (tem)
1295 if (!NILP (Fequal (found, XCAR (tem))) && (++load_count > 3)) 1290 if (!NILP (Fequal (found, XCAR (tem))) && (++load_count > 3))
1296 signal_error ("Recursive load", Fcons (found, Vloads_in_progress)); 1291 signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
1297 record_unwind_protect (record_load_unwind, Vloads_in_progress); 1292 record_unwind_protect (record_load_unwind, Vloads_in_progress);
@@ -1611,7 +1606,8 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1611 1606
1612 CHECK_STRING (str); 1607 CHECK_STRING (str);
1613 1608
1614 for (tail = suffixes; CONSP (tail); tail = XCDR (tail)) 1609 tail = suffixes;
1610 FOR_EACH_TAIL_SAFE (tail)
1615 { 1611 {
1616 CHECK_STRING_CAR (tail); 1612 CHECK_STRING_CAR (tail);
1617 max_suffix_len = max (max_suffix_len, 1613 max_suffix_len = max (max_suffix_len,
@@ -1625,12 +1621,17 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1625 1621
1626 absolute = complete_filename_p (str); 1622 absolute = complete_filename_p (str);
1627 1623
1624 AUTO_LIST1 (just_use_str, Qnil);
1625 if (NILP (path))
1626 path = just_use_str;
1627
1628 /* Go through all entries in the path and see whether we find the 1628 /* Go through all entries in the path and see whether we find the
1629 executable. */ 1629 executable. */
1630 do { 1630 FOR_EACH_TAIL_SAFE (path)
1631 {
1631 ptrdiff_t baselen, prefixlen; 1632 ptrdiff_t baselen, prefixlen;
1632 1633
1633 if (NILP (path)) 1634 if (EQ (path, just_use_str))
1634 filename = str; 1635 filename = str;
1635 else 1636 else
1636 filename = Fexpand_file_name (str, XCAR (path)); 1637 filename = Fexpand_file_name (str, XCAR (path));
@@ -1663,8 +1664,9 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1663 memcpy (fn, SDATA (filename) + prefixlen, baselen); 1664 memcpy (fn, SDATA (filename) + prefixlen, baselen);
1664 1665
1665 /* Loop over suffixes. */ 1666 /* Loop over suffixes. */
1666 for (tail = NILP (suffixes) ? list1 (empty_unibyte_string) : suffixes; 1667 AUTO_LIST1 (empty_string_only, empty_unibyte_string);
1667 CONSP (tail); tail = XCDR (tail)) 1668 tail = NILP (suffixes) ? empty_string_only : suffixes;
1669 FOR_EACH_TAIL_SAFE (tail)
1668 { 1670 {
1669 Lisp_Object suffix = XCAR (tail); 1671 Lisp_Object suffix = XCAR (tail);
1670 ptrdiff_t fnlen, lsuffix = SBYTES (suffix); 1672 ptrdiff_t fnlen, lsuffix = SBYTES (suffix);
@@ -1808,10 +1810,9 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1808 } 1810 }
1809 } 1811 }
1810 } 1812 }
1811 if (absolute || NILP (path)) 1813 if (absolute)
1812 break; 1814 break;
1813 path = XCDR (path); 1815 }
1814 } while (CONSP (path));
1815 1816
1816 SAFE_FREE (); 1817 SAFE_FREE ();
1817 errno = last_errno; 1818 errno = last_errno;
@@ -1838,7 +1839,7 @@ build_load_history (Lisp_Object filename, bool entire)
1838 tail = Vload_history; 1839 tail = Vload_history;
1839 prev = Qnil; 1840 prev = Qnil;
1840 1841
1841 while (CONSP (tail)) 1842 FOR_EACH_TAIL (tail)
1842 { 1843 {
1843 tem = XCAR (tail); 1844 tem = XCAR (tail);
1844 1845
@@ -1861,22 +1862,19 @@ build_load_history (Lisp_Object filename, bool entire)
1861 { 1862 {
1862 tem2 = Vcurrent_load_list; 1863 tem2 = Vcurrent_load_list;
1863 1864
1864 while (CONSP (tem2)) 1865 FOR_EACH_TAIL (tem2)
1865 { 1866 {
1866 newelt = XCAR (tem2); 1867 newelt = XCAR (tem2);
1867 1868
1868 if (NILP (Fmember (newelt, tem))) 1869 if (NILP (Fmember (newelt, tem)))
1869 Fsetcar (tail, Fcons (XCAR (tem), 1870 Fsetcar (tail, Fcons (XCAR (tem),
1870 Fcons (newelt, XCDR (tem)))); 1871 Fcons (newelt, XCDR (tem))));
1871
1872 tem2 = XCDR (tem2);
1873 maybe_quit (); 1872 maybe_quit ();
1874 } 1873 }
1875 } 1874 }
1876 } 1875 }
1877 else 1876 else
1878 prev = tail; 1877 prev = tail;
1879 tail = XCDR (tail);
1880 maybe_quit (); 1878 maybe_quit ();
1881 } 1879 }
1882 1880
@@ -1918,10 +1916,9 @@ readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand)
1918 if (EQ (CAR_SAFE (val), Qprogn)) 1916 if (EQ (CAR_SAFE (val), Qprogn))
1919 { 1917 {
1920 Lisp_Object subforms = XCDR (val); 1918 Lisp_Object subforms = XCDR (val);
1921 1919 val = Qnil;
1922 for (val = Qnil; CONSP (subforms); subforms = XCDR (subforms)) 1920 FOR_EACH_TAIL (subforms)
1923 val = readevalloop_eager_expand_eval (XCAR (subforms), 1921 val = readevalloop_eager_expand_eval (XCAR (subforms), macroexpand);
1924 macroexpand);
1925 } 1922 }
1926 else 1923 else
1927 val = eval_sub (call2 (macroexpand, val, Qt)); 1924 val = eval_sub (call2 (macroexpand, val, Qt));
@@ -2588,7 +2585,8 @@ read_escape (Lisp_Object readcharfun, bool stringp)
2588 want. */ 2585 want. */
2589 int digit = char_hexdigit (c); 2586 int digit = char_hexdigit (c);
2590 if (digit < 0) 2587 if (digit < 0)
2591 error ("Non-hex digit used for Unicode escape"); 2588 error ("Non-hex character used for Unicode escape: %c (%d)",
2589 c, c);
2592 i = (i << 4) + digit; 2590 i = (i << 4) + digit;
2593 } 2591 }
2594 if (i > 0x10FFFF) 2592 if (i > 0x10FFFF)
@@ -2861,16 +2859,19 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
2861 /* Now use params to make a new hash table and fill it. */ 2859 /* Now use params to make a new hash table and fill it. */
2862 ht = Fmake_hash_table (param_count, params); 2860 ht = Fmake_hash_table (param_count, params);
2863 2861
2864 while (CONSP (data)) 2862 Lisp_Object last = data;
2865 { 2863 FOR_EACH_TAIL_SAFE (data)
2864 {
2866 key = XCAR (data); 2865 key = XCAR (data);
2867 data = XCDR (data); 2866 data = XCDR (data);
2868 if (!CONSP (data)) 2867 if (!CONSP (data))
2869 error ("Odd number of elements in hash table data"); 2868 break;
2870 val = XCAR (data); 2869 val = XCAR (data);
2871 data = XCDR (data); 2870 last = XCDR (data);
2872 Fputhash (key, val, ht); 2871 Fputhash (key, val, ht);
2873 } 2872 }
2873 if (!NILP (last))
2874 error ("Hash table data is not a list of even length");
2874 2875
2875 return ht; 2876 return ht;
2876 } 2877 }
diff --git a/src/mini-gmp.c b/src/mini-gmp.c
index 88b71c3f9a6..e92e7cf9c72 100644
--- a/src/mini-gmp.c
+++ b/src/mini-gmp.c
@@ -2,7 +2,7 @@
2 2
3 Contributed to the GNU project by Niels Möller 3 Contributed to the GNU project by Niels Möller
4 4
5Copyright 1991-1997, 1999-2018 Free Software Foundation, Inc. 5Copyright 1991-1997, 1999-2019 Free Software Foundation, Inc.
6 6
7This file is part of the GNU MP Library. 7This file is part of the GNU MP Library.
8 8
@@ -295,7 +295,7 @@ gmp_default_alloc (size_t size)
295} 295}
296 296
297static void * 297static void *
298gmp_default_realloc (void *old, size_t old_size, size_t new_size) 298gmp_default_realloc (void *old, size_t unused_old_size, size_t new_size)
299{ 299{
300 void * p; 300 void * p;
301 301
@@ -308,7 +308,7 @@ gmp_default_realloc (void *old, size_t old_size, size_t new_size)
308} 308}
309 309
310static void 310static void
311gmp_default_free (void *p, size_t size) 311gmp_default_free (void *p, size_t unused_size)
312{ 312{
313 free (p); 313 free (p);
314} 314}
@@ -1595,7 +1595,7 @@ mpz_get_ui (const mpz_t u)
1595 int LOCAL_GMP_LIMB_BITS = GMP_LIMB_BITS; 1595 int LOCAL_GMP_LIMB_BITS = GMP_LIMB_BITS;
1596 unsigned long r = 0; 1596 unsigned long r = 0;
1597 mp_size_t n = GMP_ABS (u->_mp_size); 1597 mp_size_t n = GMP_ABS (u->_mp_size);
1598 n = GMP_MIN (n, 1 + (GMP_ULONG_BITS - 1) / GMP_LIMB_BITS); 1598 n = GMP_MIN (n, 1 + (mp_size_t) (GMP_ULONG_BITS - 1) / GMP_LIMB_BITS);
1599 while (--n >= 0) 1599 while (--n >= 0)
1600 r = (r << LOCAL_GMP_LIMB_BITS) + u->_mp_d[n]; 1600 r = (r << LOCAL_GMP_LIMB_BITS) + u->_mp_d[n];
1601 return r; 1601 return r;
@@ -3499,7 +3499,7 @@ gmp_stronglucas (const mpz_t x, mpz_t Qk)
3499 b0 = mpz_scan0 (n, 0); 3499 b0 = mpz_scan0 (n, 0);
3500 3500
3501 /* D= P^2 - 4Q; P = 1; Q = (1-D)/4 */ 3501 /* D= P^2 - 4Q; P = 1; Q = (1-D)/4 */
3502 Q = (D & 2) ? (D >> 2) + 1 : -(long) (D >> 2); 3502 Q = (D & 2) ? (long) (D >> 2) + 1 : -(long) (D >> 2);
3503 3503
3504 if (! gmp_lucas_mod (V, Qk, Q, b0, n)) /* If Ud != 0 */ 3504 if (! gmp_lucas_mod (V, Qk, Q, b0, n)) /* If Ud != 0 */
3505 while (V->_mp_size != 0 && --b0 != 0) /* while Vk != 0 */ 3505 while (V->_mp_size != 0 && --b0 != 0) /* while Vk != 0 */
diff --git a/src/minibuf.c b/src/minibuf.c
index 14a0dbe762c..f6cf47f1f28 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -169,7 +169,8 @@ string_to_object (Lisp_Object val, Lisp_Object defalt)
169 { 169 {
170 int c = SREF (val, i); 170 int c = SREF (val, i);
171 if (c != ' ' && c != '\t' && c != '\n') 171 if (c != ' ' && c != '\t' && c != '\n')
172 error ("Trailing garbage following expression"); 172 xsignal1 (Qinvalid_read_syntax,
173 build_string ("Trailing garbage following expression"));
173 } 174 }
174 } 175 }
175 176
diff --git a/src/pdumper.c b/src/pdumper.c
index 326a346a632..98090238b1a 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -105,8 +105,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
105# define VM_SUPPORTED 0 105# define VM_SUPPORTED 0
106#endif 106#endif
107 107
108#define DANGEROUS 0
109
110/* PDUMPER_CHECK_REHASHING being true causes the portable dumper to 108/* PDUMPER_CHECK_REHASHING being true causes the portable dumper to
111 check, for each hash table it dumps, that the hash table means the 109 check, for each hash table it dumps, that the hash table means the
112 same thing after rehashing. */ 110 same thing after rehashing. */
@@ -129,7 +127,11 @@ verify (sizeof (ptrdiff_t) <= sizeof (Lisp_Object));
129verify (sizeof (ptrdiff_t) <= sizeof (EMACS_INT)); 127verify (sizeof (ptrdiff_t) <= sizeof (EMACS_INT));
130verify (CHAR_BIT == 8); 128verify (CHAR_BIT == 8);
131 129
132#define DIVIDE_ROUND_UP(x, y) (((x) + (y) - 1) / (y)) 130static size_t
131divide_round_up (size_t x, size_t y)
132{
133 return (x + y - 1) / y;
134}
133 135
134static const char dump_magic[16] = { 136static const char dump_magic[16] = {
135 'D', 'U', 'M', 'P', 'E', 'D', 137 'D', 'U', 'M', 'P', 'E', 'D',
@@ -235,9 +237,12 @@ enum emacs_reloc_type
235 RELOC_EMACS_EMACS_LV, 237 RELOC_EMACS_EMACS_LV,
236 }; 238 };
237 239
238#define EMACS_RELOC_TYPE_BITS 3 240enum
239#define EMACS_RELOC_LENGTH_BITS \ 241 {
240 (sizeof (dump_off) * CHAR_BIT - EMACS_RELOC_TYPE_BITS) 242 EMACS_RELOC_TYPE_BITS = 3,
243 EMACS_RELOC_LENGTH_BITS = (sizeof (dump_off) * CHAR_BIT
244 - EMACS_RELOC_TYPE_BITS)
245 };
241 246
242struct emacs_reloc 247struct emacs_reloc
243{ 248{
@@ -274,19 +279,22 @@ struct dump_table_locator
274 dump_off nr_entries; 279 dump_off nr_entries;
275}; 280};
276 281
277#define DUMP_RELOC_TYPE_BITS 5 282enum
278verify (RELOC_DUMP_TO_EMACS_LV + 8 < (1 << DUMP_RELOC_TYPE_BITS)); 283 {
284 DUMP_RELOC_TYPE_BITS = 5,
285 DUMP_RELOC_ALIGNMENT_BITS = 2,
279 286
280#define DUMP_RELOC_ALIGNMENT_BITS 2 287 /* Minimum alignment required by dump file format. */
281#define DUMP_RELOC_OFFSET_BITS \ 288 DUMP_RELOCATION_ALIGNMENT = 1 << DUMP_RELOC_ALIGNMENT_BITS,
282 (sizeof (dump_off) * CHAR_BIT - DUMP_RELOC_TYPE_BITS)
283 289
284/* Minimum alignment required by dump file format. */ 290 /* The alignment granularity (in bytes) for objects we store in the
285#define DUMP_RELOCATION_ALIGNMENT (1<<DUMP_RELOC_ALIGNMENT_BITS) 291 dump. Always suitable for heap objects; may be more aligned. */
292 DUMP_ALIGNMENT = max (GCALIGNMENT, DUMP_RELOCATION_ALIGNMENT),
293
294 DUMP_RELOC_OFFSET_BITS = sizeof (dump_off) * CHAR_BIT - DUMP_RELOC_TYPE_BITS
295 };
286 296
287/* The alignment granularity (in bytes) for objects we store in the 297verify (RELOC_DUMP_TO_EMACS_LV + 8 < (1 << DUMP_RELOC_TYPE_BITS));
288 dump. Always suitable for heap objects; may be more aligned. */
289#define DUMP_ALIGNMENT (max (GCALIGNMENT, DUMP_RELOCATION_ALIGNMENT))
290verify (DUMP_ALIGNMENT >= GCALIGNMENT); 298verify (DUMP_ALIGNMENT >= GCALIGNMENT);
291 299
292struct dump_reloc 300struct dump_reloc
@@ -572,23 +580,17 @@ enum dump_object_special_offset
572 }; 580 };
573 581
574/* Weights for score scores for object non-locality. */ 582/* Weights for score scores for object non-locality. */
575enum link_weight_enum
576 {
577 WEIGHT_NONE_VALUE = 0,
578 WEIGHT_NORMAL_VALUE = 1000,
579 WEIGHT_STRONG_VALUE = 1200,
580 };
581 583
582struct link_weight 584struct link_weight
583{ 585{
584 /* Wrapped in a struct to break unwanted implicit conversion. */ 586 /* Wrapped in a struct to break unwanted implicit conversion. */
585 enum link_weight_enum value; 587 int value;
586}; 588};
587 589
588#define LINK_WEIGHT_LITERAL(x) ((struct link_weight){.value=(x)}) 590static struct link_weight const
589#define WEIGHT_NONE LINK_WEIGHT_LITERAL (WEIGHT_NONE_VALUE) 591 WEIGHT_NONE = { .value = 0 },
590#define WEIGHT_NORMAL LINK_WEIGHT_LITERAL (WEIGHT_NORMAL_VALUE) 592 WEIGHT_NORMAL = { .value = 1000 },
591#define WEIGHT_STRONG LINK_WEIGHT_LITERAL (WEIGHT_STRONG_VALUE) 593 WEIGHT_STRONG = { .value = 1200 };
592 594
593 595
594/* Dump file creation */ 596/* Dump file creation */
@@ -628,35 +630,27 @@ dump_set_have_current_referrer (struct dump_context *ctx, bool have)
628#endif 630#endif
629} 631}
630 632
631/* Remember the reason objects are enqueued. 633/* Return true if if objects should be enqueued in CTX to refer to an
634 object that the caller should store into CTX->current_referrer.
632 635
633 Until DUMP_CLEAR_REFERRER is called, any objects enqueued are being 636 Until dump_clear_referrer is called, any objects enqueued are being
634 enqueued because OBJECT refers to them. It is not legal to enqueue 637 enqueued because the object refers to them. It is not valid to
635 objects without a referer set. We check this constraint 638 enqueue objects without a referrer set. We check this constraint
636 at runtime. 639 at runtime.
637 640
638 It is illegal to call DUMP_SET_REFERRER twice without an 641 It is invalid to call dump_set_referrer twice without an
639 intervening call to DUMP_CLEAR_REFERRER. 642 intervening call to dump_clear_referrer. */
640 643static bool
641 Define as a macro so we can avoid evaluating OBJECT 644dump_set_referrer (struct dump_context *ctx)
642 if we dont want referrer tracking. */ 645{
643#define DUMP_SET_REFERRER(ctx, object) \ 646 eassert (!ctx->have_current_referrer);
644 do \ 647 dump_set_have_current_referrer (ctx, true);
645 { \ 648 return dump_tracking_referrers_p (ctx);
646 struct dump_context *_ctx = (ctx); \ 649}
647 eassert (!_ctx->have_current_referrer); \ 650
648 dump_set_have_current_referrer (_ctx, true); \ 651/* Unset the referrer that dump_set_referrer prepared for. */
649 if (dump_tracking_referrers_p (_ctx)) \
650 ctx->current_referrer = (object); \
651 } \
652 while (0)
653
654/* Unset the referer that DUMP_SET_REFERRER set.
655
656 Named with upper-case letters for symmetry with
657 DUMP_SET_REFERRER. */
658static void 652static void
659DUMP_CLEAR_REFERRER (struct dump_context *ctx) 653dump_clear_referrer (struct dump_context *ctx)
660{ 654{
661 eassert (ctx->have_current_referrer); 655 eassert (ctx->have_current_referrer);
662 dump_set_have_current_referrer (ctx, false); 656 dump_set_have_current_referrer (ctx, false);
@@ -732,34 +726,36 @@ dump_object_self_representing_p (Lisp_Object object)
732 return FIXNUMP (object) || dump_builtin_symbol_p (object); 726 return FIXNUMP (object) || dump_builtin_symbol_p (object);
733} 727}
734 728
735#define DEFINE_FROMLISP_FUNC(fn, type) \ 729static intmax_t
736 static type \ 730intmax_t_from_lisp (Lisp_Object value)
737 fn (Lisp_Object value) \ 731{
738 { \ 732 intmax_t n;
739 ALLOW_IMPLICIT_CONVERSION; \ 733 bool ok = integer_to_intmax (value, &n);
740 if (FIXNUMP (value)) \ 734 eassert (ok);
741 return XFIXNUM (value); \ 735 return n;
742 eassert (BIGNUMP (value)); \ 736}
743 type result; \
744 if (TYPE_SIGNED (type)) \
745 result = bignum_to_intmax (value); \
746 else \
747 result = bignum_to_uintmax (value); \
748 DISALLOW_IMPLICIT_CONVERSION; \
749 return result; \
750 }
751 737
752#define DEFINE_TOLISP_FUNC(fn, type) \ 738static Lisp_Object
753 static Lisp_Object \ 739intmax_t_to_lisp (intmax_t value)
754 fn (type value) \ 740{
755 { \ 741 return INT_TO_INTEGER (value);
756 return INT_TO_INTEGER (value); \ 742}
757 } 743
744static dump_off
745dump_off_from_lisp (Lisp_Object value)
746{
747 intmax_t n = intmax_t_from_lisp (value);
748 eassert (DUMP_OFF_MIN <= n && n <= DUMP_OFF_MAX);
749 ALLOW_IMPLICIT_CONVERSION;
750 return n;
751 DISALLOW_IMPLICIT_CONVERSION;
752}
758 753
759DEFINE_FROMLISP_FUNC (intmax_t_from_lisp, intmax_t) 754static Lisp_Object
760DEFINE_TOLISP_FUNC (intmax_t_to_lisp, intmax_t) 755dump_off_to_lisp (dump_off value)
761DEFINE_FROMLISP_FUNC (dump_off_from_lisp, dump_off) 756{
762DEFINE_TOLISP_FUNC (dump_off_to_lisp, dump_off) 757 return INT_TO_INTEGER (value);
758}
763 759
764static void 760static void
765dump_write (struct dump_context *ctx, const void *buf, dump_off nbyte) 761dump_write (struct dump_context *ctx, const void *buf, dump_off nbyte)
@@ -1731,9 +1727,10 @@ dump_root_visitor (Lisp_Object const *root_ptr, enum gc_root_type type,
1731 eassert (dump_builtin_symbol_p (value)); 1727 eassert (dump_builtin_symbol_p (value));
1732 /* Remember to dump the object itself later along with all the 1728 /* Remember to dump the object itself later along with all the
1733 rest of the copied-to-Emacs objects. */ 1729 rest of the copied-to-Emacs objects. */
1734 DUMP_SET_REFERRER (ctx, build_string ("built-in symbol list")); 1730 if (dump_set_referrer (ctx))
1731 ctx->current_referrer = build_string ("built-in symbol list");
1735 dump_enqueue_object (ctx, value, WEIGHT_NONE); 1732 dump_enqueue_object (ctx, value, WEIGHT_NONE);
1736 DUMP_CLEAR_REFERRER (ctx); 1733 dump_clear_referrer (ctx);
1737 } 1734 }
1738 else 1735 else
1739 { 1736 {
@@ -1743,9 +1740,11 @@ dump_root_visitor (Lisp_Object const *root_ptr, enum gc_root_type type,
1743 ctx->staticpro_table); 1740 ctx->staticpro_table);
1744 if (root_ptr != &Vinternal_interpreter_environment) 1741 if (root_ptr != &Vinternal_interpreter_environment)
1745 { 1742 {
1746 DUMP_SET_REFERRER (ctx, dump_ptr_referrer ("emacs root", root_ptr)); 1743 if (dump_set_referrer (ctx))
1744 ctx->current_referrer
1745 = dump_ptr_referrer ("emacs root", root_ptr);
1747 dump_emacs_reloc_to_lv (ctx, root_ptr, *root_ptr); 1746 dump_emacs_reloc_to_lv (ctx, root_ptr, *root_ptr);
1748 DUMP_CLEAR_REFERRER (ctx); 1747 dump_clear_referrer (ctx);
1749 } 1748 }
1750 } 1749 }
1751} 1750}
@@ -1759,7 +1758,7 @@ dump_roots (struct dump_context *ctx)
1759 visit_static_gc_roots (visitor); 1758 visit_static_gc_roots (visitor);
1760} 1759}
1761 1760
1762#define PDUMPER_MAX_OBJECT_SIZE 2048 1761enum { PDUMPER_MAX_OBJECT_SIZE = 2048 };
1763 1762
1764static dump_off 1763static dump_off
1765field_relpos (const void *in_start, const void *in_field) 1764field_relpos (const void *in_start, const void *in_field)
@@ -1788,11 +1787,7 @@ cpyptr (void *out, const void *in)
1788 1787
1789/* Convenience macro for regular assignment. */ 1788/* Convenience macro for regular assignment. */
1790#define DUMP_FIELD_COPY(out, in, name) \ 1789#define DUMP_FIELD_COPY(out, in, name) \
1791 do \ 1790 ((out)->name = (in)->name)
1792 { \
1793 (out)->name = (in)->name; \
1794 } \
1795 while (0)
1796 1791
1797static void 1792static void
1798dump_field_lv_or_rawptr (struct dump_context *ctx, 1793dump_field_lv_or_rawptr (struct dump_context *ctx,
@@ -1848,6 +1843,7 @@ dump_field_lv_or_rawptr (struct dump_context *ctx,
1848 intptr_t out_value; 1843 intptr_t out_value;
1849 dump_off out_field_offset = ctx->obj_offset + relpos; 1844 dump_off out_field_offset = ctx->obj_offset + relpos;
1850 dump_off target_offset = dump_recall_object (ctx, value); 1845 dump_off target_offset = dump_recall_object (ctx, value);
1846 enum { DANGEROUS = false };
1851 if (DANGEROUS 1847 if (DANGEROUS
1852 && target_offset > 0 && dump_object_emacs_ptr (value) == NULL) 1848 && target_offset > 0 && dump_object_emacs_ptr (value) == NULL)
1853 { 1849 {
@@ -2211,7 +2207,7 @@ dump_bignum (struct dump_context *ctx, Lisp_Object object)
2211 const struct Lisp_Bignum *bignum = XBIGNUM (object); 2207 const struct Lisp_Bignum *bignum = XBIGNUM (object);
2212 START_DUMP_PVEC (ctx, &bignum->header, struct Lisp_Bignum, out); 2208 START_DUMP_PVEC (ctx, &bignum->header, struct Lisp_Bignum, out);
2213 verify (sizeof (out->value) >= sizeof (struct bignum_reload_info)); 2209 verify (sizeof (out->value) >= sizeof (struct bignum_reload_info));
2214 dump_field_fixup_later (ctx, out, bignum, &bignum->value); 2210 dump_field_fixup_later (ctx, out, bignum, xbignum_val (object));
2215 dump_off bignum_offset = finish_dump_pvec (ctx, &out->header); 2211 dump_off bignum_offset = finish_dump_pvec (ctx, &out->header);
2216 if (ctx->flags.dump_object_contents) 2212 if (ctx->flags.dump_object_contents)
2217 { 2213 {
@@ -2408,7 +2404,8 @@ dump_pre_dump_symbol (struct dump_context *ctx, struct Lisp_Symbol *symbol)
2408{ 2404{
2409 Lisp_Object symbol_lv = make_lisp_symbol (symbol); 2405 Lisp_Object symbol_lv = make_lisp_symbol (symbol);
2410 eassert (!dump_recall_symbol_aux (ctx, symbol_lv)); 2406 eassert (!dump_recall_symbol_aux (ctx, symbol_lv));
2411 DUMP_SET_REFERRER (ctx, symbol_lv); 2407 if (dump_set_referrer (ctx))
2408 ctx->current_referrer = symbol_lv;
2412 switch (symbol->u.s.redirect) 2409 switch (symbol->u.s.redirect)
2413 { 2410 {
2414 case SYMBOL_LOCALIZED: 2411 case SYMBOL_LOCALIZED:
@@ -2422,7 +2419,7 @@ dump_pre_dump_symbol (struct dump_context *ctx, struct Lisp_Symbol *symbol)
2422 default: 2419 default:
2423 break; 2420 break;
2424 } 2421 }
2425 DUMP_CLEAR_REFERRER (ctx); 2422 dump_clear_referrer (ctx);
2426} 2423}
2427 2424
2428static dump_off 2425static dump_off
@@ -2443,13 +2440,14 @@ dump_symbol (struct dump_context *ctx,
2443 { 2440 {
2444 eassert (offset == DUMP_OBJECT_ON_NORMAL_QUEUE 2441 eassert (offset == DUMP_OBJECT_ON_NORMAL_QUEUE
2445 || offset == DUMP_OBJECT_NOT_SEEN); 2442 || offset == DUMP_OBJECT_NOT_SEEN);
2446 DUMP_CLEAR_REFERRER (ctx); 2443 dump_clear_referrer (ctx);
2447 struct dump_flags old_flags = ctx->flags; 2444 struct dump_flags old_flags = ctx->flags;
2448 ctx->flags.dump_object_contents = false; 2445 ctx->flags.dump_object_contents = false;
2449 ctx->flags.defer_symbols = false; 2446 ctx->flags.defer_symbols = false;
2450 dump_object (ctx, object); 2447 dump_object (ctx, object);
2451 ctx->flags = old_flags; 2448 ctx->flags = old_flags;
2452 DUMP_SET_REFERRER (ctx, object); 2449 if (dump_set_referrer (ctx))
2450 ctx->current_referrer = object;
2453 2451
2454 offset = DUMP_OBJECT_ON_SYMBOL_QUEUE; 2452 offset = DUMP_OBJECT_ON_SYMBOL_QUEUE;
2455 dump_remember_object (ctx, object, offset); 2453 dump_remember_object (ctx, object, offset);
@@ -2696,7 +2694,7 @@ dump_hash_table (struct dump_context *ctx,
2696 Lisp_Object object, 2694 Lisp_Object object,
2697 dump_off offset) 2695 dump_off offset)
2698{ 2696{
2699#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_BB1ACF756E 2697#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_12AFBF47AF
2700# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." 2698# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h."
2701#endif 2699#endif
2702 const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); 2700 const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object);
@@ -3118,7 +3116,8 @@ dump_object (struct dump_context *ctx, Lisp_Object object)
3118 } 3116 }
3119 3117
3120 /* Object needs to be dumped. */ 3118 /* Object needs to be dumped. */
3121 DUMP_SET_REFERRER (ctx, object); 3119 if (dump_set_referrer (ctx))
3120 ctx->current_referrer = object;
3122 switch (XTYPE (object)) 3121 switch (XTYPE (object))
3123 { 3122 {
3124 case Lisp_String: 3123 case Lisp_String:
@@ -3142,7 +3141,7 @@ dump_object (struct dump_context *ctx, Lisp_Object object)
3142 default: 3141 default:
3143 emacs_abort (); 3142 emacs_abort ();
3144 } 3143 }
3145 DUMP_CLEAR_REFERRER (ctx); 3144 dump_clear_referrer (ctx);
3146 3145
3147 /* offset can be < 0 if we've deferred an object. */ 3146 /* offset can be < 0 if we've deferred an object. */
3148 if (ctx->flags.dump_object_contents && offset > DUMP_OBJECT_NOT_SEEN) 3147 if (ctx->flags.dump_object_contents && offset > DUMP_OBJECT_NOT_SEEN)
@@ -3397,19 +3396,18 @@ dump_cold_buffer (struct dump_context *ctx, Lisp_Object data)
3397static void 3396static void
3398dump_cold_bignum (struct dump_context *ctx, Lisp_Object object) 3397dump_cold_bignum (struct dump_context *ctx, Lisp_Object object)
3399{ 3398{
3400 const struct Lisp_Bignum *bignum = XBIGNUM (object); 3399 mpz_t const *n = xbignum_val (object);
3401 size_t sz_nlimbs = mpz_size (bignum->value); 3400 size_t sz_nlimbs = mpz_size (*n);
3402 eassert (sz_nlimbs < DUMP_OFF_MAX); 3401 eassert (sz_nlimbs < DUMP_OFF_MAX);
3403 dump_align_output (ctx, alignof (mp_limb_t)); 3402 dump_align_output (ctx, alignof (mp_limb_t));
3404 dump_off nlimbs = (dump_off) sz_nlimbs; 3403 dump_off nlimbs = (dump_off) sz_nlimbs;
3405 Lisp_Object descriptor 3404 Lisp_Object descriptor
3406 = list2 (dump_off_to_lisp (ctx->offset), 3405 = list2 (dump_off_to_lisp (ctx->offset),
3407 dump_off_to_lisp ((mpz_sgn (bignum->value) < 0 3406 dump_off_to_lisp (mpz_sgn (*n) < 0 ? -nlimbs : nlimbs));
3408 ? -nlimbs : nlimbs)));
3409 Fputhash (object, descriptor, ctx->bignum_data); 3407 Fputhash (object, descriptor, ctx->bignum_data);
3410 for (mp_size_t i = 0; i < nlimbs; ++i) 3408 for (mp_size_t i = 0; i < nlimbs; ++i)
3411 { 3409 {
3412 mp_limb_t limb = mpz_getlimbn (bignum->value, i); 3410 mp_limb_t limb = mpz_getlimbn (*n, i);
3413 dump_write (ctx, &limb, sizeof (limb)); 3411 dump_write (ctx, &limb, sizeof (limb));
3414 } 3412 }
3415} 3413}
@@ -3508,9 +3506,10 @@ dump_drain_user_remembered_data_hot (struct dump_context *ctx)
3508 read_ptr_raw_and_lv (mem, type, &value, &lv); 3506 read_ptr_raw_and_lv (mem, type, &value, &lv);
3509 if (value != NULL) 3507 if (value != NULL)
3510 { 3508 {
3511 DUMP_SET_REFERRER (ctx, dump_ptr_referrer ("user data", mem)); 3509 if (dump_set_referrer (ctx))
3510 ctx->current_referrer = dump_ptr_referrer ("user data", mem);
3512 dump_enqueue_object (ctx, lv, WEIGHT_NONE); 3511 dump_enqueue_object (ctx, lv, WEIGHT_NONE);
3513 DUMP_CLEAR_REFERRER (ctx); 3512 dump_clear_referrer (ctx);
3514 } 3513 }
3515 } 3514 }
3516 } 3515 }
@@ -4735,7 +4734,7 @@ dump_mmap_release_vm (struct dump_memory_map *map)
4735static bool 4734static bool
4736needs_mmap_retry_p (void) 4735needs_mmap_retry_p (void)
4737{ 4736{
4738#if defined (CYGWIN) || VM_SUPPORTED == VM_MS_WINDOWS 4737#if defined CYGWIN || VM_SUPPORTED == VM_MS_WINDOWS || defined _AIX
4739 return true; 4738 return true;
4740#else 4739#else
4741 return false; 4740 return false;
@@ -4878,7 +4877,7 @@ dump_bitset_init (struct dump_bitset *bitset, size_t number_bits)
4878{ 4877{
4879 int xword_size = sizeof (bitset->bits[0]); 4878 int xword_size = sizeof (bitset->bits[0]);
4880 int bits_per_word = xword_size * CHAR_BIT; 4879 int bits_per_word = xword_size * CHAR_BIT;
4881 ptrdiff_t words_needed = DIVIDE_ROUND_UP (number_bits, bits_per_word); 4880 ptrdiff_t words_needed = divide_round_up (number_bits, bits_per_word);
4882 bitset->number_words = words_needed; 4881 bitset->number_words = words_needed;
4883 bitset->bits = calloc (words_needed, xword_size); 4882 bitset->bits = calloc (words_needed, xword_size);
4884 return bitset->bits != NULL; 4883 return bitset->bits != NULL;
@@ -5058,7 +5057,7 @@ pdumper_cold_object_p_impl (const void *obj)
5058 return offset >= dump_private.header.cold_start; 5057 return offset >= dump_private.header.cold_start;
5059} 5058}
5060 5059
5061enum Lisp_Type 5060int
5062pdumper_find_object_type_impl (const void *obj) 5061pdumper_find_object_type_impl (const void *obj)
5063{ 5062{
5064 eassert (pdumper_object_p (obj)); 5063 eassert (pdumper_object_p (obj));
@@ -5068,7 +5067,7 @@ pdumper_find_object_type_impl (const void *obj)
5068 const struct dump_reloc *reloc = 5067 const struct dump_reloc *reloc =
5069 dump_find_relocation (&dump_private.header.object_starts, offset); 5068 dump_find_relocation (&dump_private.header.object_starts, offset);
5070 return (reloc != NULL && dump_reloc_get_offset (*reloc) == offset) 5069 return (reloc != NULL && dump_reloc_get_offset (*reloc) == offset)
5071 ? (enum Lisp_Type) reloc->type 5070 ? reloc->type
5072 : PDUMPER_NO_OBJECT; 5071 : PDUMPER_NO_OBJECT;
5073} 5072}
5074 5073
@@ -5205,8 +5204,8 @@ dump_do_dump_relocation (const uintptr_t dump_base,
5205 { 5204 {
5206 struct Lisp_Bignum *bignum = dump_ptr (dump_base, reloc_offset); 5205 struct Lisp_Bignum *bignum = dump_ptr (dump_base, reloc_offset);
5207 struct bignum_reload_info reload_info; 5206 struct bignum_reload_info reload_info;
5208 verify (sizeof (reload_info) <= sizeof (bignum->value)); 5207 verify (sizeof (reload_info) <= sizeof (*bignum_val (bignum)));
5209 memcpy (&reload_info, &bignum->value, sizeof (reload_info)); 5208 memcpy (&reload_info, bignum_val (bignum), sizeof (reload_info));
5210 const mp_limb_t *limbs = 5209 const mp_limb_t *limbs =
5211 dump_ptr (dump_base, reload_info.data_location); 5210 dump_ptr (dump_base, reload_info.data_location);
5212 mpz_roinit_n (bignum->value, limbs, reload_info.nlimbs); 5211 mpz_roinit_n (bignum->value, limbs, reload_info.nlimbs);
@@ -5421,7 +5420,7 @@ pdumper_load (const char *dump_filename)
5421 5420
5422 err = PDUMPER_LOAD_ERROR; 5421 err = PDUMPER_LOAD_ERROR;
5423 mark_bits_needed = 5422 mark_bits_needed =
5424 DIVIDE_ROUND_UP (header->discardable_start, DUMP_ALIGNMENT); 5423 divide_round_up (header->discardable_start, DUMP_ALIGNMENT);
5425 if (!dump_bitset_init (&mark_bits, mark_bits_needed)) 5424 if (!dump_bitset_init (&mark_bits, mark_bits_needed))
5426 goto out; 5425 goto out;
5427 5426
diff --git a/src/pdumper.h b/src/pdumper.h
index 5d1e9c3aea3..83c094f3caa 100644
--- a/src/pdumper.h
+++ b/src/pdumper.h
@@ -24,7 +24,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 24
25INLINE_HEADER_BEGIN 25INLINE_HEADER_BEGIN
26 26
27#define PDUMPER_NO_OBJECT ((enum Lisp_Type) -1) 27enum { PDUMPER_NO_OBJECT = -1 };
28 28
29/* Indicate in source code that we're deliberately relying on pdumper 29/* Indicate in source code that we're deliberately relying on pdumper
30 not preserving the given value. Compiles to nothing --- for humans 30 not preserving the given value. Compiles to nothing --- for humans
@@ -170,12 +170,12 @@ pdumper_cold_object_p (const void *obj)
170} 170}
171 171
172 172
173extern enum Lisp_Type pdumper_find_object_type_impl (const void *obj); 173extern int pdumper_find_object_type_impl (const void *obj);
174 174
175/* Return the type of the dumped object that starts at OBJ. It is a 175/* Return the type of the dumped object that starts at OBJ. It is a
176 programming error to call this routine for an OBJ for which 176 programming error to call this routine for an OBJ for which
177 pdumper_object_p would return false. */ 177 pdumper_object_p would return false. */
178INLINE _GL_ATTRIBUTE_CONST enum Lisp_Type 178INLINE _GL_ATTRIBUTE_CONST int
179pdumper_find_object_type (const void *obj) 179pdumper_find_object_type (const void *obj)
180{ 180{
181#ifdef HAVE_PDUMPER 181#ifdef HAVE_PDUMPER
@@ -186,6 +186,14 @@ pdumper_find_object_type (const void *obj)
186#endif 186#endif
187} 187}
188 188
189/* Return true if TYPE is that of a Lisp object.
190 PDUMPER_NO_OBJECT is invalid. */
191INLINE bool
192pdumper_valid_object_type_p (int type)
193{
194 return 0 <= type;
195}
196
189/* Return whether OBJ points exactly to the start of some object in 197/* Return whether OBJ points exactly to the start of some object in
190 the loaded dump image. It is a programming error to call this 198 the loaded dump image. It is a programming error to call this
191 routine for an OBJ for which pdumper_object_p would return 199 routine for an OBJ for which pdumper_object_p would return
@@ -194,7 +202,7 @@ INLINE _GL_ATTRIBUTE_CONST bool
194pdumper_object_p_precise (const void *obj) 202pdumper_object_p_precise (const void *obj)
195{ 203{
196#ifdef HAVE_PDUMPER 204#ifdef HAVE_PDUMPER
197 return pdumper_find_object_type (obj) != PDUMPER_NO_OBJECT; 205 return pdumper_valid_object_type_p (pdumper_find_object_type (obj));
198#else 206#else
199 (void) obj; 207 (void) obj;
200 emacs_abort (); 208 emacs_abort ();
diff --git a/src/process.c b/src/process.c
index 066edbc83d6..372277a953d 100644
--- a/src/process.c
+++ b/src/process.c
@@ -276,6 +276,10 @@ static int read_process_output (Lisp_Object, int);
276static void create_pty (Lisp_Object); 276static void create_pty (Lisp_Object);
277static void exec_sentinel (Lisp_Object, Lisp_Object); 277static void exec_sentinel (Lisp_Object, Lisp_Object);
278 278
279static Lisp_Object
280network_lookup_address_info_1 (Lisp_Object host, const char *service,
281 struct addrinfo *hints, struct addrinfo **res);
282
279/* Number of bits set in connect_wait_mask. */ 283/* Number of bits set in connect_wait_mask. */
280static int num_pending_connects; 284static int num_pending_connects;
281 285
@@ -4106,7 +4110,7 @@ usage: (make-network-process &rest ARGS) */)
4106 if (!NILP (host)) 4110 if (!NILP (host))
4107 { 4111 {
4108 struct addrinfo *res, *lres; 4112 struct addrinfo *res, *lres;
4109 int ret; 4113 Lisp_Object msg;
4110 4114
4111 maybe_quit (); 4115 maybe_quit ();
4112 4116
@@ -4115,20 +4119,9 @@ usage: (make-network-process &rest ARGS) */)
4115 hints.ai_family = family; 4119 hints.ai_family = family;
4116 hints.ai_socktype = socktype; 4120 hints.ai_socktype = socktype;
4117 4121
4118 ret = getaddrinfo (SSDATA (host), portstring, &hints, &res); 4122 msg = network_lookup_address_info_1 (host, portstring, &hints, &res);
4119 if (ret) 4123 if (!EQ (msg, Qt))
4120#ifdef HAVE_GAI_STRERROR 4124 error ("%s", SSDATA (msg));
4121 {
4122 synchronize_system_messages_locale ();
4123 char const *str = gai_strerror (ret);
4124 if (! NILP (Vlocale_coding_system))
4125 str = SSDATA (code_convert_string_norecord
4126 (build_string (str), Vlocale_coding_system, 0));
4127 error ("%s/%s %s", SSDATA (host), portstring, str);
4128 }
4129#else
4130 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
4131#endif
4132 4125
4133 for (lres = res; lres; lres = lres->ai_next) 4126 for (lres = res; lres; lres = lres->ai_next)
4134 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos); 4127 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
@@ -4576,6 +4569,86 @@ Data that is unavailable is returned as nil. */)
4576#endif 4569#endif
4577} 4570}
4578 4571
4572static Lisp_Object
4573network_lookup_address_info_1 (Lisp_Object host, const char *service,
4574 struct addrinfo *hints, struct addrinfo **res)
4575{
4576 Lisp_Object msg = Qt;
4577 int ret;
4578
4579 if (STRING_MULTIBYTE (host) && SBYTES (host) != SCHARS (host))
4580 error ("Non-ASCII hostname %s detected, please use puny-encode-domain",
4581 SSDATA (host));
4582 ret = getaddrinfo (SSDATA (host), service, hints, res);
4583 if (ret)
4584 {
4585 if (service == NULL)
4586 service = "0";
4587#ifdef HAVE_GAI_STRERROR
4588 synchronize_system_messages_locale ();
4589 char const *str = gai_strerror (ret);
4590 if (! NILP (Vlocale_coding_system))
4591 str = SSDATA (code_convert_string_norecord
4592 (build_string (str), Vlocale_coding_system, 0));
4593 AUTO_STRING (format, "%s/%s %s");
4594 msg = CALLN (Fformat, format, host, build_string (service),
4595 build_string (str));
4596#else
4597 AUTO_STRING (format, "%s/%s getaddrinfo error %d");
4598 msg = CALLN (Fformat, format, host, build_string (service),
4599 make_int (ret));
4600#endif
4601 }
4602 return msg;
4603}
4604
4605DEFUN ("network-lookup-address-info", Fnetwork_lookup_address_info,
4606 Snetwork_lookup_address_info, 1, 2, 0,
4607 doc: /* Look up ip address info of NAME.
4608Optional parameter FAMILY controls whether to look up IPv4 or IPv6
4609addresses. The default of nil means both, symbol `ipv4' means IPv4
4610only, symbol `ipv6' means IPv6 only. Returns a list of addresses, or
4611nil if none were found. Each address is a vector of integers. */)
4612 (Lisp_Object name, Lisp_Object family)
4613{
4614 Lisp_Object addresses = Qnil;
4615 Lisp_Object msg = Qnil;
4616
4617 struct addrinfo *res, *lres;
4618 struct addrinfo hints;
4619
4620 memset (&hints, 0, sizeof hints);
4621 if (EQ (family, Qnil))
4622 hints.ai_family = AF_UNSPEC;
4623 else if (EQ (family, Qipv4))
4624 hints.ai_family = AF_INET;
4625 else if (EQ (family, Qipv6))
4626#ifdef AF_INET6
4627 hints.ai_family = AF_INET6;
4628#else
4629 /* If we don't support IPv6, querying will never work anyway */
4630 return addresses;
4631#endif
4632 else
4633 error ("Unsupported lookup type");
4634 hints.ai_socktype = SOCK_DGRAM;
4635
4636 msg = network_lookup_address_info_1 (name, NULL, &hints, &res);
4637 if (!EQ (msg, Qt))
4638 message ("%s", SSDATA(msg));
4639 else
4640 {
4641 for (lres = res; lres; lres = lres->ai_next)
4642 addresses = Fcons (conv_sockaddr_to_lisp (lres->ai_addr,
4643 lres->ai_addrlen),
4644 addresses);
4645 addresses = Fnreverse (addresses);
4646
4647 freeaddrinfo (res);
4648 }
4649 return addresses;
4650}
4651
4579/* Turn off input and output for process PROC. */ 4652/* Turn off input and output for process PROC. */
4580 4653
4581static void 4654static void
@@ -8345,6 +8418,7 @@ returns non-`nil'. */);
8345 defsubr (&Sset_network_process_option); 8418 defsubr (&Sset_network_process_option);
8346 defsubr (&Smake_network_process); 8419 defsubr (&Smake_network_process);
8347 defsubr (&Sformat_network_address); 8420 defsubr (&Sformat_network_address);
8421 defsubr (&Snetwork_lookup_address_info);
8348 defsubr (&Snetwork_interface_list); 8422 defsubr (&Snetwork_interface_list);
8349 defsubr (&Snetwork_interface_info); 8423 defsubr (&Snetwork_interface_info);
8350#ifdef DATAGRAM_SOCKETS 8424#ifdef DATAGRAM_SOCKETS
diff --git a/src/sound.c b/src/sound.c
index 4ba826e82c4..44d4cbc6d56 100644
--- a/src/sound.c
+++ b/src/sound.c
@@ -72,12 +72,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
72#include <soundcard.h> 72#include <soundcard.h>
73#endif 73#endif
74#ifdef HAVE_ALSA 74#ifdef HAVE_ALSA
75#ifdef ALSA_SUBDIR_INCLUDE
76#include <alsa/asoundlib.h> 75#include <alsa/asoundlib.h>
77#else 76#endif
78#include <asoundlib.h>
79#endif /* ALSA_SUBDIR_INCLUDE */
80#endif /* HAVE_ALSA */
81 77
82/* END: Non Windows Includes */ 78/* END: Non Windows Includes */
83 79
diff --git a/src/sysdep.c b/src/sysdep.c
index f7478253a35..aa18ee22fd5 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -2810,12 +2810,6 @@ errputc (int c)
2810} 2810}
2811 2811
2812void 2812void
2813verrprintf (char const *fmt, va_list ap)
2814{
2815 vfprintf (errstream (), fmt, ap);
2816}
2817
2818void
2819errwrite (void const *buf, ptrdiff_t nbuf) 2813errwrite (void const *buf, ptrdiff_t nbuf)
2820{ 2814{
2821 fwrite_unlocked (buf, 1, nbuf, errstream ()); 2815 fwrite_unlocked (buf, 1, nbuf, errstream ());
diff --git a/src/sysstdio.h b/src/sysstdio.h
index f402bd633d4..1e1180a4d31 100644
--- a/src/sysstdio.h
+++ b/src/sysstdio.h
@@ -28,7 +28,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
28 28
29extern FILE *emacs_fopen (char const *, char const *); 29extern FILE *emacs_fopen (char const *, char const *);
30extern void errputc (int); 30extern void errputc (int);
31extern void verrprintf (char const *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0);
32extern void errwrite (void const *, ptrdiff_t); 31extern void errwrite (void const *, ptrdiff_t);
33extern void close_output_streams (void); 32extern void close_output_streams (void);
34 33
diff --git a/src/systime.h b/src/systime.h
index 125b2f1385e..2f783efcfca 100644
--- a/src/systime.h
+++ b/src/systime.h
@@ -41,6 +41,8 @@ typedef unsigned long Time;
41#endif 41#endif
42 42
43#include <sys/time.h> /* for 'struct timeval' */ 43#include <sys/time.h> /* for 'struct timeval' */
44
45#undef hz /* AIX <sys/param.h> #defines this. */
44 46
45/* Emacs uses struct timespec to represent nonnegative temporal intervals. 47/* Emacs uses struct timespec to represent nonnegative temporal intervals.
46 48
diff --git a/src/timefns.c b/src/timefns.c
index 2d545a4f905..c1e3141c4cf 100644
--- a/src/timefns.c
+++ b/src/timefns.c
@@ -91,7 +91,7 @@ static Lisp_Object timespec_hz;
91#define TRILLION 1000000000000 91#define TRILLION 1000000000000
92#if FIXNUM_OVERFLOW_P (TRILLION) 92#if FIXNUM_OVERFLOW_P (TRILLION)
93static Lisp_Object trillion; 93static Lisp_Object trillion;
94# define ztrillion (XBIGNUM (trillion)->value) 94# define ztrillion (*xbignum_val (trillion))
95#else 95#else
96# define trillion make_fixnum (TRILLION) 96# define trillion make_fixnum (TRILLION)
97# if ULONG_MAX < TRILLION || !FASTER_TIMEFNS 97# if ULONG_MAX < TRILLION || !FASTER_TIMEFNS
@@ -99,6 +99,22 @@ mpz_t ztrillion;
99# endif 99# endif
100#endif 100#endif
101 101
102/* True if the nonzero Lisp integer HZ divides evenly into a trillion. */
103static bool
104trillion_factor (Lisp_Object hz)
105{
106 if (FASTER_TIMEFNS)
107 {
108 if (FIXNUMP (hz))
109 return TRILLION % XFIXNUM (hz) == 0;
110 if (!FIXNUM_OVERFLOW_P (TRILLION))
111 return false;
112 }
113 verify (TRILLION <= INTMAX_MAX);
114 intmax_t ihz;
115 return integer_to_intmax (hz, &ihz) && TRILLION % ihz == 0;
116}
117
102/* Return a struct timeval that is roughly equivalent to T. 118/* Return a struct timeval that is roughly equivalent to T.
103 Use the least timeval not less than T. 119 Use the least timeval not less than T.
104 Return an extremal value if the result would overflow. */ 120 Return an extremal value if the result would overflow. */
@@ -391,16 +407,36 @@ decode_float_time (double t, struct lisp_time *result)
391 else 407 else
392 { 408 {
393 int exponent = ilogb (t); 409 int exponent = ilogb (t);
394 if (exponent == FP_ILOGBNAN) 410 int scale;
395 return EINVAL; 411 if (exponent < DBL_MANT_DIG)
396 412 {
397 /* An enormous or infinite T would make SCALE < 0 which would make 413 if (exponent < DBL_MIN_EXP - 1)
398 HZ < 1, which the (TICKS . HZ) representation does not allow. */ 414 {
399 if (DBL_MANT_DIG - 1 < exponent) 415 if (exponent == FP_ILOGBNAN
400 return EOVERFLOW; 416 && (FP_ILOGBNAN != FP_ILOGB0 || isnan (t)))
401 417 return EINVAL;
402 /* min so we don't scale tiny numbers as if they were normalized. */ 418 /* T is tiny. SCALE must be less than FLT_RADIX_POWER_SIZE,
403 int scale = min (DBL_MANT_DIG - 1 - exponent, flt_radix_power_size - 1); 419 as otherwise T would be scaled as if it were normalized. */
420 scale = flt_radix_power_size - 1;
421 }
422 else
423 {
424 /* The typical case. */
425 scale = DBL_MANT_DIG - 1 - exponent;
426 }
427 }
428 else if (exponent < INT_MAX)
429 {
430 /* T is finite but so large that HZ would be less than 1 if
431 T's precision were represented exactly. SCALE must be
432 nonnegative, as the (TICKS . HZ) representation requires
433 HZ to be at least 1. So use SCALE = 0, which converts T to
434 (T . 1), which is the exact numeric value with too-large HZ,
435 which is typically better than signaling overflow. */
436 scale = 0;
437 }
438 else
439 return FP_ILOGBNAN == INT_MAX && isnan (t) ? EINVAL : EOVERFLOW;
404 440
405 double scaled = scalbn (t, scale); 441 double scaled = scalbn (t, scale);
406 eassert (trunc (scaled) == scaled); 442 eassert (trunc (scaled) == scaled);
@@ -498,7 +534,7 @@ lisp_time_hz_ticks (struct lisp_time t, Lisp_Object hz)
498 return make_int (ticks / XFIXNUM (t.hz) 534 return make_int (ticks / XFIXNUM (t.hz)
499 - (ticks % XFIXNUM (t.hz) < 0)); 535 - (ticks % XFIXNUM (t.hz) < 0));
500 } 536 }
501 else if (! (BIGNUMP (hz) && 0 < mpz_sgn (XBIGNUM (hz)->value))) 537 else if (! (BIGNUMP (hz) && 0 < mpz_sgn (*xbignum_val (hz))))
502 invalid_hz (hz); 538 invalid_hz (hz);
503 539
504 mpz_mul (mpz[0], 540 mpz_mul (mpz[0],
@@ -661,18 +697,10 @@ enum timeform
661 TIMEFORM_HI_LO_US, /* seconds plus microseconds (HI LO US) */ 697 TIMEFORM_HI_LO_US, /* seconds plus microseconds (HI LO US) */
662 TIMEFORM_NIL, /* current time in nanoseconds */ 698 TIMEFORM_NIL, /* current time in nanoseconds */
663 TIMEFORM_HI_LO_US_PS, /* seconds plus micro and picoseconds (HI LO US PS) */ 699 TIMEFORM_HI_LO_US_PS, /* seconds plus micro and picoseconds (HI LO US PS) */
664 /* These two should be last; see timeform_sub_ps_p. */
665 TIMEFORM_FLOAT, /* time as a float */ 700 TIMEFORM_FLOAT, /* time as a float */
666 TIMEFORM_TICKS_HZ /* fractional time: HI is ticks, LO is ticks per second */ 701 TIMEFORM_TICKS_HZ /* fractional time: HI is ticks, LO is ticks per second */
667 }; 702 };
668 703
669/* True if Lisp times of form FORM can express sub-picosecond timestamps. */
670static bool
671timeform_sub_ps_p (enum timeform form)
672{
673 return TIMEFORM_FLOAT <= form;
674}
675
676/* From the valid form FORM and the time components HIGH, LOW, USEC 704/* From the valid form FORM and the time components HIGH, LOW, USEC
677 and PSEC, generate the corresponding time value. If LOW is 705 and PSEC, generate the corresponding time value. If LOW is
678 floating point, the other components should be zero and FORM should 706 floating point, the other components should be zero and FORM should
@@ -878,6 +906,7 @@ lisp_to_timespec (struct lisp_time t)
878 struct timespec result = invalid_timespec (); 906 struct timespec result = invalid_timespec ();
879 int ns; 907 int ns;
880 mpz_t *q = &mpz[0]; 908 mpz_t *q = &mpz[0];
909 mpz_t const *qt = q;
881 910
882 if (FASTER_TIMEFNS && EQ (t.hz, timespec_hz)) 911 if (FASTER_TIMEFNS && EQ (t.hz, timespec_hz))
883 { 912 {
@@ -896,7 +925,7 @@ lisp_to_timespec (struct lisp_time t)
896 return result; 925 return result;
897 } 926 }
898 else 927 else
899 ns = mpz_fdiv_q_ui (*q, XBIGNUM (t.ticks)->value, TIMESPEC_HZ); 928 ns = mpz_fdiv_q_ui (*q, *xbignum_val (t.ticks), TIMESPEC_HZ);
900 } 929 }
901 else if (FASTER_TIMEFNS && EQ (t.hz, make_fixnum (1))) 930 else if (FASTER_TIMEFNS && EQ (t.hz, make_fixnum (1)))
902 { 931 {
@@ -913,7 +942,7 @@ lisp_to_timespec (struct lisp_time t)
913 return result; 942 return result;
914 } 943 }
915 else 944 else
916 q = &XBIGNUM (t.ticks)->value; 945 qt = xbignum_val (t.ticks);
917 } 946 }
918 else 947 else
919 { 948 {
@@ -925,7 +954,7 @@ lisp_to_timespec (struct lisp_time t)
925 /* With some versions of MinGW, tv_sec is a 64-bit type, whereas 954 /* With some versions of MinGW, tv_sec is a 64-bit type, whereas
926 time_t is a 32-bit type. */ 955 time_t is a 32-bit type. */
927 time_t sec; 956 time_t sec;
928 if (mpz_time (*q, &sec)) 957 if (mpz_time (*qt, &sec))
929 { 958 {
930 result.tv_sec = sec; 959 result.tv_sec = sec;
931 result.tv_nsec = ns; 960 result.tv_nsec = ns;
@@ -1010,7 +1039,7 @@ lispint_arith (Lisp_Object a, Lisp_Object b, bool subtract)
1010 if (eabs (XFIXNUM (b)) <= ULONG_MAX) 1039 if (eabs (XFIXNUM (b)) <= ULONG_MAX)
1011 { 1040 {
1012 ((XFIXNUM (b) < 0) == subtract ? mpz_add_ui : mpz_sub_ui) 1041 ((XFIXNUM (b) < 0) == subtract ? mpz_add_ui : mpz_sub_ui)
1013 (mpz[0], XBIGNUM (a)->value, eabs (XFIXNUM (b))); 1042 (mpz[0], *xbignum_val (a), eabs (XFIXNUM (b)));
1014 mpz_done = true; 1043 mpz_done = true;
1015 } 1044 }
1016 } 1045 }
@@ -1060,9 +1089,14 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
1060 else 1089 else
1061 { 1090 {
1062 /* The plan is to decompose ta into na/da and tb into nb/db. 1091 /* The plan is to decompose ta into na/da and tb into nb/db.
1063 Start by computing da and db. */ 1092 Start by computing da and db, their minimum (which will be
1093 needed later) and the iticks temporary that will become
1094 available once only their minimum is needed. */
1064 mpz_t const *da = bignum_integer (&mpz[1], ta.hz); 1095 mpz_t const *da = bignum_integer (&mpz[1], ta.hz);
1065 mpz_t const *db = bignum_integer (&mpz[2], tb.hz); 1096 mpz_t const *db = bignum_integer (&mpz[2], tb.hz);
1097 bool da_lt_db = mpz_cmp (*da, *db) < 0;
1098 mpz_t const *hzmin = da_lt_db ? da : db;
1099 mpz_t *iticks = &mpz[da_lt_db + 1];
1066 1100
1067 /* The plan is to compute (na * (db/g) + nb * (da/g)) / lcm (da, db) 1101 /* The plan is to compute (na * (db/g) + nb * (da/g)) / lcm (da, db)
1068 where g = gcd (da, db). Start by computing g. */ 1102 where g = gcd (da, db). Start by computing g. */
@@ -1070,34 +1104,83 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract)
1070 mpz_gcd (*g, *da, *db); 1104 mpz_gcd (*g, *da, *db);
1071 1105
1072 /* fa = da/g, fb = db/g. */ 1106 /* fa = da/g, fb = db/g. */
1073 mpz_t *fa = &mpz[1], *fb = &mpz[3]; 1107 mpz_t *fa = &mpz[4], *fb = &mpz[3];
1074 mpz_tdiv_q (*fa, *da, *g); 1108 mpz_divexact (*fa, *da, *g);
1075 mpz_tdiv_q (*fb, *db, *g); 1109 mpz_divexact (*fb, *db, *g);
1110
1111 /* ihz = fa * db. This is equal to lcm (da, db). */
1112 mpz_t *ihz = &mpz[0];
1113 mpz_mul (*ihz, *fa, *db);
1114
1115 /* When warning about obsolete timestamps, if the smaller
1116 denominator comes from a non-(TICKS . HZ) timestamp and could
1117 generate a (TICKS . HZ) timestamp that would look obsolete,
1118 arrange for the result to have a higher HZ to avoid a
1119 spurious warning by a later consumer of this function's
1120 returned value. */
1121 verify (1 << LO_TIME_BITS <= ULONG_MAX);
1122 if (WARN_OBSOLETE_TIMESTAMPS
1123 && (da_lt_db ? aform : bform) == TIMEFORM_FLOAT
1124 && (da_lt_db ? bform : aform) != TIMEFORM_TICKS_HZ
1125 && mpz_cmp_ui (*hzmin, 1) > 0
1126 && mpz_cmp_ui (*hzmin, 1 << LO_TIME_BITS) < 0)
1127 {
1128 mpz_t *hzmin1 = &mpz[2 - da_lt_db];
1129 mpz_set_ui (*hzmin1, 1 << LO_TIME_BITS);
1130 hzmin = hzmin1;
1131 }
1076 1132
1077 /* FIXME: Maybe omit need for extra temp by computing fa * db here? */ 1133 /* iticks = (fb * na) OP (fa * nb), where OP is + or -. */
1134 mpz_t const *na = bignum_integer (iticks, ta.ticks);
1135 mpz_mul (*iticks, *fb, *na);
1136 mpz_t const *nb = bignum_integer (&mpz[3], tb.ticks);
1137 (subtract ? mpz_submul : mpz_addmul) (*iticks, *fa, *nb);
1138
1139 /* Normalize iticks/ihz by dividing both numerator and
1140 denominator by ig = gcd (iticks, ihz). However, if that
1141 would cause the denominator to become less than hzmin,
1142 rescale the denominator upwards from its ordinary value by
1143 multiplying numerator and denominator so that the denominator
1144 becomes at least hzmin. This rescaling avoids returning a
1145 timestamp that is less precise than both a and b, or a
1146 timestamp that looks obsolete when that might be a problem. */
1147 mpz_t *ig = &mpz[3];
1148 mpz_gcd (*ig, *iticks, *ihz);
1149
1150 if (!FASTER_TIMEFNS || mpz_cmp_ui (*ig, 1) > 0)
1151 {
1152 mpz_divexact (*iticks, *iticks, *ig);
1153 mpz_divexact (*ihz, *ihz, *ig);
1078 1154
1079 /* hz = fa * db. This is equal to lcm (da, db). */ 1155 if (!FASTER_TIMEFNS || mpz_cmp (*ihz, *hzmin) < 0)
1080 mpz_mul (mpz[0], *fa, *db); 1156 {
1157 /* Rescale straightforwardly. Although this might not
1158 yield the minimal denominator that preserves numeric
1159 value and is at least hzmin, calculating such a
1160 denominator would be too expensive because it would
1161 require testing multisets of factors of lcm (da, db). */
1162 mpz_t *rescale = &mpz[3];
1163 mpz_cdiv_q (*rescale, *hzmin, *ihz);
1164 mpz_mul (*iticks, *iticks, *rescale);
1165 mpz_mul (*ihz, *ihz, *rescale);
1166 }
1167 }
1081 hz = make_integer_mpz (); 1168 hz = make_integer_mpz ();
1082 1169 mpz_swap (mpz[0], *iticks);
1083 /* ticks = (fb * na) OPER (fa * nb), where OPER is + or -.
1084 OP is the multiply-add or multiply-sub form of OPER. */
1085 mpz_t const *na = bignum_integer (&mpz[0], ta.ticks);
1086 mpz_mul (mpz[0], *fb, *na);
1087 mpz_t const *nb = bignum_integer (&mpz[3], tb.ticks);
1088 (subtract ? mpz_submul : mpz_addmul) (mpz[0], *fa, *nb);
1089 ticks = make_integer_mpz (); 1170 ticks = make_integer_mpz ();
1090 } 1171 }
1091 1172
1092 /* Return an integer if the timestamp resolution is 1, 1173 /* Return an integer if the timestamp resolution is 1,
1093 otherwise the (TICKS . HZ) form if !CURRENT_TIME_LIST or if 1174 otherwise the (TICKS . HZ) form if !CURRENT_TIME_LIST or if
1094 either input form supports timestamps that cannot be expressed 1175 either input used (TICKS . HZ) form or the result can't be expressed
1095 exactly in (HI LO US PS) form, otherwise the (HI LO US PS) form 1176 exactly in (HI LO US PS) form, otherwise the (HI LO US PS) form
1096 for backward compatibility. */ 1177 for backward compatibility. */
1097 return (EQ (hz, make_fixnum (1)) 1178 return (EQ (hz, make_fixnum (1))
1098 ? ticks 1179 ? ticks
1099 : (!CURRENT_TIME_LIST 1180 : (!CURRENT_TIME_LIST
1100 || timeform_sub_ps_p (aform) || timeform_sub_ps_p (bform)) 1181 || aform == TIMEFORM_TICKS_HZ
1182 || bform == TIMEFORM_TICKS_HZ
1183 || !trillion_factor (hz))
1101 ? Fcons (ticks, hz) 1184 ? Fcons (ticks, hz)
1102 : ticks_hz_list4 (ticks, hz)); 1185 : ticks_hz_list4 (ticks, hz));
1103} 1186}
diff --git a/src/w32.c b/src/w32.c
index 36a5a37496e..d7a91692c63 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -3918,7 +3918,7 @@ logon_network_drive (const char *path)
3918 return; 3918 return;
3919 3919
3920 n_slashes = 2; 3920 n_slashes = 2;
3921 strncpy (share, path, MAX_UTF8_PATH); 3921 strncpy (share, path, MAX_UTF8_PATH - 1);
3922 /* Truncate to just server and share name. */ 3922 /* Truncate to just server and share name. */
3923 for (p = share + 2; *p && p < share + MAX_UTF8_PATH; p++) 3923 for (p = share + 2; *p && p < share + MAX_UTF8_PATH; p++)
3924 { 3924 {
diff --git a/src/xdisp.c b/src/xdisp.c
index af772bdef28..94f969f37cf 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -184,7 +184,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
184 infrequently. These include the face of the characters, whether 184 infrequently. These include the face of the characters, whether
185 text is invisible, the object (buffer or display or overlay string) 185 text is invisible, the object (buffer or display or overlay string)
186 being iterated, character composition info, etc. For any given 186 being iterated, character composition info, etc. For any given
187 buffer or string position, these sources of information that 187 buffer or string position, the sources of information that
188 affects the display can be determined by calling the appropriate 188 affects the display can be determined by calling the appropriate
189 primitives, such as Fnext_single_property_change, but both these 189 primitives, such as Fnext_single_property_change, but both these
190 calls and the processing of their return values is relatively 190 calls and the processing of their return values is relatively
@@ -214,7 +214,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
214 string's interval tree to determine where the text properties 214 string's interval tree to determine where the text properties
215 change, finds the next position where overlays and character 215 change, finds the next position where overlays and character
216 composition can change, and stores in stop_charpos the closest 216 composition can change, and stores in stop_charpos the closest
217 position where any of these factors should be reconsider. 217 position where any of these factors should be reconsidered.
218 218
219 Producing glyphs. 219 Producing glyphs.
220 220
@@ -13509,7 +13509,8 @@ hscroll_window_tree (Lisp_Object window)
13509 get glyph rows whose start and end have zero buffer 13509 get glyph rows whose start and end have zero buffer
13510 positions, which we cannot handle below. Just skip 13510 positions, which we cannot handle below. Just skip
13511 such windows. */ 13511 such windows. */
13512 && CHARPOS (cursor_row->start.pos) >= BUF_BEG (w->contents) 13512 && (CHARPOS (cursor_row->start.pos)
13513 >= BUF_BEG (XBUFFER (w->contents)))
13513 /* For left-to-right rows, hscroll when cursor is either 13514 /* For left-to-right rows, hscroll when cursor is either
13514 (i) inside the right hscroll margin, or (ii) if it is 13515 (i) inside the right hscroll margin, or (ii) if it is
13515 inside the left margin and the window is already 13516 inside the left margin and the window is already
@@ -20463,7 +20464,7 @@ append_space_for_newline (struct it *it, bool default_face_p)
20463static void 20464static void
20464extend_face_to_end_of_line (struct it *it) 20465extend_face_to_end_of_line (struct it *it)
20465{ 20466{
20466 struct face *face, *default_face; 20467 struct face *face;
20467 struct frame *f = it->f; 20468 struct frame *f = it->f;
20468 20469
20469 /* If line is already filled, do nothing. Non window-system frames 20470 /* If line is already filled, do nothing. Non window-system frames
@@ -20481,10 +20482,6 @@ extend_face_to_end_of_line (struct it *it)
20481 || WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0)) 20482 || WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0))
20482 return; 20483 return;
20483 20484
20484 /* The default face, possibly remapped. */
20485 default_face =
20486 FACE_FROM_ID_OR_NULL (f, lookup_basic_face (it->w, f, DEFAULT_FACE_ID));
20487
20488 /* Face extension extends the background and box of IT->face_id 20485 /* Face extension extends the background and box of IT->face_id
20489 to the end of the line. If the background equals the background 20486 to the end of the line. If the background equals the background
20490 of the frame, we don't have to do anything. */ 20487 of the frame, we don't have to do anything. */
@@ -20517,7 +20514,14 @@ extend_face_to_end_of_line (struct it *it)
20517 it->face_id = FACE_FOR_CHAR (f, face, 0, -1, Qnil); 20514 it->face_id = FACE_FOR_CHAR (f, face, 0, -1, Qnil);
20518 } 20515 }
20519 20516
20517 /* The default face, possibly remapped. */
20518 struct face *default_face =
20519 FACE_FROM_ID (f, lookup_basic_face (it->w, f, DEFAULT_FACE_ID));
20520
20520#ifdef HAVE_WINDOW_SYSTEM 20521#ifdef HAVE_WINDOW_SYSTEM
20522 if (default_face == NULL)
20523 error ("extend_face_to_end_of_line: default_face is not set!");
20524
20521 if (FRAME_WINDOW_P (f)) 20525 if (FRAME_WINDOW_P (f))
20522 { 20526 {
20523 /* If the row is empty, add a space with the current face of IT, 20527 /* If the row is empty, add a space with the current face of IT,
diff --git a/src/xterm.c b/src/xterm.c
index 0d224063d76..b761eaf4d11 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -10044,7 +10044,6 @@ For details, see etc/PROBLEMS.\n",
10044 { 10044 {
10045 fprintf (stderr, "%s\n", error_msg); 10045 fprintf (stderr, "%s\n", error_msg);
10046 Fkill_emacs (make_fixnum (70)); 10046 Fkill_emacs (make_fixnum (70));
10047 /* NOTREACHED */
10048 } 10047 }
10049 10048
10050 totally_unblock_input (); 10049 totally_unblock_input ();
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-20 18:07:19 +0000