From 29c780279ce50db5e9fa8c45320ca4d77373bb92 Mon Sep 17 00:00:00 2001 From: Paul Eggert 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 + # . + 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 . + # 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 . */ #include #include +/* 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