Subject: Emacs port to gcc -fcheck-pointer-bounds
From: Paul Eggert <[email-masked]>
To: Emacs bug reports and feature requests <[email-masked]>
Date: Wed, 6 Dec 2017 23:18:35 -0800
List-Id: <debbugs-submit.debbugs.gnu.org>

Attached is a series of three patches to port Emacs to 'gcc 
-fcheck-pointer-bounds'. This feature enables hardware bounds checking for some 
internal pointers of the Emacs interpreter, and I've used it to find a bug in 
Emacs itself. It's intended primarily for debugging Emacs internals, and is off 
by default. I would like to install these patches soon unless some problems turn 
up, and am submitting this as a bug report in case others who care about Emacs 
low-level internals would like to review the patches.

The first patch changes the basic Emacs internal type from an integer to a 
pointer of the same width. Although this doesn't significantly affect ordinary 
builds it's essential for -fcheck-pointer-type, where the C compiler must be 
told the location of every pointer (including tagged pointers) for the checking 
to work well. (No doubt I'm partial, but I think this patch also cleans up Emacs 
internals a bit even for typical platforms.) The patch should not change the 
behavior of the Emacs interpreter; it's mostly just treating some intptr_t 
values as pointer values instead.

The second patch builds on the first to fix Emacs so that it doesn't crash when 
-fcheck-pointer-bounds is used.

The third patch enables more pointer bounds checking. Not every pointer access 
is checked, just the ones for which -fcheck-pointer-bounds is easy. Although 
this doesn't catch every pointer-bounds error, it does catch some of them. 
Perhaps more checking could be added later.
From 29c780279ce50db5e9fa8c45320ca4d77373bb92 Mon Sep 17 00:00:00 2001
From: Paul Eggert <[email-masked]>
Date: Wed, 6 Dec 2017 22:29:33 -0800
Subject: [PATCH 1/3] Reimplement Lisp_Object as pointer-to-incomplete

This makes Lisp_Object values opaque pointers instead of integers,
which helps avoid the same sort of typos that
CHECK_LISP_OBJECT_TYPE helps to avoid, without having to wrap
pointers inside structures.  This also looks forward to supporting
-fcheck-pointer-bounds.
* etc/DEBUG:
* src/.gdbinit (Lisp_Object_Printer.to_string):
Lisp_Object can be a pointer type now.
* src/alloc.c (macro_XPNTR, XPNTR):
* src/emacs-module.c (value_to_lisp_bits, lisp_to_value_bits):
* src/lisp.h (lisp_h_XLI, lisp_h_XIL):
(lisp_h_XUNTAG) [USE_LSB_TAG]:
(XUNTAG) [!USE_LSB_TAG]:
(Lisp_Object, TAG_PTR, make_lisp_symbol):
Support new Lisp_Object implementation as a pointer to an
incomplete type.  Keep pointers pointers, as much as possible.
* src/alloc.c (macro_XPNTR_OR_SYMBOL_OFFSET, XPNTR_OR_SYMBOL_OFFSET):
Remove.  All uses replaced by plain XPNTR.
* src/emacs-module.c: Work around GCC bug 83162.
* src/lisp.h (LISP_WORDS_ARE_POINTERS, lisp_h_XLP, lisp_h_XPL):
(XLP, XPL) [DEFINE_KEY_OPS_AS_MACROS]:
New macros.
(Lisp_Word, untagged_ptr, Lisp_Word_tag): New types.
(XLP, XPL): New inline functions.
(TAG_PTR): Now expands to an initializer, not an expression.
All uses changed.
(TAG_SYMOFFSET, XLI_BUILTIN_LISPSYM): Remove.  All uses removed.
(LISPSYM_INITIALLY): Redo in terms of the new TAG_PTR.
(NIL_IS_ZERO): Redo without XLI_BUILTIN_LISPSYM.
* src/xwidget.c (webkit_javascript_finished_cb): Use XPL
instead of XIL with a non-EMACS_INT arg.
(Fxwidget_webkit_execute_script): Use XLP instead of XLI
followed by two conversions.
---
 etc/DEBUG          |   7 +--
 src/.gdbinit       |  16 ++++--
 src/alloc.c        |  39 +++++---------
 src/emacs-module.c |  30 ++++++++---
 src/lisp.h         | 154 +++++++++++++++++++++++++++++++++++++----------------
 src/xwidget.c      |   5 +-
 6 files changed, 160 insertions(+), 91 deletions(-)

diff --git a/etc/DEBUG b/etc/DEBUG
index f5efbe0ff9..9fa6ac1d11 100644
--- a/etc/DEBUG
+++ b/etc/DEBUG
@@ -140,9 +140,10 @@ If you attached the debugger to a running Emacs, type "continue" into
 the *gud-emacs* buffer and press RET.
 
 Many variables you will encounter while debugging are Lisp objects.
-These are displayed as integer values (or structures, if you used the
-"--enable-check-lisp-object-type" option at configure time) that are
-hard to interpret, especially if they represent long lists.  You can
+These are normally displayed as opaque pointers or integers that are
+hard to interpret, especially if they represent long lists.
+(They are instead displayed as structures containing these opaque
+values, if --enable-check-lisp-object-type is in effect.)  You can
 use the 'pp' command to display them in their Lisp form.  That command
 displays its output on the standard error stream, which you
 can redirect to a file using "M-x redirect-debugging-output".
diff --git a/src/.gdbinit b/src/.gdbinit
index e22d03ea47..0eb2c73591 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -1321,19 +1321,26 @@ if hasattr(gdb, 'printing'):
       Lisp_Int0 = 2
       Lisp_Int1 = 6 if USE_LSB_TAG else 3
 
-      # Unpack the Lisp value from its containing structure, if necessary.
       val = self.val
       basic_type = gdb.types.get_basic_type (val.type)
+
+      # Unpack VAL from its containing structure, if necessary.
       if (basic_type.code == gdb.TYPE_CODE_STRUCT
           and gdb.types.has_field (basic_type, "i")):
         val = val["i"]
 
+      # Convert VAL to a Python integer.  Convert by hand, as this is
+      # simpler and works regardless of whether VAL is a pointer or
+      # integer.  Also, val.cast (gdb.lookup.type ("EMACS_UINT"))
+      # would have problems with GDB 7.12.1; see
+      # <http://patchwork.sourceware.org/patch/11557/>.
+      ival = int (val)
+
       # For nil, yield "XIL(0)", which is easier to read than "XIL(0x0)".
-      if not val:
+      if not ival:
         return "XIL(0)"
 
       # Extract the integer representation of the value and its Lisp type.
-      ival = int(val)
       itype = ival >> (0 if USE_LSB_TAG else VALBITS)
       itype = itype & ((1 << GCTYPEBITS) - 1)
 
@@ -1352,8 +1359,7 @@ if hasattr(gdb, 'printing'):
       # integers even when Lisp_Object is an integer.
       # Perhaps some day the pretty-printing could be fancier.
       # Prefer the unsigned representation to negative values, converting
-      # by hand as val.cast(gdb.lookup_type("EMACS_UINT") does not work in
-      # GDB 7.12.1; see <http://patchwork.sourceware.org/patch/11557/>.
+      # by hand as val.cast does not work in GDB 7.12.1 as noted above.
       if ival < 0:
         ival = ival + (1 << EMACS_INT_WIDTH)
       return "XIL(0x%x)" % ival
