bug#36370: 27.0.50; XFIXNAT called on negative numbers

[Paul Eggert <eggert@cs.ucla.edu>]

[-- Attachment #1: Type: text/plain, Size: 1521 bytes --]

Thanks for looking into this. Cleaning this up has been on my to-do list 
for a while, and something along these lines has been discussed on the 
mailing list. Some comments on your fixes:

* The ccl.c, fileio.c, image.c, and process.c fixes should use XFIXNUM, 
not XFIXNAT, since the code is range-checking after extraction anyway 
and the latter range-checking should do the right thing. Come to think 
of it, the ccl.c and image.c code is buggy regardless of the 
XFIXNUM/XFIXNAT business since the Emacs integer might not fit into int 
range, and that should be fixed too.

* Instead of adding a new macro CHECK_FIXNAT_COERCE_MARKER, the code 
should stick with CHECK_FIXNUM_COERCE_MARKER and do the usual 
range-checking on the results. This should yield more-precise 
diagnostics. Most of the range-checking is there already.

* The set_text_properties fix can be done more efficiently via EQ.

* I'm mildly inclined to think that w32term.c and xterm.c should treate 
negative minimum values as 0 when the actual value must be nonnegative. 
That is, a negative minimum should act like a minimum of 0, not as a 
minimum of 1 as in your proposed patch.

To help prevent similar problems in the future, XFIXNUM, XFIXNAT etc. 
should check that their arguments are of the proper type when 
ENABLE_CHECKING is nonzero.

A proposed patch is attached; it should do all the above.

PS. At some point we should also check that make_fixnum is invoked only 
on values in fixnum range, but that's a matter for a later patch.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Clean-up-use-of-XFIXNUM-etc.patch --]
[-- Type: text/x-patch; name="0001-Clean-up-use-of-XFIXNUM-etc.patch", Size: 15900 bytes --]

From bdec4f8e8d7278d68d3534b87c29362ffcbe23d2 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Wed, 26 Jun 2019 17:52:06 -0700
Subject: [PATCH] Clean up use of XFIXNUM etc.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

A few bits of the code were relying on the fact that XFIXNUM,
XFIXNAT, and XUFIXNUM do something even with arguments that
are not fixnums/fixnats.  Separate these rare uses out into
XFIXNUM_RAW and XUFIXNUM_RAW.
Problem and original patch reported by Pip Cet (Bug#36370).
* src/ccl.c (Fccl_execute_on_string):
* src/fileio.c (Finsert_file_contents, a_write)
(Fdo_auto_save):
* src/process.c (conv_lisp_to_sockaddr):
* src/textprop.c (Fnext_single_char_property_change)
(Fprevious_single_char_property_change)
(Fnext_property_change, Fnext_single_property_change)
(Fprevious_property_change)
(Fprevious_single_property_change):
Don’t assume fixnums are nonnegative.
* src/ccl.c (Fccl_execute_on_string):
Fix range-checking bug if AREF (status, i) is out of int range.
* src/data.c (arith_driver): Use XFIXNUM_RAW as we want
efficient garbage if the value is not a fixnum.
* src/dosfns.c (Fint86, Fdos_memput):
Check that args are nonnegative.
* src/image.c (lookup_image): Check that args are in range.
* src/lisp.h (lisp_h_XHASH): Use XUFIXNUM_RAW, since this
is for hashing.
(lisp_h_XFIXNAT, XFIXNAT) [USE_LSB_TAG]: Remove macros.
(lisp_h_XFIXNUM_RAW, XFIXNUM_RAW) [USE_LSB_TAG]: New macros, with
the semantics of the old macros without _RAW.
(XFIXNUM_RAW, XUFIXNUM_RAW): New inline functions, with the
semantics of the old functions without _RAW.
(FIXNUMP): Move definition up to avoid forward use.
(XFIXNUM, XFIXNAT, XUFIXNUM): Use eassume to add a runtime
check (when debugging) that the argument has the proper form.
(XFIXNUM, XFIXNAT): Now inline functions only, since they
refer to their arguments more than once now that they use eassume.
* src/textprop.c (Fprevious_single_char_property_change):
Avoid fixnum overflow with invalid input.
(set_text_properties): Fix unlikely failure
to validate arguments, by using EQ instead of XFIXNAT.
* src/w32term.c (w32_draw_glyph_string):
* src/xterm.c (x_draw_glyph_string):
Treat negative minimums as 0 rather than as garbage patterns.
---
 src/ccl.c      |  6 ++--
 src/data.c     |  2 +-
 src/dosfns.c   |  4 +--
 src/fileio.c   |  6 ++--
 src/image.c    |  4 +--
 src/lisp.h     | 75 +++++++++++++++++++++++++-------------------------
 src/process.c  |  2 +-
 src/textprop.c | 29 +++++++++----------
 src/w32term.c  |  2 +-
 src/xterm.c    |  2 +-
 10 files changed, 67 insertions(+), 65 deletions(-)

diff --git a/src/ccl.c b/src/ccl.c
index ec108e30d8..f1d4c28df1 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -2064,9 +2064,9 @@ #define CCL_EXECUTE_BUF_SIZE 1024
     }
   if (FIXNUMP (AREF (status, i)))
     {
-      i = XFIXNAT (AREF (status, 8));
-      if (ccl.ic < i && i < ccl.size)
-	ccl.ic = i;
+      EMACS_INT ic = XFIXNUM (AREF (status, i));
+      if (ccl.ic < ic && ic < ccl.size)
+	ccl.ic = ic;
     }
 
   buf_magnification = ccl.buf_magnification ? ccl.buf_magnification : 1;
diff --git a/src/data.c b/src/data.c
index c1699aeae7..46bd7e0e25 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2928,7 +2928,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
   ptrdiff_t argnum = 0;
   /* Set ACCUM to VAL's value if it is a fixnum, otherwise to some
      ignored value to avoid using an uninitialized variable later.  */
-  intmax_t accum = XFIXNUM (val);
+  intmax_t accum = XFIXNUM_RAW (val);
 
   if (FIXNUMP (val))
     while (true)
diff --git a/src/dosfns.c b/src/dosfns.c
index 47c545007a..fb5bcc9ad3 100644
--- a/src/dosfns.c
+++ b/src/dosfns.c
@@ -72,7 +72,7 @@ DEFUN ("int86", Fint86, Sint86, 2, 2, 0,
   if (no < 0 || no > 0xff || ASIZE (registers) != 8)
     return Qnil;
   for (i = 0; i < 8; i++)
-    CHECK_FIXNUM (AREF (registers, i));
+    CHECK_FIXNAT (AREF (registers, i));
 
   inregs.x.ax    = (unsigned long) XFIXNAT (AREF (registers, 0));
   inregs.x.bx    = (unsigned long) XFIXNAT (AREF (registers, 1));
@@ -139,7 +139,7 @@ DEFUN ("msdos-memput", Fdos_memput, Sdos_memput, 2, 2, 0,
 
   for (i = 0; i < len; i++)
     {
-      CHECK_FIXNUM (AREF (vector, i));
+      CHECK_FIXNAT (AREF (vector, i));
       buf[i] = (unsigned char) XFIXNAT (AREF (vector, i)) & 0xFF;
     }
 
diff --git a/src/fileio.c b/src/fileio.c
index 0da9894a73..61e10dac47 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -4720,7 +4720,7 @@ because (1) it preserves some marker positions and (2) it puts less data
 	      Lisp_Object tem = XCAR (old_undo);
 	      if (CONSP (tem) && FIXNUMP (XCAR (tem))
 		  && FIXNUMP (XCDR (tem))
-		  && XFIXNAT (XCDR (tem)) == PT + old_inserted)
+		  && XFIXNUM (XCDR (tem)) == PT + old_inserted)
 		XSETCDR (tem, make_fixnum (PT + inserted));
 	    }
 	}
