[Emacs-diffs] master 3548fd8: Debug out-of-range make_fixnum args

[Paul Eggert]

branch: master
commit 3548fd8a53869ce6b42c47f690660cb8eddb8aab
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    Debug out-of-range make_fixnum args
    
    With --enable-checking, make_fixnum (N) now checks that N is
    in fixnum range.  Suggested by Pip Cet in:
    https://lists.gnu.org/r/emacs-devel/2019-07/msg00548.html
    A new function make_ufixnum (N) is for the rare cases where N
    is intended to be unsigned and is in the range 0..INTMASK.
    * configure.ac (AC_C_TYPEOF): Add.
    (HAVE_STATEMENT_EXPRESSIONS): Resurrect this macro.
    * src/fns.c (Frandom, hashfn_eq, hashfn_equal, hashfn_user_defined):
    * src/profiler.c (hashfn_profiler):
    Use make_ufixnum rather than make_fixum, since the argument is
    an unsigned integer in the range 0..INTMASK rather than a signed
    integer in the range MOST_NEGATIVE_FIXNUM..MOST_POSITIVE_FIXNUM.
    Typically this is for hashes.
    * src/lisp.h (lisp_h_make_fixnum_wrap) [USE_LSB_TAG]:
    Rename from lisp_h_make_fixnum.
    (lisp_h_make_fixnum): Redefine in terms of lisp_h_make_fixnum_wrap.
    Check for fixnum overflow on compilers like GCC that
    have statement expressions and typeof.
    (FIXNUM_OVERFLOW_P): Move up.
    (make_fixnum): Check for fixnum overflow.
    (make_ufixnum): New function, which checks that the arg
    fits into 0..INTMASK range.
---
 configure.ac   | 13 +++++++++++++
 src/fns.c      |  8 ++++----
 src/lisp.h     | 47 ++++++++++++++++++++++++++++++++++++++++-------
 src/profiler.c |  2 +-
 4 files changed, 58 insertions(+), 12 deletions(-)

diff --git a/configure.ac b/configure.ac
index c093d86..1400fcb 100644
--- a/configure.ac
+++ b/configure.ac
@@ -5371,6 +5371,19 @@ if test "$emacs_cv_struct_alignment" = yes; then
      structure to an N-byte boundary.])
 fi
 
+AC_C_TYPEOF
+
+AC_CACHE_CHECK([for statement expressions],
+  [emacs_cv_statement_expressions],
+  [AC_COMPILE_IFELSE(
+     [AC_LANG_PROGRAM([], [[return ({ int x = 5; x-x; });]])],
+     [emacs_cv_statement_expressions=yes],
+     [emacs_cv_statement_expressions=no])])
+if test "$emacs_cv_statement_expressions" = yes; then
+  AC_DEFINE([HAVE_STATEMENT_EXPRESSIONS], 1,
+    [Define to 1 if statement expressions work.])
+fi
+
 if test "${GNU_MALLOC}" = "yes" ; then
   AC_DEFINE(GNU_MALLOC, 1,
            [Define to 1 if you want to use the GNU memory allocator.])