diff --git a/src/alloc.c b/src/alloc.c
index 4f3928a482..38daee065a 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -502,30 +502,20 @@ pointer_align (void *ptr, int alignment)
   return (void *) ROUNDUP ((uintptr_t) ptr, alignment);
 }
 
-/* Extract the pointer hidden within A, if A is not a symbol.
-   If A is a symbol, extract the hidden pointer's offset from lispsym,
-   converted to void *.  */
+/* Extract the pointer hidden within O.  Define this as a function, as
+   functions are cleaner and can be used in debuggers.  Also, define
+   it as a macro if being compiled with GCC without optimization, for
+   performance in that case.  macro_XPNTR is private to this section
+   of code.  */
+
+#define macro_XPNTR(o)                                                 \
+  ((void *) \
+   (SYMBOLP (o)							       \
+    ? ((char *) lispsym						       \
+       - ((EMACS_UINT) Lisp_Symbol << (USE_LSB_TAG ? 0 : VALBITS))     \
+       + XLI (o))						       \
+    : (char *) XLP (o) - (XLI (o) & ~VALMASK)))
 
-#define macro_XPNTR_OR_SYMBOL_OFFSET(a) \
-  ((void *) (intptr_t) (USE_LSB_TAG ? XLI (a) - XTYPE (a) : XLI (a) & VALMASK))
-
-/* Extract the pointer hidden within A.  */
-
-#define macro_XPNTR(a) \
-  ((void *) ((intptr_t) XPNTR_OR_SYMBOL_OFFSET (a) \
-	     + (SYMBOLP (a) ? (char *) lispsym : NULL)))
-
-/* For pointer access, define XPNTR and XPNTR_OR_SYMBOL_OFFSET as
-   functions, as functions are cleaner and can be used in debuggers.
-   Also, define them as macros if being compiled with GCC without
-   optimization, for performance in that case.  The macro_* names are
-   private to this section of code.  */
-
-static ATTRIBUTE_UNUSED void *
-XPNTR_OR_SYMBOL_OFFSET (Lisp_Object a)
-{
-  return macro_XPNTR_OR_SYMBOL_OFFSET (a);
-}
 static ATTRIBUTE_UNUSED void *
 XPNTR (Lisp_Object a)
 {
@@ -533,7 +523,6 @@ XPNTR (Lisp_Object a)
 }
 
 #if DEFINE_KEY_OPS_AS_MACROS
-# define XPNTR_OR_SYMBOL_OFFSET(a) macro_XPNTR_OR_SYMBOL_OFFSET (a)
 # define XPNTR(a) macro_XPNTR (a)
 #endif
 
@@ -5605,7 +5594,7 @@ static Lisp_Object
 purecopy (Lisp_Object obj)
 {
   if (INTEGERP (obj)
-      || (! SYMBOLP (obj) && PURE_P (XPNTR_OR_SYMBOL_OFFSET (obj)))
+      || (! SYMBOLP (obj) && PURE_P (XPNTR (obj)))
       || SUBRP (obj))
     return obj;    /* Already pure.  */
 
diff --git a/src/emacs-module.c b/src/emacs-module.c
index b351515c3b..9a02e7d482 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -36,6 +36,11 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #include <intprops.h>
 #include <verify.h>
 
+/* Work around GCC bug 83162.  */
+#if GNUC_PREREQ (4, 3, 0)
+# pragma GCC diagnostic ignored "-Wclobbered"
+#endif
+
 /* We use different strategies for allocating the user-visible objects
    (struct emacs_runtime, emacs_env, emacs_value), depending on
    whether the user supplied the -module-assertions flag.  If
@@ -915,9 +920,8 @@ static Lisp_Object ltv_mark;
 static Lisp_Object
 value_to_lisp_bits (emacs_value v)
 {
-  intptr_t i = (intptr_t) v;
   if (plain_values || USE_LSB_TAG)
-    return XIL (i);
+    return XPL (v);
 
   /* With wide EMACS_INT and when tag bits are the most significant,
      reassembling integers differs from reassembling pointers in two
@@ -926,6 +930,7 @@ value_to_lisp_bits (emacs_value v)
      integer when restoring, but zero-extend pointers because that
      makes TAG_PTR faster.  */
 
+  intptr_t i = (intptr_t) v;
   EMACS_UINT tag = i & (GCALIGNMENT - 1);
   EMACS_UINT untagged = i - tag;
   switch (tag)
@@ -989,13 +994,22 @@ value_to_lisp (emacs_value v)
 static emacs_value
 lisp_to_value_bits (Lisp_Object o)
 {
-  EMACS_UINT u = XLI (o);
+  if (plain_values || USE_LSB_TAG)
+    return XLP (o);
 
-  /* Compress U into the space of a pointer, possibly losing information.  */
-  uintptr_t p = (plain_values || USE_LSB_TAG
-		 ? u
-		 : (INTEGERP (o) ? u << VALBITS : u & VALMASK) + XTYPE (o));
-  return (emacs_value) p;
+  /* Compress O into the space of a pointer, possibly losing information.  */
+  EMACS_UINT u = XLI (o);
+  if (INTEGERP (o))
+    {
+      uintptr_t i = (u << VALBITS) + XTYPE (o);
+      return (emacs_value) i;
+    }
+  else
+    {
+      char *p = XLP (o);
+      void *v = p - (u & ~VALMASK) + XTYPE (o);
+      return v;
+    }
 }
 
 /* Convert O to an emacs_value.  Allocate storage if needed; this can
diff --git a/src/lisp.h b/src/lisp.h
index 68824d6b39..d2050ec0e7 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -277,6 +277,18 @@ DEFINE_GDB_SYMBOL_END (VALMASK)
 error !;
 #endif
 
+/* Lisp_Word is a scalar word suitable for holding a tagged pointer or
+   integer.  Usually it is a pointer to a deliberately-incomplete type
+   'union Lisp_X'.  However, it is EMACS_INT when Lisp_Objects and
+   pointers differ in width.  */
+
+#define LISP_WORDS_ARE_POINTERS (EMACS_INT_MAX == INTPTR_MAX)
+#if LISP_WORDS_ARE_POINTERS
+typedef union Lisp_X *Lisp_Word;
+#else
+typedef EMACS_INT Lisp_Word;
+#endif
+
 /* Some operations are so commonly executed that they are implemented
    as macros, not functions, because otherwise runtime performance would
    suffer too much when compiling with GCC without optimization.
@@ -302,16 +314,37 @@ error !;
    functions, once "gcc -Og" (new to GCC 4.8) works well enough for
    Emacs developers.  Maybe in the year 2020.  See Bug#11935.
 
-   Commentary for these macros can be found near their corresponding
-   functions, below.  */
-
-#if CHECK_LISP_OBJECT_TYPE
-# define lisp_h_XLI(o) ((o).i)
-# define lisp_h_XIL(i) ((Lisp_Object) { i })
+   For the macros that have corresponding functions (defined later),
+   see these functions for commentary.  */
+
+/* Convert among the various Lisp-related types: I for EMACS_INT, L
+   for Lisp_Object, P for void *.  */
+#if !CHECK_LISP_OBJECT_TYPE
+# if LISP_WORDS_ARE_POINTERS
+#  define lisp_h_XLI(o) ((EMACS_INT) (o))
+#  define lisp_h_XIL(i) ((Lisp_Object) (i))
+#  define lisp_h_XLP(o) ((void *) (o))
+#  define lisp_h_XPL(p) ((Lisp_Object) (p))
+# else
+#  define lisp_h_XLI(o) (o)
+#  define lisp_h_XIL(i) (i)
+#  define lisp_h_XLP(o) ((void *) (uintptr_t) (o))
+#  define lisp_h_XPL(p) ((Lisp_Object) (uintptr_t) (p))
+# endif
 #else
-# define lisp_h_XLI(o) (o)
-# define lisp_h_XIL(i) (i)
+# if LISP_WORDS_ARE_POINTERS
+#  define lisp_h_XLI(o) ((EMACS_INT) (o).i)
+#  define lisp_h_XIL(i) ((Lisp_Object) {(Lisp_Word) (i)})
+#  define lisp_h_XLP(o) ((void *) (o).i)
+#  define lisp_h_XPL(p) lisp_h_XIL (p)
+# else
+#  define lisp_h_XLI(o) ((o).i)
+#  define lisp_h_XIL(i) ((Lisp_Object) {i})
+#  define lisp_h_XLP(o) ((void *) (uintptr_t) (o).i)
+#  define lisp_h_XPL(p) ((Lisp_Object) {(uintptr_t) (p)})
+# endif
 #endif
+
 #define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x)
 #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
 #define lisp_h_CHECK_TYPE(ok, predicate, x) \
@@ -352,8 +385,7 @@ error !;
 			     + (char *) lispsym))
 # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
 # define lisp_h_XUNTAG(a, type) \