@@ -5392,7 +5392,7 @@ a_write (int desc, Lisp_Object string, ptrdiff_t pos,
       tem = Fcar_safe (Fcar (*annot));
       nextpos = pos - 1;
       if (FIXNUMP (tem))
-	nextpos = XFIXNAT (tem);
+	nextpos = XFIXNUM (tem);
 
       /* If there are no more annotations in this range,
 	 output the rest of the range all at once.  */
@@ -5850,7 +5850,7 @@ DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
 		&& FIXNUMP (BVAR (b, save_length))
 		/* A short file is likely to change a large fraction;
 		   spare the user annoying messages.  */
-		&& XFIXNAT (BVAR (b, save_length)) > 5000
+		&& XFIXNUM (BVAR (b, save_length)) > 5000
 		&& (growth_factor * (BUF_Z (b) - BUF_BEG (b))
 		    < (growth_factor - 1) * XFIXNAT (BVAR (b, save_length)))
 		/* These messages are frequent and annoying for `*mail*'.  */
diff --git a/src/image.c b/src/image.c
index 7b648c46ae..d204749631 100644
--- a/src/image.c
+++ b/src/image.c
@@ -2385,13 +2385,13 @@ lookup_image (struct frame *f, Lisp_Object spec)
 #endif
 
 	  ascent = image_spec_value (spec, QCascent, NULL);
-	  if (FIXNUMP (ascent))
+	  if (RANGED_FIXNUMP (0, ascent, INT_MAX))
 	    img->ascent = XFIXNAT (ascent);
 	  else if (EQ (ascent, Qcenter))
 	    img->ascent = CENTERED_IMAGE_ASCENT;
 
 	  margin = image_spec_value (spec, QCmargin, NULL);
-	  if (FIXNUMP (margin))
+	  if (RANGED_FIXNUMP (0, margin, INT_MAX))
 	    img->vmargin = img->hmargin = XFIXNAT (margin);
 	  else if (CONSP (margin))
 	    {
diff --git a/src/lisp.h b/src/lisp.h
index 77fc22d118..077d236065 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -414,12 +414,11 @@ #define lisp_h_XCAR(c) XCONS (c)->u.s.car
 #define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr
 #define lisp_h_XCONS(a) \
    (eassert (CONSP (a)), XUNTAG (a, Lisp_Cons, struct Lisp_Cons))
-#define lisp_h_XHASH(a) XUFIXNUM (a)
+#define lisp_h_XHASH(a) XUFIXNUM_RAW (a)
 #if USE_LSB_TAG
 # define lisp_h_make_fixnum(n) \
     XIL ((EMACS_INT) (((EMACS_UINT) (n) << INTTYPEBITS) + Lisp_Int0))
-# define lisp_h_XFIXNAT(a) XFIXNUM (a)
-# define lisp_h_XFIXNUM(a) (XLI (a) >> INTTYPEBITS)
+# define lisp_h_XFIXNUM_RAW(a) (XLI (a) >> INTTYPEBITS)
 # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
 #endif
 
@@ -460,8 +459,7 @@ #define lisp_h_XHASH(a) XUFIXNUM (a)
 # define XHASH(a) lisp_h_XHASH (a)
 # if USE_LSB_TAG
 #  define make_fixnum(n) lisp_h_make_fixnum (n)
-#  define XFIXNAT(a) lisp_h_XFIXNAT (a)
-#  define XFIXNUM(a) lisp_h_XFIXNUM (a)
+#  define XFIXNUM_RAW(a) lisp_h_XFIXNUM_RAW (a)
 #  define XTYPE(a) lisp_h_XTYPE (a)
 # endif
 #endif
@@ -1141,17 +1139,9 @@ #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
 }
 
 INLINE EMACS_INT
-(XFIXNUM) (Lisp_Object a)
+(XFIXNUM_RAW) (Lisp_Object a)
 {
-  return lisp_h_XFIXNUM (a);
-}
-
-INLINE EMACS_INT
-(XFIXNAT) (Lisp_Object a)
-{
-  EMACS_INT n = lisp_h_XFIXNAT (a);
-  eassume (0 <= n);
-  return n;
+  return lisp_h_XFIXNUM_RAW (a);
 }
 
 #else /* ! USE_LSB_TAG */
@@ -1179,9 +1169,11 @@ make_fixnum (EMACS_INT n)
   return XIL (n);
 }
 
