[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 4893a09 1/3: Clean up use of XFIXNUM etc.
From: |
Paul Eggert |
Subject: |
[Emacs-diffs] master 4893a09 1/3: Clean up use of XFIXNUM etc. |
Date: |
Thu, 27 Jun 2019 15:35:14 -0400 (EDT) |
branch: master
commit 4893a09c005cac81c05cd3db05c87225be6a7b42
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>
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.
---
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 ec108e3..f1d4c28 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 c1699ae..46bd7e0 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 47c5450..fb5bcc9 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 0da9894..61e10da 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 e684aed..bbf25b4 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 77fc22d..077d236 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 15d87cf..cab390c 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 ae42c44..3026ec7 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 5726124..97a5fc6 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 1acff2a..38bc17d 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,