-    __builtin_assume_aligned ((void *) (intptr_t) (XLI (a) - (type)), \
-			      GCALIGNMENT)
+    __builtin_assume_aligned ((char *) XLP (a) - (type), GCALIGNMENT)
 #endif
 
 /* When compiling via gcc -O0, define the key operations as macros, as
@@ -370,6 +402,8 @@ error !;
 #if DEFINE_KEY_OPS_AS_MACROS
 # define XLI(o) lisp_h_XLI (o)
 # define XIL(i) lisp_h_XIL (i)
+# define XLP(o) lisp_h_XLP (o)
+# define XPL(p) lisp_h_XPL (p)
 # define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x)
 # define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x)
 # define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x)
@@ -543,22 +577,24 @@ enum Lisp_Fwd_Type
    your object -- this way, the same object could be used to represent
    several disparate C structures.  */
 
-#ifdef CHECK_LISP_OBJECT_TYPE
 
-typedef struct Lisp_Object { EMACS_INT i; } Lisp_Object;
+/* A Lisp_Object is a tagged pointer or integer.  Ordinarily it is a
+   Lisp_Word.  However, if CHECK_LISP_OBJECT_TYPE, it is a wrapper
+   around Lisp_Word, to help catch thinkos like 'Lisp_Object x = 0;'.
 
-#define LISP_INITIALLY(i) {i}
+   LISP_INITIALLY (W) initializes a Lisp object with a tagged value
+   that is a Lisp_Word W.  It can be used in a static initializer.  */
 
-#undef CHECK_LISP_OBJECT_TYPE
+#ifdef CHECK_LISP_OBJECT_TYPE
+typedef struct Lisp_Object { Lisp_Word i; } Lisp_Object;
+# define LISP_INITIALLY(w) {w}
+# undef CHECK_LISP_OBJECT_TYPE
 enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true };
-#else /* CHECK_LISP_OBJECT_TYPE */
-
-/* If a struct type is not wanted, define Lisp_Object as just a number.  */
-
-typedef EMACS_INT Lisp_Object;
-#define LISP_INITIALLY(i) (i)
+#else
+typedef Lisp_Word Lisp_Object;
+# define LISP_INITIALLY(w) (w)
 enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false };
-#endif /* CHECK_LISP_OBJECT_TYPE */
+#endif
 
 /* Forward declarations.  */
 
@@ -590,8 +626,10 @@ extern double extract_float (Lisp_Object);
 
 /* Low-level conversion and type checking.  */
 
-/* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa.
-   At the machine level, these operations are no-ops.  */
+/* Convert among various types use to implement Lisp_Object.  At the
+   machine level, these operations may widen or narrow their arguments
+   if pointers differ in width from EMACS_INT; otherwise they are
+   no-ops.  */
 
 INLINE EMACS_INT
 (XLI) (Lisp_Object o)
@@ -605,6 +643,18 @@ INLINE Lisp_Object
   return lisp_h_XIL (i);
 }
 
+INLINE void *
+(XLP) (Lisp_Object o)
+{
+  return lisp_h_XLP (o);
+}
+
+INLINE Lisp_Object
+(XPL) (void *p)
+{
+  return lisp_h_XPL (p);
+}
+
 /* Extract A's type.  */
 
 INLINE enum Lisp_Type
@@ -632,8 +682,9 @@ INLINE void *
 #if USE_LSB_TAG
   return lisp_h_XUNTAG (a, type);
 #else
-  intptr_t i = USE_LSB_TAG ? XLI (a) - type : XLI (a) & VALMASK;
-  return (void *) i;
+  EMACS_UINT utype = type;
+  char *p = XLP (a);
+  return p - (utype << (USE_LSB_TAG ? 0 : VALBITS));
 #endif
 }
 
@@ -744,28 +795,34 @@ verify (alignof (struct Lisp_Symbol) % GCALIGNMENT == 0);
 #define DEFUN_ARGS_8	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
 			 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
 
-/* Yield a signed integer that contains TAG along with PTR.
+/* Typedefs useful for implementing TAG_PTR.  untagged_ptr represents
+   a pointer before tagging, and Lisp_Word_tag contains a
+   possibly-shifted tag to be added to an untagged_ptr to convert it
+   to a Lisp_Word.  */
+#if LISP_WORDS_ARE_POINTERS
+/* untagged_ptr is a pointer so that the compiler knows that TAG_PTR
+   yields a pointer; this can help with gcc -fcheck-pointer-bounds.
+   It is char * so that adding a tag uses simple machine addition.  */
+typedef char *untagged_ptr;
+typedef uintptr_t Lisp_Word_tag;
+#else
+/* untagged_ptr is an unsigned integer instead of a pointer, so that
+   it can be added to the possibly-wider Lisp_Word_tag type without
+   losing information.  */
+typedef uintptr_t untagged_ptr;
+typedef EMACS_UINT Lisp_Word_tag;
+#endif
 
-   Sign-extend pointers when USE_LSB_TAG (this simplifies emacs-module.c),
-   and zero-extend otherwise (that’s a bit faster here).
-   Sign extension matters only when EMACS_INT is wider than a pointer.  */
+/* An initializer for a Lisp_Object that contains TAG along with PTR.  */
 #define TAG_PTR(tag, ptr) \
-  (USE_LSB_TAG \
-   ? (intptr_t) (ptr) + (tag) \
-   : (EMACS_INT) (((EMACS_UINT) (tag) << VALBITS) + (uintptr_t) (ptr)))
-
-/* Yield an integer that contains a symbol tag along with OFFSET.
-   OFFSET should be the offset in bytes from 'lispsym' to the symbol.  */
-#define TAG_SYMOFFSET(offset) TAG_PTR (Lisp_Symbol, offset)
-
-/* XLI_BUILTIN_LISPSYM (iQwhatever) is equivalent to
-   XLI (builtin_lisp_symbol (Qwhatever)),
-   except the former expands to an integer constant expression.  */
-#define XLI_BUILTIN_LISPSYM(iname) TAG_SYMOFFSET ((iname) * sizeof *lispsym)
+  LISP_INITIALLY ((Lisp_Word) \
+		  ((untagged_ptr) (ptr) \
+		   + ((Lisp_Word_tag) (tag) << (USE_LSB_TAG ? 0 : VALBITS))))
 
 /* LISPSYM_INITIALLY (Qfoo) is equivalent to Qfoo except it is
    designed for use as an initializer, even for a constant initializer.  */