diff --git a/src/fns.c b/src/fns.c
index acc6d46..920adde 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -87,7 +87,7 @@ See Info node `(elisp)Random Numbers' for more details.  */)
          return make_fixnum (remainder);
        val = get_random ();
       }
-  return make_fixnum (val);
+  return make_ufixnum (val);
 }
 
 /* Random data-structure functions.  */
@@ -3994,7 +3994,7 @@ cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2,
 static Lisp_Object
 hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h)
 {
-  return make_fixnum (XHASH (key) ^ XTYPE (key));
+  return make_ufixnum (XHASH (key) ^ XTYPE (key));
 }
 
 /* Ignore HT and return a hash code for KEY which uses 'equal' to compare keys.
@@ -4003,7 +4003,7 @@ hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h)
 Lisp_Object
 hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h)
 {
-  return make_fixnum (sxhash (key, 0));
+  return make_ufixnum (sxhash (key, 0));
 }
 
 /* Ignore HT and return a hash code for KEY which uses 'eql' to compare keys.
@@ -4023,7 +4023,7 @@ hashfn_user_defined (Lisp_Object key, struct 
Lisp_Hash_Table *h)
 {
   Lisp_Object args[] = { h->test.user_hash_function, key };
   Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h);
-  return FIXNUMP (hash) ? hash : make_fixnum (sxhash (hash, 0));
+  return FIXNUMP (hash) ? hash : make_ufixnum (sxhash (hash, 0));
 }
 
 struct hash_table_test const
diff --git a/src/lisp.h b/src/lisp.h
index 0370c52..1c98925 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -397,8 +397,16 @@ typedef EMACS_INT Lisp_Word;
    (eassert (CONSP (a)), XUNTAG (a, Lisp_Cons, struct Lisp_Cons))
 #define lisp_h_XHASH(a) XUFIXNUM_RAW (a)
 #if USE_LSB_TAG
-# define lisp_h_make_fixnum(n) \
+# define lisp_h_make_fixnum_wrap(n) \
     XIL ((EMACS_INT) (((EMACS_UINT) (n) << INTTYPEBITS) + Lisp_Int0))
+# if defined HAVE_STATEMENT_EXPRESSIONS && defined HAVE_TYPEOF
+#  define lisp_h_make_fixnum(n) \
+     ({ typeof (n) lisp_h_make_fixnum_n = n; \
+       eassert (!FIXNUM_OVERFLOW_P (lisp_h_make_fixnum_n)); \
+       lisp_h_make_fixnum_wrap (lisp_h_make_fixnum_n); })
+# else
+#  define lisp_h_make_fixnum(n) lisp_h_make_fixnum_wrap (n)
+# endif
 # define lisp_h_XFIXNUM_RAW(a) (XLI (a) >> INTTYPEBITS)
 # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
 #endif
@@ -1125,12 +1133,18 @@ enum More_Lisp_Bits
 #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS)
 #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
 
+/* True if the possibly-unsigned integer I doesn't fit in a fixnum.  */
+
+#define FIXNUM_OVERFLOW_P(i) \
+  (! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= 
MOST_POSITIVE_FIXNUM))
+
 #if USE_LSB_TAG
 
 INLINE Lisp_Object
 (make_fixnum) (EMACS_INT n)
 {
-  return lisp_h_make_fixnum (n);
+  eassert (!FIXNUM_OVERFLOW_P (n));
+  return lisp_h_make_fixnum_wrap (n);
 }
 
 INLINE EMACS_INT
@@ -1139,6 +1153,13 @@ INLINE EMACS_INT
   return lisp_h_XFIXNUM_RAW (a);
 }
 
+INLINE Lisp_Object
+make_ufixnum (EMACS_INT n)
+{
+  eassert (0 <= n && n <= INTMASK);
+  return lisp_h_make_fixnum_wrap (n);
+}
+
 #else /* ! USE_LSB_TAG */
 
 /* Although compiled only if ! USE_LSB_TAG, the following functions
@@ -1149,6 +1170,7 @@ INLINE EMACS_INT
 INLINE Lisp_Object
 make_fixnum (EMACS_INT n)
 {
+  eassert (! FIXNUM_OVERFLOW_P (n));
   EMACS_INT int0 = Lisp_Int0;
   if (USE_LSB_TAG)
     {
@@ -1179,6 +1201,22 @@ XFIXNUM_RAW (Lisp_Object a)
   return i >> INTTYPEBITS;
 }
 
+INLINE Lisp_Object
+make_ufixnum (EMACS_INT n)
+{
+  eassert (0 <= n && n <= INTMASK);
+  EMACS_INT int0 = Lisp_Int0;
+  if (USE_LSB_TAG)
+    {
+      EMACS_UINT u = n;
+      n = u << INTTYPEBITS;
+      n += int0;
+    }
+  else
+    n += int0 << VALBITS;
+  return XIL (n);
+}
+
 #endif /* ! USE_LSB_TAG */
 
 INLINE bool
@@ -1232,11 +1270,6 @@ INLINE bool
   return lisp_h_EQ (x, y);
 }
 
-/* True if the possibly-unsigned integer I doesn't fit in a fixnum.  */
-
-#define FIXNUM_OVERFLOW_P(i) \
-  (! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= 
MOST_POSITIVE_FIXNUM))
-
 INLINE intmax_t
 clip_to_bounds (intmax_t lower, intmax_t num, intmax_t upper)
 {
diff --git a/src/profiler.c b/src/profiler.c
index 6b482ab..6943905 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -566,7 +566,7 @@ hashfn_profiler (Lisp_Object bt, struct Lisp_Hash_Table *h)
     }
   else
     hash = XHASH (bt);
-  return make_fixnum (SXHASH_REDUCE (hash));
+  return make_ufixnum (SXHASH_REDUCE (hash));
 }
 
 static void syms_of_profiler_for_pdumper (void);