From: Paul Eggert Date: Thu, 27 Jun 2019 19:31:27 +0000 (-0700) Subject: Clean up use of XFIXNUM etc. X-Git-Tag: emacs-27.0.90~2179 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4893a09c005cac81c05cd3db05c87225be6a7b42;p=emacs.git Clean up use of XFIXNUM etc. 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. --- diff --git a/src/ccl.c b/src/ccl.c index ec108e30d86..f1d4c28df1c 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -2064,9 +2064,9 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY } 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 c1699aeae73..46bd7e0e253 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 47c545007ad..fb5bcc9ad3f 100644 --- a/src/dosfns.c +++ b/src/dosfns.c @@ -72,7 +72,7 @@ REGISTERS should be a vector produced by `make-register' and 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 0da9894a73a..61e10dac47f 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -4720,7 +4720,7 @@ by calling `format-decode', which see. */) 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 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) && 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 e684aedb99f..bbf25b4d58f 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 77fc22d1187..077d2360654 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -414,12 +414,11 @@ typedef EMACS_INT Lisp_Word; #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 @@ typedef EMACS_INT Lisp_Word; # 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 @@ INLINE Lisp_Object } 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 15d87cf6015..cab390c10c6 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 ae42c44185f..3026ec7e992 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -799,7 +799,7 @@ last valid position in OBJECT. */) 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 @@ first valid position in OBJECT. */) 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 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) 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 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) 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 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) 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 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) 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 5726124b0ed..97a5fc63892 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 1acff2af0da..38bc17de973 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,