-#define LISPSYM_INITIALLY(name) LISP_INITIALLY (XLI_BUILTIN_LISPSYM (i##name))
+#define LISPSYM_INITIALLY(name) \
+  TAG_PTR (Lisp_Symbol, (char *) (intptr_t) ((i##name) * sizeof *lispsym))
 
 /* Declare extern constants for Lisp symbols.  These can be helpful
    when using a debugger like GDB, on older platforms where the debug
@@ -843,7 +900,8 @@ INLINE struct Lisp_Symbol *
 INLINE Lisp_Object
 make_lisp_symbol (struct Lisp_Symbol *sym)
 {
-  Lisp_Object a = XIL (TAG_SYMOFFSET ((char *) sym - (char *) lispsym));
+  intptr_t symoffset = (char *) sym - (char *) lispsym;
+  Lisp_Object a = TAG_PTR (Lisp_Symbol, (char *) symoffset);
   eassert (XSYMBOL (a) == sym);
   return a;
 }
@@ -1061,7 +1119,7 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper)
 INLINE Lisp_Object
 make_lisp_ptr (void *ptr, enum Lisp_Type type)
 {
-  Lisp_Object a = XIL (TAG_PTR (type, ptr));
+  Lisp_Object a = TAG_PTR (type, ptr);
   eassert (XTYPE (a) == type && XUNTAG (a, type) == ptr);
   return a;
 }
@@ -1132,7 +1190,7 @@ XINTPTR (Lisp_Object a)
 INLINE Lisp_Object
 make_pointer_integer (void *p)
 {
-  Lisp_Object a = XIL (TAG_PTR (Lisp_Int0, p));
+  Lisp_Object a = TAG_PTR (Lisp_Int0, p);
   eassert (INTEGERP (a) && XINTPTR (a) == p);
   return a;
 }
@@ -1644,8 +1702,10 @@ gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
 
 /* True, since Qnil's representation is zero.  Every place in the code
    that assumes Qnil is zero should verify (NIL_IS_ZERO), to make it easy
-   to find such assumptions later if we change Qnil to be nonzero.  */
-enum { NIL_IS_ZERO = XLI_BUILTIN_LISPSYM (iQnil) == 0 };
+   to find such assumptions later if we change Qnil to be nonzero.
+   Test iQnil and Lisp_Symbol instead of Qnil directly, since the latter
+   is not suitable for use in an integer constant expression.  */
+enum { NIL_IS_ZERO = iQnil == 0 && Lisp_Symbol == 0 };
 
 /* Clear the object addressed by P, with size NBYTES, so that all its
    bytes are zero and all its Lisp values are nil.  */
diff --git a/src/xwidget.c b/src/xwidget.c
index a67dc0ecf4..c7f0594728 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -392,8 +392,7 @@ webkit_javascript_finished_cb (GObject      *webview,
     /* FIXME: This might lead to disaster if LISP_CALLBACK’s object
        was garbage collected before now.  See the FIXME in
        Fxwidget_webkit_execute_script.  */
-    store_xwidget_js_callback_event (xw, XIL ((intptr_t) lisp_callback),
-                                     lisp_value);
+    store_xwidget_js_callback_event (xw, XPL (lisp_callback), lisp_value);
 }

@@ -723,7 +722,7 @@ argument procedure FUN.*/)
   /* FIXME: This hack might lead to disaster if FUN is garbage
      collected before store_xwidget_js_callback_event makes it visible
      to Lisp again.  See the FIXME in webkit_javascript_finished_cb.  */
-  gpointer callback_arg = (gpointer) (intptr_t) XLI (fun);
+  gpointer callback_arg = XLP (fun);
 
   /* JavaScript execution happens asynchronously.  If an elisp
      callback function is provided we pass it to the C callback
-- 
2.14.1

From d37f26b20efc89024c65161ee74b82ad90589a40 Mon Sep 17 00:00:00 2001
From: Paul Eggert <[email-masked]>
Date: Wed, 6 Dec 2017 22:29:33 -0800
Subject: [PATCH 2/3] Port to gcc -fcheck-pointer-bounds

This is a minimal port, just to get Emacs running;
it does not attempt to make the pointer bounds at all tight.
* src/ptr-bounds.h: New file.
* src/alloc.c, src/gmalloc.c: Include it.
* src/alloc.c (live_string_holding, live_cons_holding)
(live_symbol_holding, live_misc_holding, garbage_collect_1)
(sweep_conses, sweep_floats):
* src/gmalloc.c (malloc_initialize_1, _free_internal_nolock)
(_realloc_internal_nolock):
Widen pointer bounds as necessary.
We're in a memory allocator so this is OK.
* src/lisp.h (lisp_h_XSYMBOL, make_lisp_symbol) [__CHKP__]:
Do not convert from pointer to integer and back again, so
that GCC does not lose track of pointer bounds.
(XSYMBOL) [__CHKP__ && !USE_LSB_TAG]: Now a compile-time error.
Although it's possible to support both -fcheck-pointer-bounds and
--with-wide-int, it's more work; keep things simple for now.
(DEFINE_LISP_SYMBOL) [__CHKP__]: Now a no-op, to avoid
trouble with unbounded pointers.
---
 etc/NEWS         |  7 +++++++
 src/alloc.c      | 37 ++++++++++++++++++++++++-------------
 src/gmalloc.c    |  6 +++++-
 src/lisp.h       | 34 +++++++++++++++++++++++++++-------
 src/ptr-bounds.h | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 115 insertions(+), 21 deletions(-)
 create mode 100644 src/ptr-bounds.h

diff --git a/etc/NEWS b/etc/NEWS
index cbd50f0227..e032055312 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -24,6 +24,13 @@ When you add a new item, use the appropriate mark if you are sure it applies,
 
 * Installation Changes in Emacs 27.1
 
+** Emacs has been ported to the -fcheck-pointer-bounds option of GCC.
+This causes Emacs to check bounds of some arrays addressed by its
+internal pointers, which can be helpful when debugging the Emacs
+interpreter or modules that it uses.  If your platform supports it you
+can enable it when configuring, e.g., './configure CFLAGS="-g3 -O2
+-mmpx -fcheck-pointer-bounds"' on Intel MPX platforms.
+
 
 * Startup Changes in Emacs 27.1
 
diff --git a/src/alloc.c b/src/alloc.c
index 38daee065a..96b9aaa0d2 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -33,6 +33,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #include "lisp.h"
 #include "dispextern.h"
 #include "intervals.h"
+#include "ptr-bounds.h"
 #include "puresize.h"
 #include "sheap.h"
 #include "systime.h"
@@ -4564,6 +4565,7 @@ live_string_holding (struct mem_node *m, void *p)
 	 must not be on the free-list.  */
       if (0 <= offset && offset < STRING_BLOCK_SIZE * sizeof b->strings[0])
 	{
+	  cp = ptr_bounds_copy (cp, b);
 	  struct Lisp_String *s = p = cp -= offset % sizeof b->strings[0];
 	  if (s->u.s.data)
 	    return make_lisp_ptr (s, Lisp_String);
@@ -4598,6 +4600,7 @@ live_cons_holding (struct mem_node *m, void *p)
 	  && (b != cons_block
 	      || offset / sizeof b->conses[0] < cons_block_index))
 	{
+	  cp = ptr_bounds_copy (cp, b);
 	  struct Lisp_Cons *s = p = cp -= offset % sizeof b->conses[0];
 	  if (!EQ (s->u.s.car, Vdead))
 	    return make_lisp_ptr (s, Lisp_Cons);
@@ -4633,6 +4636,7 @@ live_symbol_holding (struct mem_node *m, void *p)
 	  && (b != symbol_block
 	      || offset / sizeof b->symbols[0] < symbol_block_index))
 	{
+	  cp = ptr_bounds_copy (cp, b);
 	  struct Lisp_Symbol *s = p = cp -= offset % sizeof b->symbols[0];
 	  if (!EQ (s->u.s.function, Vdead))
 	    return make_lisp_symbol (s);
@@ -4692,6 +4696,7 @@ live_misc_holding (struct mem_node *m, void *p)
 	  && (b != marker_block
 	      || offset / sizeof b->markers[0] < marker_block_index))
 	{
+	  cp = ptr_bounds_copy (cp, b);
 	  union Lisp_Misc *s = p = cp -= offset % sizeof b->markers[0];
 	  if (s->u_any.type != Lisp_Misc_Free)
 	    return make_lisp_ptr (s, Lisp_Misc);
@@ -5955,6 +5960,7 @@ garbage_collect_1 (void *end)
 	      stack_copy = xrealloc (stack_copy, stack_size);
 	      stack_copy_size = stack_size;
 	    }
+	  stack = ptr_bounds_set (stack, stack_size);
 	  no_sanitize_memcpy (stack_copy, stack, stack_size);
 	}
     }