-/* Extract A's value as a signed integer.  */
+/* Extract A's value as a signed integer.  Unlike XFIXNUM, this works
+   on any Lisp object, although the resulting integer is useful only
+   for things like hashing when A is not a fixnum.  */
 INLINE EMACS_INT
-XFIXNUM (Lisp_Object a)
+XFIXNUM_RAW (Lisp_Object a)
 {
   EMACS_INT i = XLI (a);
   if (! USE_LSB_TAG)
@@ -1192,31 +1184,36 @@ XFIXNUM (Lisp_Object a)
   return i >> INTTYPEBITS;
 }
 
-/* Like XFIXNUM (A), but may be faster.  A must be nonnegative.
-   If ! USE_LSB_TAG, this takes advantage of the fact that Lisp
-   integers have zero-bits in their tags.  */
-INLINE EMACS_INT
-XFIXNAT (Lisp_Object a)
+#endif /* ! USE_LSB_TAG */
+
+INLINE bool
+(FIXNUMP) (Lisp_Object x)
 {
-  EMACS_INT int0 = Lisp_Int0;
-  EMACS_INT n = USE_LSB_TAG ? XFIXNUM (a) : XLI (a) - (int0 << VALBITS);
-  eassume (0 <= n);
-  return n;
+  return lisp_h_FIXNUMP (x);
 }
 
