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.

5 files changed, 156 insertions, 88 deletions

diff --git a/src/.gdbinit b/src/.gdbinit
index e22d03ea476..0eb2c73591f 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 4f3928a4824..38daee065ae 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 b351515c3bd..9a02e7d4821 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 91ed14fa4c9..54103d4bebc 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 a67dc0ecf4d..c7f0594728c 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