@@ -6848,7 +6854,9 @@ sweep_conses (void)
 
               for (pos = start; pos < stop; pos++)
                 {
-                  if (!CONS_MARKED_P (&cblk->conses[pos]))
+		  struct Lisp_Cons *acons
+		    = ptr_bounds_copy (&cblk->conses[pos], cblk);
+		  if (!CONS_MARKED_P (acons))
                     {
                       this_free++;
                       cblk->conses[pos].u.s.u.chain = cons_free_list;
@@ -6858,7 +6866,7 @@ sweep_conses (void)
                   else
                     {
                       num_used++;
-                      CONS_UNMARK (&cblk->conses[pos]);
+		      CONS_UNMARK (acons);
                     }
                 }
             }
@@ -6901,17 +6909,20 @@ sweep_floats (void)
       register int i;
       int this_free = 0;
       for (i = 0; i < lim; i++)
-        if (!FLOAT_MARKED_P (&fblk->floats[i]))
-          {
-            this_free++;
-            fblk->floats[i].u.chain = float_free_list;
-            float_free_list = &fblk->floats[i];
-          }
-        else
-          {
-            num_used++;
-            FLOAT_UNMARK (&fblk->floats[i]);
-          }
+	{
+	  struct Lisp_Float *afloat = ptr_bounds_copy (&fblk->floats[i], fblk);
+	  if (!FLOAT_MARKED_P (afloat))
+	    {
+	      this_free++;
+	      fblk->floats[i].u.chain = float_free_list;
+	      float_free_list = &fblk->floats[i];
+	    }
+	  else
+	    {
+	      num_used++;
+	      FLOAT_UNMARK (afloat);
+	    }
+	}
       lim = FLOAT_BLOCK_SIZE;
       /* If this block contains only free floats and we have already
          seen more than two blocks worth of free floats then deallocate
diff --git a/src/gmalloc.c b/src/gmalloc.c
index a17d39c1ee..97ab76561f 100644
--- a/src/gmalloc.c
+++ b/src/gmalloc.c
@@ -40,6 +40,8 @@ License along with this library.  If not, see <https://www.gnu.org/licenses/>.
 # include "lisp.h"
 #endif
 
+#include "ptr-bounds.h"
+
 #ifdef HAVE_MALLOC_H
 # if GNUC_PREREQ (4, 2, 0)
 #  pragma GCC diagnostic ignored "-Wdeprecated-declarations"
@@ -558,7 +560,7 @@ malloc_initialize_1 (void)
   _heapinfo[0].free.size = 0;
   _heapinfo[0].free.next = _heapinfo[0].free.prev = 0;
   _heapindex = 0;
-  _heapbase = (char *) _heapinfo;
+  _heapbase = (char *) ptr_bounds_init (_heapinfo);
   _heaplimit = BLOCK (_heapbase + heapsize * sizeof (malloc_info));
 
   register_heapinfo ();
@@ -997,6 +999,7 @@ _free_internal_nolock (void *ptr)
 
   if (ptr == NULL)
     return;
+  ptr = ptr_bounds_init (ptr);
 
   PROTECT_MALLOC_STATE (0);
 
@@ -1308,6 +1311,7 @@ _realloc_internal_nolock (void *ptr, size_t size)
   else if (ptr == NULL)
     return _malloc_internal_nolock (size);
 
+  ptr = ptr_bounds_init (ptr);
   block = BLOCK (ptr);
 
   PROTECT_MALLOC_STATE (0);
diff --git a/src/lisp.h b/src/lisp.h
index d2050ec0e7..38a098da82 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -379,10 +379,18 @@ typedef EMACS_INT Lisp_Word;
     XIL ((EMACS_INT) (((EMACS_UINT) (n) << INTTYPEBITS) + Lisp_Int0))
 # define lisp_h_XFASTINT(a) XINT (a)
 # define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS)
-# define lisp_h_XSYMBOL(a) \
+# ifdef __CHKP__
+#  define lisp_h_XSYMBOL(a) \
+    (eassert (SYMBOLP (a)), \
+     (struct Lisp_Symbol *) ((char *) XUNTAG (a, Lisp_Symbol) \
+			     + (intptr_t) lispsym))
+# else
+   /* If !__CHKP__ this is equivalent, and is a bit faster as of GCC 7.  */
+#  define lisp_h_XSYMBOL(a) \
     (eassert (SYMBOLP (a)), \
      (struct Lisp_Symbol *) ((intptr_t) XLI (a) - Lisp_Symbol \
 			     + (char *) lispsym))
+# endif
 # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
 # define lisp_h_XUNTAG(a, type) \
     __builtin_assume_aligned ((char *) XLP (a) - (type), GCALIGNMENT)
@@ -826,10 +834,15 @@ typedef EMACS_UINT Lisp_Word_tag;
 
 /* Declare extern constants for Lisp symbols.  These can be helpful
    when using a debugger like GDB, on older platforms where the debug
-   format does not represent C macros.  */
-#define DEFINE_LISP_SYMBOL(name) \
-  DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) \
-  DEFINE_GDB_SYMBOL_END (LISPSYM_INITIALLY (name))
+   format does not represent C macros.  However, they are unbounded
+   and would just be asking for trouble if checking pointer bounds.  */
+#ifdef __CHKP__
+# define DEFINE_LISP_SYMBOL(name)
+#else
+# define DEFINE_LISP_SYMBOL(name) \
+   DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) \
+   DEFINE_GDB_SYMBOL_END (LISPSYM_INITIALLY (name))
+#endif
 
 /* The index of the C-defined Lisp symbol SYM.
    This can be used in a static initializer.  */
@@ -889,6 +902,8 @@ INLINE struct Lisp_Symbol *
 {
 #if USE_LSB_TAG
   return lisp_h_XSYMBOL (a);
+#elif defined __CHKP__
+# error "pointer-checking not supported with wide integers"
 #else
   eassert (SYMBOLP (a));
   intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol);