-#endif /* ! USE_LSB_TAG */
+INLINE EMACS_INT
+XFIXNUM (Lisp_Object a)
+{
+  eassume (FIXNUMP (a));
+  return XFIXNUM_RAW (a);
+}
 
 /* Extract A's value as an unsigned integer in the range 0..INTMASK.  */
 INLINE EMACS_UINT
-XUFIXNUM (Lisp_Object a)
+XUFIXNUM_RAW (Lisp_Object a)
 {
   EMACS_UINT i = XLI (a);
   return USE_LSB_TAG ? i >> INTTYPEBITS : i & INTMASK;
 }
+INLINE EMACS_UINT
+XUFIXNUM (Lisp_Object a)
+{
+  eassume (FIXNUMP (a));
+  return XUFIXNUM_RAW (a);
+}
 
-/* Return A's hash, which is in the range 0..INTMASK.  Although XHASH (A) ==
-   XUFIXNUM (A) currently, XUFIXNUM should be applied only to fixnums.  */
-
+/* Return A's hash, which is in the range 0..INTMASK.  */
 INLINE EMACS_INT
 (XHASH) (Lisp_Object a)
 {
@@ -1261,12 +1258,6 @@ make_lisp_ptr (void *ptr, enum Lisp_Type type)
   return a;
 }
 
-INLINE bool
-(FIXNUMP) (Lisp_Object x)
-{
-  return lisp_h_FIXNUMP (x);
-}
-
 #define XSETINT(a, b) ((a) = make_fixnum (b))
 #define XSETFASTINT(a, b) ((a) = make_fixed_natnum (b))
 #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons))
@@ -2832,6 +2823,16 @@ FIXNATP (Lisp_Object x)
 {
   return FIXNUMP (x) && 0 <= XFIXNUM (x);
 }