@@ -900,8 +915,13 @@ INLINE struct Lisp_Symbol *
 INLINE Lisp_Object
 make_lisp_symbol (struct Lisp_Symbol *sym)
 {
-  intptr_t symoffset = (char *) sym - (char *) lispsym;
-  Lisp_Object a = TAG_PTR (Lisp_Symbol, (char *) symoffset);
+#ifdef __CHKP__
+  char *symoffset = (char *) sym - (intptr_t) lispsym;
+#else
+  /* If !__CHKP__ this is equivalent, and is a bit faster as of GCC 7.  */
+  char *symoffset = (char *) ((char *) sym - (char *) lispsym);
+#endif
+  Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset);
   eassert (XSYMBOL (a) == sym);
   return a;
 }
diff --git a/src/ptr-bounds.h b/src/ptr-bounds.h
new file mode 100644
index 0000000000..54979824c0
--- /dev/null
+++ b/src/ptr-bounds.h
@@ -0,0 +1,52 @@
+/* Pointer bounds checking for GNU Emacs
+
+Copyright 2017 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
+
+#ifndef PTR_BOUNDS_H
+#define PTR_BOUNDS_H
+
+#include <stddef.h>
+
+/* When not checking pointer bounds, the following macros simply
+   return their first argument.  These macros return either void *, or
+   the same type as their first argument.  */
+
+/* Return a copy of P, but with the bounds of Q.  */
+#ifdef __CHKP__
+# define ptr_bounds_copy(p, q) __builtin___bnd_copy_ptr_bounds (p, q)
+#else
+# define ptr_bounds_copy(p, q) ((void) (void const *) {q}, p)
+#endif
+
+/* Return a copy of P, but with infinite bounds.
+   This is a loophole in pointer bounds checking.  */
+#ifdef __CHKP__
+# define ptr_bounds_init(p) __builtin___bnd_init_ptr_bounds (p)
+#else
+# define ptr_bounds_init(p) (p)
+#endif
+
+/* Return a copy of P, but with bounds [P, P + N).
+   This is a loophole in pointer bounds checking.  */
+#ifdef __CHKP__
+# define ptr_bounds_set(p, n) __builtin___bnd_set_ptr_bounds (p, n)
+#else
+# define ptr_bounds_set(p, n) ((void) (size_t) {n}, p)
+#endif
+
+#endif /* PTR_BOUNDS_H */
-- 
2.14.1

From 08dd8655ae276d12d1ea9f075871ecf6ad69d229 Mon Sep 17 00:00:00 2001
From: Paul Eggert <[email-masked]>
Date: Wed, 6 Dec 2017 22:29:33 -0800
Subject: [PATCH 3/3] Narrow pointer bounds when appropriate

This typically occurs in a storage manager, where the caller
is expected to access only the newly-allocated object,
instead of using the returned value to access unrelated
parts of the heap.
* src/alloc.c (allocate_string, allocate_string_data)
(compact_small_strings, find_string_data_in_pure)
(sweep_strings, setup_on_free_list, allocate_vectorlike
(pure_alloc):
* src/bytecode.c (exec_byte_code):
* src/callint.c (Fcall_interactively):
* src/dispnew.c (scrolling):
* src/editfns.c (styled_format):
* src/frame.c (xrdb_get_resource, x_get_resource_string):
* src/fringe.c (Fdefine_fringe_bitmap):
* src/gmalloc.c (malloc, realloc, aligned_alloc):
Narrow pointer bounds when appropriate.
* src/alloc.c (SDATA_OF_STRING):
* src/lisp.h (make_lisp_symbol) [__CHKP__]:
Widen bounds here, though.
* src/bytecode.c, src/callint.c, src/dispnew.c, src/editfns.c:
* src/emacs.c, src/frame.c, src/fringe.c:
Include ptr-bounds.h.
* src/ptr-bounds.h (ptr_bounds_clip): New function.
---
 src/alloc.c      | 31 +++++++++++++++++--------------
 src/bytecode.c   | 15 +++++++++------
 src/callint.c    |  4 ++++
 src/dispnew.c    |  6 ++++++
 src/editfns.c    |  9 ++++++---
 src/emacs.c      |  1 +
 src/frame.c      |  5 +++++
 src/fringe.c     |  5 ++++-
 src/gmalloc.c    | 10 +++++++---
 src/lisp.h       |  9 +++++++--
 src/ptr-bounds.h | 27 +++++++++++++++++++++++++++
 11 files changed, 93 insertions(+), 29 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index 96b9aaa0d2..9197ff12ef 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1727,7 +1727,8 @@ static EMACS_INT total_string_bytes;
    a pointer to the `u.data' member of its sdata structure; the
    structure starts at a constant offset in front of that.  */
 
-#define SDATA_OF_STRING(S) ((sdata *) ((S)->u.s.data - SDATA_DATA_OFFSET))
+#define SDATA_OF_STRING(S) ptr_bounds_init ((sdata *) ((S)->u.s.data \
+						       - SDATA_DATA_OFFSET))

 #ifdef GC_CHECK_STRING_OVERRUN
@@ -1919,7 +1920,7 @@ allocate_string (void)
 	  /* Every string on a free list should have NULL data pointer.  */
 	  s->u.s.data = NULL;
 	  NEXT_FREE_LISP_STRING (s) = string_free_list;
-	  string_free_list = s;
+	  string_free_list = ptr_bounds_clip (s, sizeof *s);
 	}
 
       total_free_strings += STRING_BLOCK_SIZE;
@@ -2034,7 +2035,7 @@ allocate_string_data (struct Lisp_String *s,
 
   MALLOC_UNBLOCK_INPUT;
 
-  s->u.s.data = SDATA_DATA (data);
+  s->u.s.data = ptr_bounds_clip (SDATA_DATA (data), nbytes + 1);
 #ifdef GC_CHECK_STRING_BYTES
   SDATA_NBYTES (data) = nbytes;
 #endif
@@ -2120,7 +2121,7 @@ sweep_strings (void)
 
 		  /* Put the string on the free-list.  */
 		  NEXT_FREE_LISP_STRING (s) = string_free_list;
-		  string_free_list = s;
+		  string_free_list = ptr_bounds_clip (s, sizeof *s);
 		  ++nfree;
 		}
 	    }
@@ -2128,7 +2129,7 @@ sweep_strings (void)
 	    {
 	      /* S was on the free-list before.  Put it there again.  */
 	      NEXT_FREE_LISP_STRING (s) = string_free_list;
-	      string_free_list = s;
+	      string_free_list = ptr_bounds_clip (s, sizeof *s);
 	      ++nfree;
 	    }
 	}
@@ -2224,9 +2225,9 @@ compact_small_strings (void)
 	      nbytes = s ? STRING_BYTES (s) : SDATA_NBYTES (from);
 	      eassert (nbytes <= LARGE_STRING_BYTES);
 
-	      nbytes = SDATA_SIZE (nbytes);
+	      ptrdiff_t size = SDATA_SIZE (nbytes);
 	      sdata *from_end = (sdata *) ((char *) from
-					   + nbytes + GC_STRING_EXTRA);
+					   + size + GC_STRING_EXTRA);
 
 #ifdef GC_CHECK_STRING_OVERRUN
 	      if (memcmp (string_overrun_cookie,
@@ -2240,22 +2241,23 @@ compact_small_strings (void)
 		{
 		  /* If TB is full, proceed with the next sblock.  */
 		  sdata *to_end = (sdata *) ((char *) to
-					     + nbytes + GC_STRING_EXTRA);
+					     + size + GC_STRING_EXTRA);
 		  if (to_end > tb_end)
 		    {
 		      tb->next_free = to;
 		      tb = tb->next;
 		      tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
 		      to = tb->data;
-		      to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
+		      to_end = (sdata *) ((char *) to + size + GC_STRING_EXTRA);
 		    }
 
 		  /* Copy, and update the string's `data' pointer.  */
 		  if (from != to)
 		    {
 		      eassert (tb != b || to < from);
-		      memmove (to, from, nbytes + GC_STRING_EXTRA);
-		      to->string->u.s.data = SDATA_DATA (to);
+		      memmove (to, from, size + GC_STRING_EXTRA);
+		      to->string->u.s.data
+			= ptr_bounds_clip (SDATA_DATA (to), nbytes + 1);
 		    }
 
 		  /* Advance past the sdata we copied to.  */
@@ -3038,6 +3040,7 @@ static EMACS_INT total_vector_slots, total_free_vector_slots;
 static void
 setup_on_free_list (struct Lisp_Vector *v, ptrdiff_t nbytes)
 {
+  v = ptr_bounds_clip (v, nbytes);
   eassume (header_size <= nbytes);
   ptrdiff_t nwords = (nbytes - header_size) / word_size;
   XSETPVECTYPESIZE (v, PVEC_FREE, 0, nwords);
@@ -3347,7 +3350,7 @@ allocate_vectorlike (ptrdiff_t len)
 
       MALLOC_UNBLOCK_INPUT;
 
-      return p;
+      return ptr_bounds_clip (p, nbytes);
     }
 }
 
@@ -5358,7 +5361,7 @@ pure_alloc (size_t size, int type)
   pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp;
 
   if (pure_bytes_used <= pure_size)
-    return result;
+    return ptr_bounds_clip (result, size);
 
   /* Don't allocate a large amount here,
      because it might get mmap'd and then its address
@@ -5443,7 +5446,7 @@ find_string_data_in_pure (const char *data, ptrdiff_t nbytes)
       /* Check the remaining characters.  */
       if (memcmp (data, non_lisp_beg + start, nbytes) == 0)
 	/* Found.  */
-	return non_lisp_beg + start;
+	return ptr_bounds_clip (non_lisp_beg + start, nbytes + 1);
 
       start += last_char_skip;
     }
diff --git a/src/bytecode.c b/src/bytecode.c
index 8746568f16..78207f776c 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -24,6 +24,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #include "character.h"
 #include "buffer.h"
 #include "keyboard.h"
+#include "ptr-bounds.h"
 #include "syntax.h"
 #include "window.h"
 
@@ -363,13 +364,15 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
   unsigned char quitcounter = 1;
   EMACS_INT stack_items = XFASTINT (maxdepth) + 1;
   USE_SAFE_ALLOCA;
-  Lisp_Object *stack_base;
-  SAFE_ALLOCA_LISP_EXTRA (stack_base, stack_items, bytestr_length);
-  Lisp_Object *stack_lim = stack_base + stack_items;
+  void *alloc;
+  SAFE_ALLOCA_LISP_EXTRA (alloc, stack_items, bytestr_length);
+  ptrdiff_t item_bytes = stack_items * word_size;
+  Lisp_Object *stack_base = ptr_bounds_clip (alloc, item_bytes);
   Lisp_Object *top = stack_base;
-  memcpy (stack_lim, SDATA (bytestr), bytestr_length);
-  void *void_stack_lim = stack_lim;
-  unsigned char const *bytestr_data = void_stack_lim;
+  Lisp_Object *stack_lim = stack_base + stack_items;
+  unsigned char *bytestr_data = alloc;
+  bytestr_data = ptr_bounds_clip (bytestr_data + item_bytes, bytestr_length);
+  memcpy (bytestr_data, SDATA (bytestr), bytestr_length);
   unsigned char const *pc = bytestr_data;
   ptrdiff_t count = SPECPDL_INDEX ();
 
diff --git a/src/callint.c b/src/callint.c
index 5d88082e38..df26e4abb5 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -21,6 +21,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #include <config.h>
 
 #include "lisp.h"
+#include "ptr-bounds.h"
 #include "character.h"
 #include "buffer.h"
 #include "keyboard.h"
@@ -494,6 +495,9 @@ invoke it.  If KEYS is omitted or nil, the return value of
   varies = (signed char *) (visargs + nargs);
 
   memclear (args, nargs * (2 * word_size + 1));
+  args = ptr_bounds_clip (args, nargs * sizeof *args);
+  visargs = ptr_bounds_clip (visargs, nargs * sizeof *visargs);
+  varies = ptr_bounds_clip (varies, nargs * sizeof *varies);
 
   if (!NILP (enable))
     specbind (Qenable_recursive_minibuffers, Qt);
diff --git a/src/dispnew.c b/src/dispnew.c
index b0fc5c31fa..7fea867f66 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -25,6 +25,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #include <unistd.h>
 
 #include "lisp.h"
+#include "ptr-bounds.h"
 #include "termchar.h"
 /* cm.h must come after dispextern.h on Windows.  */
 #include "dispextern.h"
@@ -4652,6 +4653,11 @@ scrolling (struct frame *frame)
   unsigned *new_hash = old_hash + height;
   int *draw_cost = (int *) (new_hash + height);
   int *old_draw_cost = draw_cost + height;
+  old_hash = ptr_bounds_clip (old_hash, height * sizeof *old_hash);
+  new_hash = ptr_bounds_clip (new_hash, height * sizeof *new_hash);
+  draw_cost = ptr_bounds_clip (draw_cost, height * sizeof *draw_cost);
+  old_draw_cost = ptr_bounds_clip (old_draw_cost,
+				   height * sizeof *old_draw_cost);
 
   eassert (current_matrix);
 
diff --git a/src/editfns.c b/src/editfns.c
index e671ba0761..a333dc0801 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -56,6 +56,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 
 #include "composite.h"
 #include "intervals.h"
+#include "ptr-bounds.h"
 #include "character.h"
 #include "buffer.h"
 #include "coding.h"
@@ -4208,9 +4209,9 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
   ptrdiff_t nspec_bound = SCHARS (args[0]) >> 1;
 
   /* Allocate the info and discarded tables.  */