+
+/* Like XFIXNUM (A), but may be faster.  A must be nonnegative.  */
+INLINE EMACS_INT
+XFIXNAT (Lisp_Object a)
+{
+  eassume (FIXNATP (a));
+  EMACS_INT int0 = Lisp_Int0;
+  return USE_LSB_TAG ? XFIXNUM (a) : XLI (a) - (int0 << VALBITS);
+}
+
 INLINE bool
 NUMBERP (Lisp_Object x)
 {
diff --git a/src/process.c b/src/process.c
index 15d87cf601..cab390c10c 100644
--- a/src/process.c
+++ b/src/process.c
@@ -2675,7 +2675,7 @@ conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int
 	  for (i = 0; i < len; i++)
 	    if (FIXNUMP (p->contents[i]))
 	      {
-		int j = XFIXNAT (p->contents[i]) & 0xffff;
+		int j = XFIXNUM (p->contents[i]) & 0xffff;
 		ip6[i] = ntohs (j);
 	      }
 	  sa->sa_family = family;
diff --git a/src/textprop.c b/src/textprop.c
index ae42c44185..3026ec7e99 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -799,7 +799,7 @@ DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
       else
 	CHECK_FIXNUM_COERCE_MARKER (limit);
 
-      if (XFIXNAT (position) >= XFIXNAT (limit))
+      if (XFIXNAT (position) >= XFIXNUM (limit))
 	{
 	  position = limit;
 	  if (XFIXNAT (position) > ZV)
@@ -881,16 +881,17 @@ DEFUN ("previous-single-char-property-change",
       else
 	CHECK_FIXNUM_COERCE_MARKER (limit);
 
-      if (XFIXNAT (position) <= XFIXNAT (limit))
+      if (XFIXNUM (position) <= XFIXNUM (limit))
 	{
 	  position = limit;
-	  if (XFIXNAT (position) < BEGV)
+	  if (XFIXNUM (position) < BEGV)
 	    XSETFASTINT (position, BEGV);
 	}
       else
 	{
 	  Lisp_Object initial_value
-	    = Fget_char_property (make_fixnum (XFIXNAT (position) - 1),
+	    = Fget_char_property (make_fixnum (XFIXNUM (position)
+					       - (0 <= XFIXNUM (position))),
 				  prop, object);
 
 	  while (true)
@@ -970,13 +971,13 @@ DEFUN ("next-property-change", Fnext_property_change,
   next = next_interval (i);
 
   while (next && intervals_equal (i, next)
-	 && (NILP (limit) || next->position < XFIXNAT (limit)))
+	 && (NILP (limit) || next->position < XFIXNUM (limit)))
     next = next_interval (next);
 
   if (!next
       || (next->position
 	  >= (FIXNUMP (limit)
-	      ? XFIXNAT (limit)
+	      ? XFIXNUM (limit)
 	      : (STRINGP (object)
 		 ? SCHARS (object)
 		 : BUF_ZV (XBUFFER (object))))))
@@ -1019,13 +1020,13 @@ DEFUN ("next-single-property-change", Fnext_single_property_change,
   next = next_interval (i);
   while (next
 	 && EQ (here_val, textget (next->plist, prop))
-	 && (NILP (limit) || next->position < XFIXNAT (limit)))
+	 && (NILP (limit) || next->position < XFIXNUM (limit)))
     next = next_interval (next);
 
   if (!next
       || (next->position
 	  >= (FIXNUMP (limit)
-	      ? XFIXNAT (limit)
+	      ? XFIXNUM (limit)
 	      : (STRINGP (object)
 		 ? SCHARS (object)
 		 : BUF_ZV (XBUFFER (object))))))
@@ -1069,13 +1070,13 @@ DEFUN ("previous-property-change", Fprevious_property_change,
   previous = previous_interval (i);
   while (previous && intervals_equal (previous, i)
 	 && (NILP (limit)
-	     || (previous->position + LENGTH (previous) > XFIXNAT (limit))))
+	     || (previous->position + LENGTH (previous) > XFIXNUM (limit))))
     previous = previous_interval (previous);
 
   if (!previous
       || (previous->position + LENGTH (previous)
 	  <= (FIXNUMP (limit)
-	      ? XFIXNAT (limit)
+	      ? XFIXNUM (limit)
 	      : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
     return limit;
   else
@@ -1122,13 +1123,13 @@ DEFUN ("previous-single-property-change", Fprevious_single_property_change,
   while (previous
 	 && EQ (here_val, textget (previous->plist, prop))
 	 && (NILP (limit)
-	     || (previous->position + LENGTH (previous) > XFIXNAT (limit))))
+	     || (previous->position + LENGTH (previous) > XFIXNUM (limit))))
     previous = previous_interval (previous);
 
   if (!previous
       || (previous->position + LENGTH (previous)
 	  <= (FIXNUMP (limit)
-	      ? XFIXNAT (limit)
+	      ? XFIXNUM (limit)
 	      : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
     return limit;
   else
@@ -1353,8 +1354,8 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
   /* If we want no properties for a whole string,
      get rid of its intervals.  */
   if (NILP (properties) && STRINGP (object)
-      && XFIXNAT (start) == 0
-      && XFIXNAT (end) == SCHARS (object))
+      && EQ (start, make_fixnum (0))
+      && EQ (end, make_fixnum (SCHARS (object))))
     {
       if (!string_intervals (object))
 	return Qnil;
diff --git a/src/w32term.c b/src/w32term.c
index 5726124b0e..97a5fc6389 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -2464,7 +2464,7 @@ w32_draw_glyph_string (struct glyph_string *s)
 		    = buffer_local_value (Qunderline_minimum_offset,
 					s->w->contents);
 		  if (FIXNUMP (val))
-		    minimum_offset = XFIXNAT (val);
+		    minimum_offset = max (0, XFIXNUM (val));
 		  else
 		    minimum_offset = 1;
 		  val = buffer_local_value (Qx_underline_at_descent_line,
diff --git a/src/xterm.c b/src/xterm.c
index 1acff2af0d..38bc17de97 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -3807,7 +3807,7 @@ x_draw_glyph_string (struct glyph_string *s)
 		    = buffer_local_value (Qunderline_minimum_offset,
 					  s->w->contents);
 		  if (FIXNUMP (val))
-		    minimum_offset = XFIXNAT (val);
+		    minimum_offset = max (0, XFIXNUM (val));
 		  else
 		    minimum_offset = 1;
 		  val = buffer_local_value (Qx_underline_at_descent_line,
-- 
2.21.0