-  ptrdiff_t alloca_size;
-  if (INT_MULTIPLY_WRAPV (nspec_bound, sizeof *info, &alloca_size)
-      || INT_ADD_WRAPV (formatlen, alloca_size, &alloca_size)
+  ptrdiff_t info_size, alloca_size;
+  if (INT_MULTIPLY_WRAPV (nspec_bound, sizeof *info, &info_size)
+      || INT_ADD_WRAPV (formatlen, info_size, &alloca_size)
       || SIZE_MAX < alloca_size)
     memory_full (SIZE_MAX);
   info = SAFE_ALLOCA (alloca_size);
@@ -4218,6 +4219,8 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
      string was not copied into the output.
      It is 2 if byte I was not the first byte of its character.  */
   char *discarded = (char *) &info[nspec_bound];
+  info = ptr_bounds_clip (info, info_size);
+  discarded = ptr_bounds_clip (discarded, formatlen);
   memset (discarded, 0, formatlen);
 
   /* Try to determine whether the result should be multibyte.
diff --git a/src/emacs.c b/src/emacs.c
index 808abcd9aa..06dbe92f99 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -83,6 +83,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #include "charset.h"
 #include "composite.h"
 #include "dispextern.h"
+#include "ptr-bounds.h"
 #include "regex.h"
 #include "sheap.h"
 #include "syntax.h"
diff --git a/src/frame.c b/src/frame.c
index 5bafbeddcc..94ec9fbdc7 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -35,6 +35,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #include "buffer.h"
 /* These help us bind and responding to switch-frame events.  */
 #include "keyboard.h"
+#include "ptr-bounds.h"
 #include "frame.h"
 #include "blockinput.h"
 #include "termchar.h"
@@ -4812,6 +4813,8 @@ xrdb_get_resource (XrmDatabase rdb, Lisp_Object attribute, Lisp_Object class, Li
   USE_SAFE_ALLOCA;
   char *name_key = SAFE_ALLOCA (name_keysize + class_keysize);
   char *class_key = name_key + name_keysize;
+  name_key = ptr_bounds_clip (name_key, name_keysize);
+  class_key = ptr_bounds_clip (class_key, class_keysize);
 
   /* Start with emacs.FRAMENAME for the name (the specific one)
      and with `Emacs' for the class key (the general one).  */
@@ -4890,6 +4893,8 @@ x_get_resource_string (const char *attribute, const char *class)
   ptrdiff_t class_keysize = sizeof (EMACS_CLASS) - 1 + strlen (class) + 2;
   char *name_key = SAFE_ALLOCA (name_keysize + class_keysize);
   char *class_key = name_key + name_keysize;
+  name_key = ptr_bounds_clip (name_key, name_keysize);
+  class_key = ptr_bounds_clip (class_key, class_keysize);
 
   esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute);
   sprintf (class_key, "%s.%s", EMACS_CLASS, class);
diff --git a/src/fringe.c b/src/fringe.c
index 087ef33434..a558117374 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -24,6 +24,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 
 #include "lisp.h"
 #include "frame.h"
+#include "ptr-bounds.h"
 #include "window.h"
 #include "dispextern.h"
 #include "buffer.h"
@@ -1591,7 +1592,9 @@ If BITMAP already exists, the existing definition is replaced.  */)
   fb.dynamic = true;
 
   xfb = xmalloc (sizeof fb + fb.height * BYTES_PER_BITMAP_ROW);
-  fb.bits = b = (unsigned short *) (xfb + 1);
+  fb.bits = b = ((unsigned short *)
+		 ptr_bounds_clip (xfb + 1, fb.height * BYTES_PER_BITMAP_ROW));
+  xfb = ptr_bounds_clip (xfb, sizeof *xfb);
   memset (b, 0, fb.height);
 
   j = 0;
diff --git a/src/gmalloc.c b/src/gmalloc.c
index 97ab76561f..99cb967e53 100644
--- a/src/gmalloc.c
+++ b/src/gmalloc.c
@@ -203,7 +203,8 @@ extern size_t _bytes_free;
 
 /* Internal versions of `malloc', `realloc', and `free'
    used when these functions need to call each other.
-   They are the same but don't call the hooks.  */
+   They are the same but don't call the hooks
+   and don't bound the resulting pointers.  */
 extern void *_malloc_internal (size_t);
 extern void *_realloc_internal (void *, size_t);
 extern void _free_internal (void *);
@@ -921,7 +922,8 @@ malloc (size_t size)
      among multiple threads.  We just leave it for compatibility with
      glibc malloc (i.e., assignments to gmalloc_hook) for now.  */
   hook = gmalloc_hook;
-  return (hook != NULL ? *hook : _malloc_internal) (size);
+  void *result = (hook ? hook : _malloc_internal) (size);
+  return ptr_bounds_clip (result, size);
 }
 
 #if !(defined (_LIBC) || defined (HYBRID_MALLOC))
@@ -1434,7 +1436,8 @@ realloc (void *ptr, size_t size)
     return NULL;
 
   hook = grealloc_hook;
-  return (hook != NULL ? *hook : _realloc_internal) (ptr, size);
+  void *result = (hook ? hook : _realloc_internal) (ptr, size);
+  return ptr_bounds_clip (result, size);
 }
 /* Copyright (C) 1991, 1992, 1994 Free Software Foundation, Inc.
 
@@ -1608,6 +1611,7 @@ aligned_alloc (size_t alignment, size_t size)
 	{
 	  l->exact = result;
 	  result = l->aligned = (char *) result + adj;
+	  result = ptr_bounds_clip (result, size);
 	}
       UNLOCK_ALIGNED_BLOCKS ();
       if (l == NULL)
diff --git a/src/lisp.h b/src/lisp.h
index 38a098da82..32e2208558 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -916,9 +916,14 @@ INLINE Lisp_Object
 make_lisp_symbol (struct Lisp_Symbol *sym)
 {
 #ifdef __CHKP__
-  char *symoffset = (char *) sym - (intptr_t) lispsym;
+  /* Although this should use '__builtin___bnd_narrow_ptr_bounds (sym,
+     sym, sizeof *sym)', that would run afoul of GCC bug 83251
+     <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=83251>.  */
+  char *addr = __builtin___bnd_set_ptr_bounds (sym, sizeof *sym);
+  char *symoffset = addr - (intptr_t) lispsym;
 #else
-  /* If !__CHKP__ this is equivalent, and is a bit faster as of GCC 7.  */
+  /* If !__CHKP__, GCC 7 x86-64 generates faster code if lispsym is
+     cast to char * rather than to intptr_t.  */
   char *symoffset = (char *) ((char *) sym - (char *) lispsym);
 #endif
   Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset);
diff --git a/src/ptr-bounds.h b/src/ptr-bounds.h
index 54979824c0..76740da3d3 100644
--- a/src/ptr-bounds.h
+++ b/src/ptr-bounds.h
@@ -17,6 +17,18 @@ GNU General Public License for more details.
 You should have received a copy of the GNU General Public License
 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 
+/* Pointer bounds checking is a no-op unless running on hardware
+   supporting Intel MPX (Intel Skylake or better).  Also, it requires
+   GCC 5 and Linux kernel 3.19, or later.  Configure with
+   CFLAGS='-fcheck-pointer-bounds -mmpx', perhaps with
+   -fchkp-first-field-has-own-bounds thrown in.
+
+   Although pointer bounds checking can help during debugging, it is
+   disabled by default because it hurts performance significantly.
+   The checking does not detect all pointer errors.  For example, a
+   dumped Emacs might not detect a bounds violation of a pointer that
+   was created before Emacs was dumped.  */
+
 #ifndef PTR_BOUNDS_H
 #define PTR_BOUNDS_H
 
@@ -26,6 +38,19 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
    return their first argument.  These macros return either void *, or
    the same type as their first argument.  */
 
+INLINE_HEADER_BEGIN
+
+/* Return a copy of P, with bounds narrowed to [P, P + N).  */
+#ifdef __CHKP__
+INLINE void *
+ptr_bounds_clip (void const *p, size_t n)
+{
+  return __builtin___bnd_narrow_ptr_bounds (p, p, n);
+}
+#else
+# define ptr_bounds_clip(p, n) ((void) (size_t) {n}, p)
+#endif
+
 /* Return a copy of P, but with the bounds of Q.  */
 #ifdef __CHKP__
 # define ptr_bounds_copy(p, q) __builtin___bnd_copy_ptr_bounds (p, q)
@@ -49,4 +74,6 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 # define ptr_bounds_set(p, n) ((void) (size_t) {n}, p)
 #endif
 
+INLINE_HEADER_END
+
 #endif /* PTR_BOUNDS_H */
-- 
2.14.1