diff options
Diffstat (limited to 'src/lisp.h')
| -rw-r--r-- | src/lisp.h | 1274 |
1 files changed, 664 insertions, 610 deletions
diff --git a/src/lisp.h b/src/lisp.h index 08c6dbdf72b..b650702bddc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -228,28 +228,22 @@ extern bool suppress_checking EXTERNALLY_VISIBLE; USE_LSB_TAG not only requires the least 3 bits of pointers returned by malloc to be 0 but also needs to be able to impose a mult-of-8 alignment - on the few static Lisp_Objects used, all of which are aligned via - 'char alignas (GCALIGNMENT) gcaligned;' inside a union. */ + on some non-GC Lisp_Objects, all of which are aligned via + GCALIGNED_UNION_MEMBER. */ enum Lisp_Bits { - /* 2**GCTYPEBITS. This must be a macro that expands to a literal - integer constant, for older versions of GCC (through at least 4.9). */ -#define GCALIGNMENT 8 - /* Number of bits in a Lisp_Object value, not counting the tag. */ VALBITS = EMACS_INT_WIDTH - GCTYPEBITS, - /* Number of bits in a Lisp fixnum tag. */ - INTTYPEBITS = GCTYPEBITS - 1, - /* Number of bits in a Lisp fixnum value, not counting the tag. */ FIXNUM_BITS = VALBITS + 1 }; -#if GCALIGNMENT != 1 << GCTYPEBITS -# error "GCALIGNMENT and GCTYPEBITS are inconsistent" -#endif +/* Number of bits in a Lisp fixnum tag; can be used in #if. */ +DEFINE_GDB_SYMBOL_BEGIN (int, INTTYPEBITS) +#define INTTYPEBITS (GCTYPEBITS - 1) +DEFINE_GDB_SYMBOL_END (INTTYPEBITS) /* The maximum value that can be stored in a EMACS_INT, assuming all bits other than the type bits contribute to a nonnegative signed value. @@ -277,6 +271,58 @@ DEFINE_GDB_SYMBOL_END (VALMASK) error !; #endif +/* Minimum alignment requirement for Lisp objects, imposed by the + internal representation of tagged pointers. It is 2**GCTYPEBITS if + USE_LSB_TAG, 1 otherwise. It must be a literal integer constant, + for older versions of GCC (through at least 4.9). */ +#if USE_LSB_TAG +# define GCALIGNMENT 8 +# if GCALIGNMENT != 1 << GCTYPEBITS +# error "GCALIGNMENT and GCTYPEBITS are inconsistent" +# endif +#else +# define GCALIGNMENT 1 +#endif + +/* To cause a union to have alignment of at least GCALIGNMENT, put + GCALIGNED_UNION_MEMBER in its member list. + + If a struct is always GC-aligned (either by the GC, or via + allocation in a containing union that has GCALIGNED_UNION_MEMBER) + and does not contain a GC-aligned struct or union, putting + GCALIGNED_STRUCT after its closing '}' can help the compiler + generate better code. + + Although these macros are reasonably portable, they are not + guaranteed on non-GCC platforms, as C11 does not require support + for alignment to GCALIGNMENT and older compilers may ignore + alignment requests. For any type T where garbage collection + requires alignment, use verify (GCALIGNED (T)) to verify the + requirement on the current platform. Types need this check if + their objects can be allocated outside the garbage collector. For + example, struct Lisp_Symbol needs the check because of lispsym and + struct Lisp_Cons needs it because of STACK_CONS. */ + +#define GCALIGNED_UNION_MEMBER char alignas (GCALIGNMENT) gcaligned; +#if HAVE_STRUCT_ATTRIBUTE_ALIGNED +# define GCALIGNED_STRUCT __attribute__ ((aligned (GCALIGNMENT))) +#else +# define GCALIGNED_STRUCT +#endif +#define GCALIGNED(type) (alignof (type) % GCALIGNMENT == 0) + +/* 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,26 +348,48 @@ 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_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x) #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) #define lisp_h_CHECK_TYPE(ok, predicate, x) \ ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) -#define lisp_h_CONSP(x) (XTYPE (x) == Lisp_Cons) +#define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) #define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) -#define lisp_h_FLOATP(x) (XTYPE (x) == Lisp_Float) -#define lisp_h_INTEGERP(x) ((XTYPE (x) & (Lisp_Int0 | ~Lisp_Int1)) == Lisp_Int0) -#define lisp_h_MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) -#define lisp_h_MISCP(x) (XTYPE (x) == Lisp_Misc) +#define lisp_h_FIXNUMP(x) \ + (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ + - (unsigned) (Lisp_Int0 >> !USE_LSB_TAG)) \ + & ((1 << INTTYPEBITS) - 1))) +#define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float) #define lisp_h_NILP(x) EQ (x, Qnil) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \ @@ -331,29 +399,39 @@ error !; #define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write) #define lisp_h_SYMBOL_VAL(sym) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value) -#define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) -#define lisp_h_VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike) +#define lisp_h_SYMBOLP(x) TAGGEDP (x, Lisp_Symbol) +#define lisp_h_TAGGEDP(a, tag) \ + (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \ + - (unsigned) (tag)) \ + & ((1 << GCTYPEBITS) - 1))) +#define lisp_h_VECTORLIKEP(x) TAGGEDP (x, Lisp_Vectorlike) #define lisp_h_XCAR(c) XCONS (c)->u.s.car #define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr #define lisp_h_XCONS(a) \ - (eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) -#define lisp_h_XHASH(a) XUINT (a) + (eassert (CONSP (a)), XUNTAG (a, Lisp_Cons, struct Lisp_Cons)) +#define lisp_h_XHASH(a) XUFIXNUM (a) #ifndef GC_CHECK_CONS_LIST # define lisp_h_check_cons_list() ((void) 0) #endif #if USE_LSB_TAG -# define lisp_h_make_number(n) \ +# define lisp_h_make_fixnum(n) \ 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) \ +# define lisp_h_XFIXNAT(a) XFIXNUM (a) +# define lisp_h_XFIXNUM(a) (XLI (a) >> INTTYPEBITS) +# ifdef __CHKP__ +# define lisp_h_XSYMBOL(a) \ + (eassert (SYMBOLP (a)), \ + (struct Lisp_Symbol *) ((char *) XUNTAG (a, Lisp_Symbol, \ + struct 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 ((void *) (intptr_t) (XLI (a) - (type)), \ - GCALIGNMENT) #endif /* When compiling via gcc -O0, define the key operations as macros, as @@ -370,21 +448,22 @@ error !; #if DEFINE_KEY_OPS_AS_MACROS # define XLI(o) lisp_h_XLI (o) # define XIL(i) lisp_h_XIL (i) -# define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x) +# define XLP(o) lisp_h_XLP (o) +# define XPL(p) lisp_h_XPL (p) +# define CHECK_FIXNUM(x) lisp_h_CHECK_FIXNUM (x) # define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x) # define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) # define CONSP(x) lisp_h_CONSP (x) # define EQ(x, y) lisp_h_EQ (x, y) # define FLOATP(x) lisp_h_FLOATP (x) -# define INTEGERP(x) lisp_h_INTEGERP (x) -# define MARKERP(x) lisp_h_MARKERP (x) -# define MISCP(x) lisp_h_MISCP (x) +# define FIXNUMP(x) lisp_h_FIXNUMP (x) # define NILP(x) lisp_h_NILP (x) # define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v) # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym) # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) # define SYMBOLP(x) lisp_h_SYMBOLP (x) +# define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag) # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) # define XCAR(c) lisp_h_XCAR (c) # define XCDR(c) lisp_h_XCDR (c) @@ -394,12 +473,11 @@ error !; # define check_cons_list() lisp_h_check_cons_list () # endif # if USE_LSB_TAG -# define make_number(n) lisp_h_make_number (n) -# define XFASTINT(a) lisp_h_XFASTINT (a) -# define XINT(a) lisp_h_XINT (a) +# define make_fixnum(n) lisp_h_make_fixnum (n) +# define XFIXNAT(a) lisp_h_XFIXNAT (a) +# define XFIXNUM(a) lisp_h_XFIXNUM (a) # define XSYMBOL(a) lisp_h_XSYMBOL (a) # define XTYPE(a) lisp_h_XTYPE (a) -# define XUNTAG(a, type) lisp_h_XUNTAG (a, type) # endif #endif @@ -416,9 +494,8 @@ error !; #define case_Lisp_Int case Lisp_Int0: case Lisp_Int1 /* Idea stolen from GDB. Pedantic GCC complains about enum bitfields, - MSVC doesn't support them, and xlc and Oracle Studio c99 complain - vociferously about them. */ -#if (defined __STRICT_ANSI__ || defined _MSC_VER || defined __IBMC__ \ + and xlc and Oracle Studio c99 complain vociferously about them. */ +#if (defined __STRICT_ANSI__ || defined __IBMC__ \ || (defined __SUNPRO_C && __STDC__)) #define ENUM_BF(TYPE) unsigned int #else @@ -431,11 +508,9 @@ enum Lisp_Type /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ Lisp_Symbol = 0, - /* Miscellaneous. XMISC (object) points to a union Lisp_Misc, - whose first member indicates the subtype. */ - Lisp_Misc = 1, + /* Type 1 is currently unused. */ - /* Integer. XINT (obj) is the integer value. */ + /* Fixnum. XFIXNUM (obj) is the integer value. */ Lisp_Int0 = 2, Lisp_Int1 = USE_LSB_TAG ? 6 : 3, @@ -455,25 +530,6 @@ enum Lisp_Type Lisp_Float = 7 }; -/* This is the set of data types that share a common structure. - The first member of the structure is a type code from this set. - The enum values are arbitrary, but we'll use large numbers to make it - more likely that we'll spot the error if a random word in memory is - mistakenly interpreted as a Lisp_Misc. */ -enum Lisp_Misc_Type - { - Lisp_Misc_Free = 0x5eab, - Lisp_Misc_Marker, - Lisp_Misc_Overlay, - Lisp_Misc_Save_Value, - Lisp_Misc_Finalizer, -#ifdef HAVE_MODULES - Lisp_Misc_User_Ptr, -#endif - /* This is not a type code. It is for range checking. */ - Lisp_Misc_Limit - }; - /* These are the types of forwarding objects used in the value slot of symbols for special built-in variables whose value is stored in C variables. */ @@ -487,16 +543,15 @@ enum Lisp_Fwd_Type }; /* If you want to define a new Lisp data type, here are some - instructions. See the thread at - https://lists.gnu.org/r/emacs-devel/2012-10/msg00561.html - for more info. + instructions. First, there are already a couple of Lisp types that can be used if your new type does not need to be exposed to Lisp programs nor - displayed to users. These are Lisp_Save_Value, a Lisp_Misc - subtype; and PVEC_OTHER, a kind of vectorlike object. The former - is suitable for temporarily stashing away pointers and integers in - a Lisp object. The latter is useful for vector-like Lisp objects + displayed to users. These are Lisp_Misc_Ptr and PVEC_OTHER, + which are both vectorlike objects. The former + is suitable for stashing a pointer in a Lisp object; the pointer + might be to some low-level C object that contains auxiliary + information. The latter is useful for vector-like Lisp objects that need to be used as part of other objects, but which are never shown to users or Lisp code (search for PVEC_OTHER in xterm.c for an example). @@ -504,30 +559,13 @@ enum Lisp_Fwd_Type These two types don't look pretty when printed, so they are unsuitable for Lisp objects that can be exposed to users. - To define a new data type, add one more Lisp_Misc subtype or one - more pseudovector subtype. Pseudovectors are more suitable for - objects with several slots that need to support fast random access, - while Lisp_Misc types are for everything else. A pseudovector object - provides one or more slots for Lisp objects, followed by struct - members that are accessible only from C. A Lisp_Misc object is a - wrapper for a C struct that can contain anything you like. - - Explicit freeing is discouraged for Lisp objects in general. But if - you really need to exploit this, use Lisp_Misc (check free_misc in - alloc.c to see why). There is no way to free a vectorlike object. - - To add a new pseudovector type, extend the pvec_type enumeration; - to add a new Lisp_Misc, extend the Lisp_Misc_Type enumeration. - - For a Lisp_Misc, you will also need to add your entry to union - Lisp_Misc, but make sure the first word has the same structure as - the others, starting with a 16-bit member of the Lisp_Misc_Type - enumeration and a 1-bit GC markbit. Also make sure the overall - size of the union is not increased by your addition. The latter - requirement is to keep Lisp_Misc objects small enough, so they - are handled faster: since all Lisp_Misc types use the same space, - enlarging any of them will affect all the rest. If you really - need a larger object, it is best to use Lisp_Vectorlike instead. + To define a new data type, add a pseudovector subtype by extending + the pvec_type enumeration. A pseudovector provides one or more + slots for Lisp objects, followed by struct members that are + accessible only from C. + + There is no way to explicitly free a Lisp Object; only the garbage + collector frees them. For a new pseudovector, it's highly desirable to limit the size of your data type by VBLOCK_BYTES_MAX bytes (defined in alloc.c). @@ -542,24 +580,29 @@ enum Lisp_Fwd_Type resources allocated for it that are not Lisp objects. You can even make a pointer to the function that frees the resources a slot in your object -- this way, the same object could be used to represent - several disparate C structures. */ + several disparate C structures. -#ifdef CHECK_LISP_OBJECT_TYPE + You also need to add the new type to the constant + `cl--typeof-types' in lisp/emacs-lisp/cl-preloaded.el. */ -typedef struct Lisp_Object { EMACS_INT i; } Lisp_Object; -#define LISP_INITIALLY(i) {i} +/* 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;'. -#undef CHECK_LISP_OBJECT_TYPE -enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true }; -#else /* CHECK_LISP_OBJECT_TYPE */ + 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. */ -/* If a struct type is not wanted, define Lisp_Object as just a number. */ - -typedef EMACS_INT Lisp_Object; -#define LISP_INITIALLY(i) (i) +#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 +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. */ @@ -567,6 +610,11 @@ enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false }; INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, Lisp_Object); +/* Defined in bignum.c. */ +extern double bignum_to_double (Lisp_Object); +extern Lisp_Object make_bigint (intmax_t); +extern Lisp_Object make_biguint (uintmax_t); + /* Defined in chartab.c. */ extern Lisp_Object char_table_ref (Lisp_Object, int); extern void char_table_set (Lisp_Object, int, Lisp_Object); @@ -591,8 +639,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) @@ -606,6 +656,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 @@ -619,25 +681,26 @@ INLINE enum Lisp_Type #endif } +/* True if A has type tag TAG. + Equivalent to XTYPE (a) == TAG, but often faster. */ + +INLINE bool +(TAGGEDP) (Lisp_Object a, enum Lisp_Type tag) +{ + return lisp_h_TAGGEDP (a, tag); +} + INLINE void (CHECK_TYPE) (int ok, Lisp_Object predicate, Lisp_Object x) { lisp_h_CHECK_TYPE (ok, predicate, x); } -/* Extract A's pointer value, assuming A's type is TYPE. */ - -INLINE void * -(XUNTAG) (Lisp_Object a, int type) -{ -#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; -#endif -} +/* Extract A's pointer value, assuming A's Lisp type is TYPE and the + extracted pointer's type is CTYPE *. */ +#define XUNTAG(a, type, ctype) ((ctype *) \ + ((char *) XLP (a) - LISP_WORD_TAG (type))) /* Interned state of a symbol. */ @@ -715,10 +778,10 @@ struct Lisp_Symbol /* Next symbol in obarray bucket, if the symbol is interned. */ struct Lisp_Symbol *next; } s; - char alignas (GCALIGNMENT) gcaligned; + GCALIGNED_UNION_MEMBER } u; }; -verify (alignof (struct Lisp_Symbol) % GCALIGNMENT == 0); +verify (GCALIGNED (struct Lisp_Symbol)); /* Declare a Lisp-callable function. The MAXARGS parameter has the same meaning as in the DEFUN macro, and is used to construct a prototype. */ @@ -745,35 +808,47 @@ 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. - - 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. */ -#define TAG_PTR(tag, ptr) \ - (USE_LSB_TAG \ - ? (intptr_t) (ptr) + (tag) \ - : (EMACS_INT) (((EMACS_UINT) (tag) << VALBITS) + (uintptr_t) (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 -/* 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) +/* A integer value tagged with TAG, and otherwise all zero. */ +#define LISP_WORD_TAG(tag) \ + ((Lisp_Word_tag) (tag) << (USE_LSB_TAG ? 0 : VALBITS)) -/* 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) +/* An initializer for a Lisp_Object that contains TAG along with PTR. */ +#define TAG_PTR(tag, ptr) \ + LISP_INITIALLY ((Lisp_Word) ((untagged_ptr) (ptr) + LISP_WORD_TAG (tag))) /* 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 - 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. */ @@ -795,7 +870,9 @@ verify (alignof (struct Lisp_Symbol) % GCALIGNMENT == 0); and PSEUDOVECTORP cast their pointers to union vectorlike_header *, because when two such pointers potentially alias, a compiler won't incorrectly reorder loads and stores to their size fields. See - Bug#8546. */ + Bug#8546. This union formerly contained more members, and there's + no compelling reason to change it to a struct merely because the + number of members has been reduced to one. */ union vectorlike_header { /* The main member contains various pieces of information: @@ -818,9 +895,7 @@ union vectorlike_header Current layout limits the pseudovectors to 63 PVEC_xxx subtypes, 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */ ptrdiff_t size; - char alignas (GCALIGNMENT) gcaligned; }; -verify (alignof (union vectorlike_header) % GCALIGNMENT == 0); INLINE bool (SYMBOLP) (Lisp_Object x) @@ -828,15 +903,20 @@ INLINE bool return lisp_h_SYMBOLP (x); } -INLINE struct Lisp_Symbol * +INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED (XSYMBOL) (Lisp_Object a) { #if USE_LSB_TAG return lisp_h_XSYMBOL (a); #else eassert (SYMBOLP (a)); - intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol); + intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol); void *p = (char *) lispsym + i; +# ifdef __CHKP__ + /* Bypass pointer checking. Although this could be improved it is + probably not worth the trouble. */ + p = __builtin___bnd_set_ptr_bounds (p, sizeof (struct Lisp_Symbol)); +# endif return p; #endif } @@ -844,7 +924,20 @@ INLINE struct Lisp_Symbol * INLINE Lisp_Object make_lisp_symbol (struct Lisp_Symbol *sym) { - Lisp_Object a = XIL (TAG_SYMOFFSET ((char *) sym - (char *) lispsym)); +#ifdef __CHKP__ + /* Although '__builtin___bnd_narrow_ptr_bounds (sym, sym, sizeof *sym)' + should be more efficient, it runs afoul of GCC bug 83251 + <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=83251>. + Also, attempting to call __builtin___bnd_chk_ptr_bounds (sym, sizeof *sym) + here seems to trigger a GCC bug, as yet undiagnosed. */ + char *addr = __builtin___bnd_set_ptr_bounds (sym, sizeof *sym); + char *symoffset = addr - (intptr_t) lispsym; +#else + /* 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); eassert (XSYMBOL (a) == sym); return a; } @@ -880,6 +973,14 @@ enum pvec_type { PVEC_NORMAL_VECTOR, PVEC_FREE, + PVEC_BIGNUM, + PVEC_MARKER, + PVEC_OVERLAY, + PVEC_FINALIZER, + PVEC_MISC_PTR, +#ifdef HAVE_MODULES + PVEC_USER_PTR, +#endif PVEC_PROCESS, PVEC_FRAME, PVEC_WINDOW, @@ -932,28 +1033,28 @@ enum More_Lisp_Bits that cons. */ /* Largest and smallest representable fixnum values. These are the C - values. They are macros for use in static initializers. */ + values. They are macros for use in #if and static initializers. */ #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) #if USE_LSB_TAG INLINE Lisp_Object -(make_number) (EMACS_INT n) +(make_fixnum) (EMACS_INT n) { - return lisp_h_make_number (n); + return lisp_h_make_fixnum (n); } INLINE EMACS_INT -(XINT) (Lisp_Object a) +(XFIXNUM) (Lisp_Object a) { - return lisp_h_XINT (a); + return lisp_h_XFIXNUM (a); } INLINE EMACS_INT -(XFASTINT) (Lisp_Object a) +(XFIXNAT) (Lisp_Object a) { - EMACS_INT n = lisp_h_XFASTINT (a); + EMACS_INT n = lisp_h_XFIXNAT (a); eassume (0 <= n); return n; } @@ -967,7 +1068,7 @@ INLINE EMACS_INT /* Make a Lisp integer representing the value of the low order bits of N. */ INLINE Lisp_Object -make_number (EMACS_INT n) +make_fixnum (EMACS_INT n) { EMACS_INT int0 = Lisp_Int0; if (USE_LSB_TAG) @@ -986,7 +1087,7 @@ make_number (EMACS_INT n) /* Extract A's value as a signed integer. */ INLINE EMACS_INT -XINT (Lisp_Object a) +XFIXNUM (Lisp_Object a) { EMACS_INT i = XLI (a); if (! USE_LSB_TAG) @@ -997,14 +1098,14 @@ XINT (Lisp_Object a) return i >> INTTYPEBITS; } -/* Like XINT (A), but may be faster. A must be nonnegative. +/* Like XFIXNUM (A), but may be faster. A must be nonnegative. If ! USE_LSB_TAG, this takes advantage of the fact that Lisp integers have zero-bits in their tags. */ INLINE EMACS_INT -XFASTINT (Lisp_Object a) +XFIXNAT (Lisp_Object a) { EMACS_INT int0 = Lisp_Int0; - EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a) - (int0 << VALBITS); + EMACS_INT n = USE_LSB_TAG ? XFIXNUM (a) : XLI (a) - (int0 << VALBITS); eassume (0 <= n); return n; } @@ -1013,14 +1114,14 @@ XFASTINT (Lisp_Object a) /* Extract A's value as an unsigned integer. */ INLINE EMACS_UINT -XUINT (Lisp_Object a) +XUFIXNUM (Lisp_Object a) { EMACS_UINT i = XLI (a); return USE_LSB_TAG ? i >> INTTYPEBITS : i & INTMASK; } -/* Return A's (Lisp-integer sized) hash. Happens to be like XUINT - right now, but XUINT should only be applied to objects we know are +/* Return A's (Lisp-integer sized) hash. Happens to be like XUFIXNUM + right now, but XUFIXNUM should only be applied to objects we know are integers. */ INLINE EMACS_INT @@ -1029,13 +1130,13 @@ INLINE EMACS_INT return lisp_h_XHASH (a); } -/* Like make_number (N), but may be faster. N must be in nonnegative range. */ +/* Like make_fixnum (N), but may be faster. N must be in nonnegative range. */ INLINE Lisp_Object -make_natnum (EMACS_INT n) +make_fixed_natnum (EMACS_INT n) { eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM); EMACS_INT int0 = Lisp_Int0; - return USE_LSB_TAG ? make_number (n) : XIL (n + (int0 << VALBITS)); + return USE_LSB_TAG ? make_fixnum (n) : XIL (n + (int0 << VALBITS)); } /* Return true if X and Y are the same object. */ @@ -1062,25 +1163,24 @@ 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)); - eassert (XTYPE (a) == type && XUNTAG (a, type) == ptr); + Lisp_Object a = TAG_PTR (type, ptr); + eassert (TAGGEDP (a, type) && XUNTAG (a, type, char) == ptr); return a; } INLINE bool -(INTEGERP) (Lisp_Object x) +(FIXNUMP) (Lisp_Object x) { - return lisp_h_INTEGERP (x); + return lisp_h_FIXNUMP (x); } -#define XSETINT(a, b) ((a) = make_number (b)) -#define XSETFASTINT(a, b) ((a) = make_natnum (b)) +#define XSETINT(a, b) ((a) = make_fixnum (b)) +#define XSETFASTINT(a, b) ((a) = make_fixed_natnum (b)) #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) #define XSETSYMBOL(a, b) ((a) = make_lisp_symbol (b)) #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float)) -#define XSETMISC(a, b) ((a) = make_lisp_ptr (b, Lisp_Misc)) /* Pseudovector types. */ @@ -1095,8 +1195,8 @@ INLINE bool /* The cast to union vectorlike_header * avoids aliasing issues. */ #define XSETPSEUDOVECTOR(a, b, code) \ XSETTYPED_PSEUDOVECTOR (a, b, \ - (((union vectorlike_header *) \ - XUNTAG (a, Lisp_Vectorlike)) \ + (XUNTAG (a, Lisp_Vectorlike, \ + union vectorlike_header) \ ->size), \ code) #define XSETTYPED_PSEUDOVECTOR(a, b, size, code) \ @@ -1125,16 +1225,23 @@ INLINE bool bits set, which makes this conversion inherently unportable. */ INLINE void * -XINTPTR (Lisp_Object a) +XFIXNUMPTR (Lisp_Object a) +{ + return XUNTAG (a, Lisp_Int0, char); +} + +INLINE Lisp_Object +make_pointer_integer_unsafe (void *p) { - return XUNTAG (a, Lisp_Int0); + Lisp_Object a = TAG_PTR (Lisp_Int0, p); + return a; } INLINE Lisp_Object make_pointer_integer (void *p) { - Lisp_Object a = XIL (TAG_PTR (Lisp_Int0, p)); - eassert (INTEGERP (a) && XINTPTR (a) == p); + Lisp_Object a = make_pointer_integer_unsafe (p); + eassert (FIXNUMP (a) && XFIXNUMPTR (a) == p); return a; } @@ -1160,10 +1267,10 @@ struct Lisp_Cons struct Lisp_Cons *chain; } u; } s; - char alignas (GCALIGNMENT) gcaligned; + GCALIGNED_UNION_MEMBER } u; }; -verify (alignof (struct Lisp_Cons) % GCALIGNMENT == 0); +verify (GCALIGNED (struct Lisp_Cons)); INLINE bool (NILP) (Lisp_Object x) @@ -1282,15 +1389,15 @@ struct Lisp_String unsigned char *data; } s; struct Lisp_String *next; - char alignas (GCALIGNMENT) gcaligned; + GCALIGNED_UNION_MEMBER } u; }; -verify (alignof (struct Lisp_String) % GCALIGNMENT == 0); +verify (GCALIGNED (struct Lisp_String)); INLINE bool STRINGP (Lisp_Object x) { - return XTYPE (x) == Lisp_String; + return TAGGEDP (x, Lisp_String); } INLINE void @@ -1303,7 +1410,7 @@ INLINE struct Lisp_String * XSTRING (Lisp_Object a) { eassert (STRINGP (a)); - return XUNTAG (a, Lisp_String); + return XUNTAG (a, Lisp_String, struct Lisp_String); } /* True if STR is a multibyte string. */ @@ -1416,7 +1523,7 @@ struct Lisp_Vector { union vectorlike_header header; Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER]; - }; + } GCALIGNED_STRUCT; INLINE bool (VECTORLIKEP) (Lisp_Object x) @@ -1428,7 +1535,7 @@ INLINE struct Lisp_Vector * XVECTOR (Lisp_Object a) { eassert (VECTORLIKEP (a)); - return XUNTAG (a, Lisp_Vectorlike); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Vector); } INLINE ptrdiff_t @@ -1488,8 +1595,9 @@ PSEUDOVECTORP (Lisp_Object a, int code) else { /* Converting to union vectorlike_header * avoids aliasing issues. */ - union vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike); - return PSEUDOVECTOR_TYPEP (h, code); + return PSEUDOVECTOR_TYPEP (XUNTAG (a, Lisp_Vectorlike, + union vectorlike_header), + code); } } @@ -1507,10 +1615,19 @@ struct Lisp_Bool_Vector The bits are in little-endian order in the bytes, and the bytes are in little-endian order in the words. */ bits_word data[FLEXIBLE_ARRAY_MEMBER]; - }; + } GCALIGNED_STRUCT; /* Some handy constants for calculating sizes - and offsets, mostly of vectorlike objects. */ + and offsets, mostly of vectorlike objects. + + The garbage collector assumes that the initial part of any struct + that starts with a union vectorlike_header followed by N + Lisp_Objects (some possibly in arrays and/or a trailing flexible + array) will be laid out like a struct Lisp_Vector with N + Lisp_Objects. This assumption is true in practice on known Emacs + targets even though the C standard does not guarantee it. This + header contains a few sanity checks that should suffice to detect + violations of this assumption on plausible practical hosts. */ enum { @@ -1551,7 +1668,7 @@ INLINE struct Lisp_Bool_Vector * XBOOL_VECTOR (Lisp_Object a) { eassert (BOOL_VECTOR_P (a)); - return XUNTAG (a, Lisp_Vectorlike); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Bool_Vector); } INLINE EMACS_INT @@ -1645,8 +1762,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. */ @@ -1670,7 +1789,8 @@ memclear (void *p, ptrdiff_t nbytes) ones that the GC needs to trace). */ #define PSEUDOVECSIZE(type, nonlispfield) \ - ((offsetof (type, nonlispfield) - header_size) / word_size) + (offsetof (type, nonlispfield) < header_size \ + ? 0 : (offsetof (type, nonlispfield) - header_size) / word_size) /* Compute A OP B, using the unsigned comparison operator OP. A and B should be integer expressions. This is not the same as @@ -1735,7 +1855,7 @@ struct Lisp_Char_Table /* These hold additional data. It is a vector. */ Lisp_Object extras[FLEXIBLE_ARRAY_MEMBER]; - }; + } GCALIGNED_STRUCT; INLINE bool CHAR_TABLE_P (Lisp_Object a) @@ -1747,7 +1867,7 @@ INLINE struct Lisp_Char_Table * XCHAR_TABLE (Lisp_Object a) { eassert (CHAR_TABLE_P (a)); - return XUNTAG (a, Lisp_Vectorlike); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Char_Table); } struct Lisp_Sub_Char_Table @@ -1769,7 +1889,7 @@ struct Lisp_Sub_Char_Table /* Use set_sub_char_table_contents to set this. */ Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER]; - }; + } GCALIGNED_STRUCT; INLINE bool SUB_CHAR_TABLE_P (Lisp_Object a) @@ -1781,7 +1901,7 @@ INLINE struct Lisp_Sub_Char_Table * XSUB_CHAR_TABLE (Lisp_Object a) { eassert (SUB_CHAR_TABLE_P (a)); - return XUNTAG (a, Lisp_Vectorlike); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Sub_Char_Table); } INLINE Lisp_Object @@ -1847,7 +1967,13 @@ struct Lisp_Subr const char *symbol_name; const char *intspec; EMACS_INT doc; + } GCALIGNED_STRUCT; +union Aligned_Lisp_Subr + { + struct Lisp_Subr s; + GCALIGNED_UNION_MEMBER }; +verify (GCALIGNED (union Aligned_Lisp_Subr)); INLINE bool SUBRP (Lisp_Object a) @@ -1859,7 +1985,7 @@ INLINE struct Lisp_Subr * XSUBR (Lisp_Object a) { eassert (SUBRP (a)); - return XUNTAG (a, Lisp_Vectorlike); + return &XUNTAG (a, Lisp_Vectorlike, union Aligned_Lisp_Subr)->s; } enum char_table_specials @@ -1874,6 +2000,13 @@ enum char_table_specials SUB_CHAR_TABLE_OFFSET = PSEUDOVECSIZE (struct Lisp_Sub_Char_Table, contents) }; +/* Sanity-check pseudovector layout. */ +verify (offsetof (struct Lisp_Char_Table, defalt) == header_size); +verify (offsetof (struct Lisp_Char_Table, extras) + == header_size + CHAR_TABLE_STANDARD_SLOTS * sizeof (Lisp_Object)); +verify (offsetof (struct Lisp_Sub_Char_Table, contents) + == header_size + SUB_CHAR_TABLE_OFFSET * sizeof (Lisp_Object)); + /* Return the number of "extra" slots in the char table CT. */ INLINE int @@ -1883,11 +2016,6 @@ CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct) - CHAR_TABLE_STANDARD_SLOTS); } -/* Make sure that sub char-table contents slot is where we think it is. */ -verify (offsetof (struct Lisp_Sub_Char_Table, contents) - == (offsetof (struct Lisp_Vector, contents) - + SUB_CHAR_TABLE_OFFSET * sizeof (Lisp_Object))); - /* Save and restore the instruction and environment pointers, without affecting the signal mask. */ @@ -2099,8 +2227,10 @@ struct Lisp_Hash_Table /* Next weak hash table if this is a weak hash table. The head of the list is in weak_hash_tables. */ struct Lisp_Hash_Table *next_weak; -}; +} GCALIGNED_STRUCT; +/* Sanity-check pseudovector layout. */ +verify (offsetof (struct Lisp_Hash_Table, weak) == header_size); INLINE bool HASH_TABLE_P (Lisp_Object a) @@ -2112,7 +2242,7 @@ INLINE struct Lisp_Hash_Table * XHASH_TABLE (Lisp_Object a) { eassert (HASH_TABLE_P (a)); - return XUNTAG (a, Lisp_Vectorlike); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Hash_Table); } #define XSET_HASH_TABLE(VAR, PTR) \ @@ -2177,46 +2307,10 @@ SXHASH_REDUCE (EMACS_UINT x) return (x ^ x >> (EMACS_INT_WIDTH - FIXNUM_BITS)) & INTMASK; } -/* These structures are used for various misc types. */ - -struct Lisp_Misc_Any /* Supertype of all Misc types. */ -{ - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_??? */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; -}; - -INLINE bool -(MISCP) (Lisp_Object x) -{ - return lisp_h_MISCP (x); -} - -INLINE struct Lisp_Misc_Any * -XMISCANY (Lisp_Object a) -{ - eassert (MISCP (a)); - return XUNTAG (a, Lisp_Misc); -} - -INLINE enum Lisp_Misc_Type -XMISCTYPE (Lisp_Object a) -{ - return XMISCANY (a)->type; -} - struct Lisp_Marker { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Marker */ - bool_bf gcmarkbit : 1; - unsigned spacer : 13; - /* This flag is temporarily used in the functions - decode/encode_coding_object to record that the marker position - must be adjusted after the conversion. */ - bool_bf need_adjustment : 1; - /* True means normal insertion at the marker's position - leaves the marker after the inserted text. */ - bool_bf insertion_type : 1; + union vectorlike_header header; + /* This is the buffer that the marker points into, or 0 if it points nowhere. Note: a chain of markers can contain markers pointing into different buffers (the chain is per buffer_text rather than per buffer, so it's @@ -2229,11 +2323,21 @@ struct Lisp_Marker */ struct buffer *buffer; + /* This flag is temporarily used in the functions + decode/encode_coding_object to record that the marker position + must be adjusted after the conversion. */ + bool_bf need_adjustment : 1; + /* True means normal insertion at the marker's position + leaves the marker after the inserted text. */ + bool_bf insertion_type : 1; + /* The remaining fields are meaningless in a marker that does not point anywhere. */ /* For markers that point somewhere, - this is used to chain of all the markers in a given buffer. */ + this is used to chain of all the markers in a given buffer. + The chain does not preserve markers from garbage collection; + instead, markers are removed from the chain when freed by GC. */ /* We could remove it and use an array in buffer_text instead. That would also allow us to preserve it ordered. */ struct Lisp_Marker *next; @@ -2244,7 +2348,7 @@ struct Lisp_Marker used to implement the functionality of markers, but rather to (ab)use markers as a cache for char<->byte mappings). */ ptrdiff_t bytepos; -}; +} GCALIGNED_STRUCT; /* START and END are markers in the overlay's buffer, and PLIST is the overlay's property list. */ @@ -2261,285 +2365,164 @@ struct Lisp_Overlay I.e. 9words plus 2 bits, 3words of which are for external linked lists. */ { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Overlay */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; - struct Lisp_Overlay *next; + union vectorlike_header header; Lisp_Object start; Lisp_Object end; Lisp_Object plist; - }; - -/* Number of bits needed to store one of the values - SAVE_UNUSED..SAVE_OBJECT. */ -enum { SAVE_SLOT_BITS = 3 }; - -/* Number of slots in a save value where save_type is nonzero. */ -enum { SAVE_VALUE_SLOTS = 4 }; - -/* Bit-width and values for struct Lisp_Save_Value's save_type member. */ - -enum { SAVE_TYPE_BITS = SAVE_VALUE_SLOTS * SAVE_SLOT_BITS + 1 }; - -/* Types of data which may be saved in a Lisp_Save_Value. */ - -enum Lisp_Save_Type - { - SAVE_UNUSED, - SAVE_INTEGER, - SAVE_FUNCPOINTER, - SAVE_POINTER, - SAVE_OBJECT, - SAVE_TYPE_INT_INT = SAVE_INTEGER + (SAVE_INTEGER << SAVE_SLOT_BITS), - SAVE_TYPE_INT_INT_INT - = (SAVE_INTEGER + (SAVE_TYPE_INT_INT << SAVE_SLOT_BITS)), - SAVE_TYPE_OBJ_OBJ = SAVE_OBJECT + (SAVE_OBJECT << SAVE_SLOT_BITS), - SAVE_TYPE_OBJ_OBJ_OBJ = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ << SAVE_SLOT_BITS), - SAVE_TYPE_OBJ_OBJ_OBJ_OBJ - = SAVE_OBJECT + (SAVE_TYPE_OBJ_OBJ_OBJ << SAVE_SLOT_BITS), - SAVE_TYPE_PTR_INT = SAVE_POINTER + (SAVE_INTEGER << SAVE_SLOT_BITS), - SAVE_TYPE_PTR_OBJ = SAVE_POINTER + (SAVE_OBJECT << SAVE_SLOT_BITS), - SAVE_TYPE_PTR_PTR = SAVE_POINTER + (SAVE_POINTER << SAVE_SLOT_BITS), - SAVE_TYPE_FUNCPTR_PTR_OBJ - = SAVE_FUNCPOINTER + (SAVE_TYPE_PTR_OBJ << SAVE_SLOT_BITS), - - /* This has an extra bit indicating it's raw memory. */ - SAVE_TYPE_MEMORY = SAVE_TYPE_PTR_INT + (1 << (SAVE_TYPE_BITS - 1)) - }; - -/* SAVE_SLOT_BITS must be large enough to represent these values. */ -verify (((SAVE_UNUSED | SAVE_INTEGER | SAVE_FUNCPOINTER - | SAVE_POINTER | SAVE_OBJECT) - >> SAVE_SLOT_BITS) - == 0); - -/* Special object used to hold a different values for later use. - - This is mostly used to package C integers and pointers to call - record_unwind_protect when two or more values need to be saved. - For example: - - ... - struct my_data *md = get_my_data (); - ptrdiff_t mi = get_my_integer (); - record_unwind_protect (my_unwind, make_save_ptr_int (md, mi)); - ... - - Lisp_Object my_unwind (Lisp_Object arg) - { - struct my_data *md = XSAVE_POINTER (arg, 0); - ptrdiff_t mi = XSAVE_INTEGER (arg, 1); - ... - } - - If ENABLE_CHECKING is in effect, XSAVE_xxx macros do type checking of the - saved objects and raise eassert if type of the saved object doesn't match - the type which is extracted. In the example above, XSAVE_INTEGER (arg, 2) - and XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and - slot 0 is a pointer. */ - -typedef void (*voidfuncptr) (void); + struct Lisp_Overlay *next; + } GCALIGNED_STRUCT; -struct Lisp_Save_Value +struct Lisp_Misc_Ptr { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */ - bool_bf gcmarkbit : 1; - unsigned spacer : 32 - (16 + 1 + SAVE_TYPE_BITS); - - /* V->data may hold up to SAVE_VALUE_SLOTS entries. The type of - V's data entries are determined by V->save_type. E.g., if - V->save_type == SAVE_TYPE_PTR_OBJ, V->data[0] is a pointer, - V->data[1] is an integer, and V's other data entries are unused. - - If V->save_type == SAVE_TYPE_MEMORY, V->data[0].pointer is the address of - a memory area containing V->data[1].integer potential Lisp_Objects. */ - ENUM_BF (Lisp_Save_Type) save_type : SAVE_TYPE_BITS; - union { - void *pointer; - voidfuncptr funcpointer; - ptrdiff_t integer; - Lisp_Object object; - } data[SAVE_VALUE_SLOTS]; - }; - -INLINE bool -SAVE_VALUEP (Lisp_Object x) -{ - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; -} + union vectorlike_header header; + void *pointer; + } GCALIGNED_STRUCT; + +extern Lisp_Object make_misc_ptr (void *); + +/* A mint_ptr object OBJ represents a C-language pointer P efficiently. + Preferably (and typically), OBJ is a Lisp integer I such that + XFIXNUMPTR (I) == P, as this represents P within a single Lisp value + without requiring any auxiliary memory. However, if P would be + damaged by being tagged as an integer and then untagged via + XFIXNUMPTR, then OBJ is a Lisp_Misc_Ptr with pointer component P. + + mint_ptr objects are efficiency hacks intended for C code. + Although xmint_ptr can be given any mint_ptr generated by non-buggy + C code, it should not be given a mint_ptr generated from Lisp code + as that would allow Lisp code to coin pointers from integers and + could lead to crashes. To package a C pointer into a Lisp-visible + object you can put the pointer into a pseudovector instead; see + Lisp_User_Ptr for an example. */ -INLINE struct Lisp_Save_Value * -XSAVE_VALUE (Lisp_Object a) +INLINE Lisp_Object +make_mint_ptr (void *a) { - eassert (SAVE_VALUEP (a)); - return XUNTAG (a, Lisp_Misc); + Lisp_Object val = TAG_PTR (Lisp_Int0, a); + return FIXNUMP (val) && XFIXNUMPTR (val) == a ? val : make_misc_ptr (a); } -/* Return the type of V's Nth saved value. */ -INLINE int -save_type (struct Lisp_Save_Value *v, int n) +INLINE bool +mint_ptrp (Lisp_Object x) { - eassert (0 <= n && n < SAVE_VALUE_SLOTS); - return (v->save_type >> (SAVE_SLOT_BITS * n) & ((1 << SAVE_SLOT_BITS) - 1)); + return FIXNUMP (x) || PSEUDOVECTORP (x, PVEC_MISC_PTR); } -/* Get and set the Nth saved pointer. */ - INLINE void * -XSAVE_POINTER (Lisp_Object obj, int n) +xmint_pointer (Lisp_Object a) { - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - return XSAVE_VALUE (obj)->data[n].pointer; -} -INLINE void -set_save_pointer (Lisp_Object obj, int n, void *val) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER); - XSAVE_VALUE (obj)->data[n].pointer = val; -} -INLINE voidfuncptr -XSAVE_FUNCPOINTER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_FUNCPOINTER); - return XSAVE_VALUE (obj)->data[n].funcpointer; -} - -/* Likewise for the saved integer. */ - -INLINE ptrdiff_t -XSAVE_INTEGER (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - return XSAVE_VALUE (obj)->data[n].integer; -} -INLINE void -set_save_integer (Lisp_Object obj, int n, ptrdiff_t val) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER); - XSAVE_VALUE (obj)->data[n].integer = val; -} - -/* Extract Nth saved object. */ - -INLINE Lisp_Object -XSAVE_OBJECT (Lisp_Object obj, int n) -{ - eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT); - return XSAVE_VALUE (obj)->data[n].object; + eassert (mint_ptrp (a)); + if (FIXNUMP (a)) + return XFIXNUMPTR (a); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Misc_Ptr)->pointer; } #ifdef HAVE_MODULES struct Lisp_User_Ptr { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_User_Ptr */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; - + union vectorlike_header header; void (*finalizer) (void *); void *p; -}; +} GCALIGNED_STRUCT; #endif /* A finalizer sentinel. */ struct Lisp_Finalizer { - struct Lisp_Misc_Any base; - - /* Circular list of all active weak references. */ - struct Lisp_Finalizer *prev; - struct Lisp_Finalizer *next; + union vectorlike_header header; /* Call FUNCTION when the finalizer becomes unreachable, even if FUNCTION contains a reference to the finalizer; i.e., call FUNCTION when it is reachable _only_ through finalizers. */ Lisp_Object function; - }; + + /* Circular list of all active weak references. */ + struct Lisp_Finalizer *prev; + struct Lisp_Finalizer *next; + } GCALIGNED_STRUCT; INLINE bool FINALIZERP (Lisp_Object x) { - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Finalizer; + return PSEUDOVECTORP (x, PVEC_FINALIZER); } INLINE struct Lisp_Finalizer * XFINALIZER (Lisp_Object a) { eassert (FINALIZERP (a)); - return XUNTAG (a, Lisp_Misc); -} - -/* A miscellaneous object, when it's on the free list. */ -struct Lisp_Free - { - ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Free */ - bool_bf gcmarkbit : 1; - unsigned spacer : 15; - union Lisp_Misc *chain; - }; - -/* To get the type field of a union Lisp_Misc, use XMISCTYPE. - It uses one of these struct subtypes to get the type field. */ - -union Lisp_Misc - { - struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */ - struct Lisp_Free u_free; - struct Lisp_Marker u_marker; - struct Lisp_Overlay u_overlay; - struct Lisp_Save_Value u_save_value; - struct Lisp_Finalizer u_finalizer; -#ifdef HAVE_MODULES - struct Lisp_User_Ptr u_user_ptr; -#endif - }; - -INLINE union Lisp_Misc * -XMISC (Lisp_Object a) -{ - return XUNTAG (a, Lisp_Misc); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Finalizer); } INLINE bool -(MARKERP) (Lisp_Object x) +MARKERP (Lisp_Object x) { - return lisp_h_MARKERP (x); + return PSEUDOVECTORP (x, PVEC_MARKER); } INLINE struct Lisp_Marker * XMARKER (Lisp_Object a) { eassert (MARKERP (a)); - return XUNTAG (a, Lisp_Misc); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Marker); } INLINE bool OVERLAYP (Lisp_Object x) { - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay; + return PSEUDOVECTORP (x, PVEC_OVERLAY); } INLINE struct Lisp_Overlay * XOVERLAY (Lisp_Object a) { eassert (OVERLAYP (a)); - return XUNTAG (a, Lisp_Misc); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay); } #ifdef HAVE_MODULES INLINE bool USER_PTRP (Lisp_Object x) { - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_User_Ptr; + return PSEUDOVECTORP (x, PVEC_USER_PTR); } INLINE struct Lisp_User_Ptr * XUSER_PTR (Lisp_Object a) { eassert (USER_PTRP (a)); - return XUNTAG (a, Lisp_Misc); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_User_Ptr); } #endif +INLINE bool +BIGNUMP (Lisp_Object x) +{ + return PSEUDOVECTORP (x, PVEC_BIGNUM); +} + +INLINE bool +INTEGERP (Lisp_Object x) +{ + return FIXNUMP (x) || BIGNUMP (x); +} + +/* Return a Lisp integer with value taken from N. */ +INLINE Lisp_Object +make_int (intmax_t n) +{ + return FIXNUM_OVERFLOW_P (n) ? make_bigint (n) : make_fixnum (n); +} +INLINE Lisp_Object +make_uint (uintmax_t n) +{ + return FIXNUM_OVERFLOW_P (n) ? make_biguint (n) : make_fixnum (n); +} + +/* Return a Lisp integer equal to the value of the C integer EXPR. */ +#define INT_TO_INTEGER(expr) \ + (EXPR_SIGNED (expr) ? make_int (expr) : make_uint (expr)) + /* Forwarding pointer to an int variable. This is allowed only in the value cell of a symbol, @@ -2577,7 +2560,7 @@ struct Lisp_Buffer_Objfwd { enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Buffer_Obj */ int offset; - /* One of Qnil, Qintegerp, Qsymbolp, Qstringp, Qfloatp or Qnumberp. */ + /* One of Qnil, Qfixnump, Qsymbolp, Qstringp, Qfloatp or Qnumberp. */ Lisp_Object predicate; }; @@ -2668,7 +2651,7 @@ struct Lisp_Float double data; struct Lisp_Float *chain; } u; - }; + } GCALIGNED_STRUCT; INLINE bool (FLOATP) (Lisp_Object x) @@ -2680,7 +2663,7 @@ INLINE struct Lisp_Float * XFLOAT (Lisp_Object a) { eassert (FLOATP (a)); - return XUNTAG (a, Lisp_Float); + return XUNTAG (a, Lisp_Float, struct Lisp_Float); } INLINE double @@ -2691,24 +2674,14 @@ XFLOAT_DATA (Lisp_Object f) /* Most hosts nowadays use IEEE floating point, so they use IEC 60559 representations, have infinities and NaNs, and do not trap on - exceptions. Define IEEE_FLOATING_POINT if this host is one of the + exceptions. Define IEEE_FLOATING_POINT to 1 if this host is one of the typical ones. The C11 macro __STDC_IEC_559__ is close to what is wanted here, but is not quite right because Emacs does not require all the features of C11 Annex F (and does not require C11 at all, for that matter). */ -enum - { - IEEE_FLOATING_POINT - = (FLT_RADIX == 2 && FLT_MANT_DIG == 24 - && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) - }; -/* A character, declared with the following typedef, is a member - of some character set associated with the current buffer. */ -#ifndef _UCHAR_T /* Protect against something in ctab.h on AIX. */ -#define _UCHAR_T -typedef unsigned char UCHAR; -#endif +#define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ + && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) /* Meanings of slots in a Lisp_Compiled: */ @@ -2746,26 +2719,26 @@ enum char_bits /* Data type checking. */ INLINE bool -NUMBERP (Lisp_Object x) +FIXNATP (Lisp_Object x) { - return INTEGERP (x) || FLOATP (x); + return FIXNUMP (x) && 0 <= XFIXNUM (x); } INLINE bool -NATNUMP (Lisp_Object x) +NUMBERP (Lisp_Object x) { - return INTEGERP (x) && 0 <= XINT (x); + return INTEGERP (x) || FLOATP (x); } INLINE bool -RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intmax_t hi) +RANGED_FIXNUMP (intmax_t lo, Lisp_Object x, intmax_t hi) { - return INTEGERP (x) && lo <= XINT (x) && XINT (x) <= hi; + return FIXNUMP (x) && lo <= XFIXNUM (x) && XFIXNUM (x) <= hi; } -#define TYPE_RANGED_INTEGERP(type, x) \ - (INTEGERP (x) \ - && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XINT (x) : 0 <= XINT (x)) \ - && XINT (x) <= TYPE_MAXIMUM (type)) +#define TYPE_RANGED_FIXNUMP(type, x) \ + (FIXNUMP (x) \ + && (TYPE_SIGNED (type) ? TYPE_MINIMUM (type) <= XFIXNUM (x) : 0 <= XFIXNUM (x)) \ + && XFIXNUM (x) <= TYPE_MAXIMUM (type)) INLINE bool AUTOLOADP (Lisp_Object x) @@ -2833,9 +2806,9 @@ CHECK_LIST_END (Lisp_Object x, Lisp_Object y) } INLINE void -(CHECK_NUMBER) (Lisp_Object x) +(CHECK_FIXNUM) (Lisp_Object x) { - lisp_h_CHECK_NUMBER (x); + lisp_h_CHECK_FIXNUM (x); } INLINE void @@ -2859,21 +2832,21 @@ CHECK_ARRAY (Lisp_Object x, Lisp_Object predicate) CHECK_TYPE (ARRAYP (x), predicate, x); } INLINE void -CHECK_NATNUM (Lisp_Object x) +CHECK_FIXNAT (Lisp_Object x) { - CHECK_TYPE (NATNUMP (x), Qwholenump, x); + CHECK_TYPE (FIXNATP (x), Qwholenump, x); } #define CHECK_RANGED_INTEGER(x, lo, hi) \ do { \ - CHECK_NUMBER (x); \ - if (! ((lo) <= XINT (x) && XINT (x) <= (hi))) \ + CHECK_FIXNUM (x); \ + if (! ((lo) <= XFIXNUM (x) && XFIXNUM (x) <= (hi))) \ args_out_of_range_3 \ (x, \ - make_number ((lo) < 0 && (lo) < MOST_NEGATIVE_FIXNUM \ + make_fixnum ((lo) < 0 && (lo) < MOST_NEGATIVE_FIXNUM \ ? MOST_NEGATIVE_FIXNUM \ : (lo)), \ - make_number (min (hi, MOST_POSITIVE_FIXNUM))); \ + make_fixnum (min (hi, MOST_POSITIVE_FIXNUM))); \ } while (false) #define CHECK_TYPE_RANGED_INTEGER(type, x) \ do { \ @@ -2883,27 +2856,35 @@ CHECK_NATNUM (Lisp_Object x) CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ } while (false) -#define CHECK_NUMBER_COERCE_MARKER(x) \ +#define CHECK_FIXNUM_COERCE_MARKER(x) \ do { \ if (MARKERP ((x))) \ XSETFASTINT (x, marker_position (x)); \ else \ - CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); \ + CHECK_TYPE (FIXNUMP (x), Qinteger_or_marker_p, x); \ } while (false) INLINE double XFLOATINT (Lisp_Object n) { - return FLOATP (n) ? XFLOAT_DATA (n) : XINT (n); + return (FIXNUMP (n) ? XFIXNUM (n) + : FLOATP (n) ? XFLOAT_DATA (n) + : bignum_to_double (n)); } INLINE void -CHECK_NUMBER_OR_FLOAT (Lisp_Object x) +CHECK_NUMBER (Lisp_Object x) { CHECK_TYPE (NUMBERP (x), Qnumberp, x); } -#define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \ +INLINE void +CHECK_INTEGER (Lisp_Object x) +{ + CHECK_TYPE (INTEGERP (x), Qnumberp, x); +} + +#define CHECK_NUMBER_COERCE_MARKER(x) \ do { \ if (MARKERP (x)) \ XSETFASTINT (x, marker_position (x)); \ @@ -2911,23 +2892,13 @@ CHECK_NUMBER_OR_FLOAT (Lisp_Object x) CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); \ } while (false) -/* Since we can't assign directly to the CAR or CDR fields of a cons - cell, use these when checking that those fields contain numbers. */ -INLINE void -CHECK_NUMBER_CAR (Lisp_Object x) -{ - Lisp_Object tmp = XCAR (x); - CHECK_NUMBER (tmp); - XSETCAR (x, tmp); -} - -INLINE void -CHECK_NUMBER_CDR (Lisp_Object x) -{ - Lisp_Object tmp = XCDR (x); - CHECK_NUMBER (tmp); - XSETCDR (x, tmp); -} +#define CHECK_INTEGER_COERCE_MARKER(x) \ + do { \ + if (MARKERP (x)) \ + XSETFASTINT (x, marker_position (x)); \ + else \ + CHECK_TYPE (INTEGERP (x), Qnumber_or_marker_p, x); \ + } while (false) /* Define a built-in function for calling from Lisp. `lname' should be the name to give the function in Lisp, @@ -2956,27 +2927,16 @@ CHECK_NUMBER_CDR (Lisp_Object x) /* This version of DEFUN declares a function prototype with the right arguments, so we can catch errors with maxargs at compile-time. */ -#ifdef _MSC_VER #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ - Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ - static struct Lisp_Subr sname = \ - { { (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) \ - | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)) }, \ - { (Lisp_Object (__cdecl *)(void))fnname }, \ - minargs, maxargs, lname, intspec, 0}; \ - Lisp_Object fnname -#else /* not _MSC_VER */ -#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ - static struct Lisp_Subr sname = \ - { { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ + static union Aligned_Lisp_Subr sname = \ + {{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ { .a ## maxargs = fnname }, \ - minargs, maxargs, lname, intspec, 0}; \ + minargs, maxargs, lname, intspec, 0}}; \ Lisp_Object fnname -#endif /* defsubr (Sname); is how we define the symbol for function `name' at start-up time. */ -extern void defsubr (struct Lisp_Subr *); +extern void defsubr (union Aligned_Lisp_Subr *); enum maxargs { @@ -3065,8 +3025,11 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int); enum specbind_tag { SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */ + SPECPDL_UNWIND_ARRAY, /* Likewise, on an array that needs freeing. + Its elements are potential Lisp_Objects. */ SPECPDL_UNWIND_PTR, /* Likewise, on void *. */ SPECPDL_UNWIND_INT, /* Likewise, on int. */ + SPECPDL_UNWIND_EXCURSION, /* Likewise, on an execursion. */ SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */ SPECPDL_BACKTRACE, /* An element of the backtrace. */ SPECPDL_LET, /* A plain and simple dynamic let-binding. */ @@ -3077,14 +3040,22 @@ enum specbind_tag { union specbinding { + /* Aligning similar members consistently might help efficiency slightly + (Bug#31996#25). */ ENUM_BF (specbind_tag) kind : CHAR_BIT; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; void (*func) (Lisp_Object); Lisp_Object arg; + EMACS_INT eval_depth; } unwind; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + ptrdiff_t nelts; + Lisp_Object *array; + } unwind_array; + struct { + ENUM_BF (specbind_tag) kind : CHAR_BIT; void (*func) (void *); void *arg; } unwind_ptr; @@ -3095,6 +3066,10 @@ union specbinding } unwind_int; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + Lisp_Object marker, window; + } unwind_excursion; + struct { + ENUM_BF (specbind_tag) kind : CHAR_BIT; void (*func) (void); } unwind_void; struct { @@ -3323,6 +3298,50 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) XSUB_CHAR_TABLE (table)->contents[idx] = val; } +/* Defined in bignum.c. This part of bignum.c's API does not require + the caller to access bignum internals; see bignum.h for that. */ +extern intmax_t bignum_to_intmax (Lisp_Object); +extern uintmax_t bignum_to_uintmax (Lisp_Object); +extern ptrdiff_t bignum_bufsize (Lisp_Object, int); +extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int); +extern Lisp_Object bignum_to_string (Lisp_Object, int); +extern Lisp_Object make_bignum_str (char const *, int); +extern Lisp_Object make_neg_biguint (uintmax_t); +extern Lisp_Object double_to_integer (double); + +/* Converthe integer NUM to *N. Return true if successful, false + (possibly setting *N) otherwise. */ +INLINE bool +integer_to_intmax (Lisp_Object num, intmax_t *n) +{ + if (FIXNUMP (num)) + { + *n = XFIXNUM (num); + return true; + } + else + { + intmax_t i = bignum_to_intmax (num); + *n = i; + return i != 0; + } +} +INLINE bool +integer_to_uintmax (Lisp_Object num, uintmax_t *n) +{ + if (FIXNUMP (num)) + { + *n = XFIXNUM (num); + return 0 <= XFIXNUM (num); + } + else + { + uintmax_t i = bignum_to_uintmax (num); + *n = i; + return i != 0; + } +} + /* Defined in data.c. */ extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object); extern void notify_variable_watchers (Lisp_Object, Lisp_Object, @@ -3340,16 +3359,6 @@ enum Arith_Comparison { extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, enum Arith_Comparison comparison); -/* Convert the integer I to an Emacs representation, either the integer - itself, or a cons of two or three integers, or if all else fails a float. - I should not have side effects. */ -#define INTEGER_TO_CONS(i) \ - (! FIXNUM_OVERFLOW_P (i) \ - ? make_number (i) \ - : EXPR_SIGNED (i) ? intbig_to_lisp (i) : uintbig_to_lisp (i)) -extern Lisp_Object intbig_to_lisp (intmax_t); -extern Lisp_Object uintbig_to_lisp (uintmax_t); - /* Convert the Emacs representation CONS back to an integer of type TYPE, storing the result the variable VAR. Signal an error if CONS is not a valid representation or is out of range for TYPE. */ @@ -3376,7 +3385,7 @@ extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, enum Set_Internal_Bind); extern void set_default_internal (Lisp_Object, Lisp_Object, enum Set_Internal_Bind bindflag); - +extern Lisp_Object expt_integer (Lisp_Object, Lisp_Object); extern void syms_of_data (void); extern void swap_in_global_binding (struct Lisp_Symbol *); @@ -3442,8 +3451,11 @@ extern Lisp_Object string_make_unibyte (Lisp_Object); extern void syms_of_fns (void); /* Defined in floatfns.c. */ -extern void syms_of_floatfns (void); +#ifndef HAVE_TRUNC +extern double trunc (double); +#endif extern Lisp_Object fmod_float (Lisp_Object x, Lisp_Object y); +extern void syms_of_floatfns (void); /* Defined in fringe.c. */ extern void syms_of_fringe (void); @@ -3458,6 +3470,12 @@ extern int x_bitmap_mask (struct frame *, ptrdiff_t); extern void reset_image_types (void); extern void syms_of_image (void); +#ifdef HAVE_JSON +/* Defined in json.c. */ +extern void init_json (void); +extern void syms_of_json (void); +#endif + /* Defined in insdel.c. */ extern void move_gap_both (ptrdiff_t, ptrdiff_t); extern _Noreturn void buffer_overflow (void); @@ -3507,8 +3525,7 @@ extern void replace_range_2 (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, extern void syms_of_insdel (void); /* Defined in dispnew.c. */ -#if (defined PROFILING \ - && (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__)) +#ifdef PROFILING _Noreturn void __executable_start (void); #endif extern Lisp_Object Vwindow_system; @@ -3559,7 +3576,6 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t, /* Defined in alloc.c. */ extern void *my_heap_start (void); extern void check_pure_size (void); -extern void free_misc (Lisp_Object); extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT); extern void malloc_warning (const char *); extern _Noreturn void memory_full (size_t); @@ -3571,6 +3587,7 @@ extern void refill_memory_reserve (void); #endif extern void alloc_unexec_pre (void); extern void alloc_unexec_post (void); +extern void mark_maybe_objects (Lisp_Object *, ptrdiff_t); extern void mark_stack (char *, char *); extern void flush_stack_call_func (void (*func) (void *arg), void *arg); extern const char *pending_malloc_warning; @@ -3592,20 +3609,20 @@ extern Lisp_Object listn (enum constype, ptrdiff_t, Lisp_Object, ...); INLINE Lisp_Object list2i (EMACS_INT x, EMACS_INT y) { - return list2 (make_number (x), make_number (y)); + return list2 (make_fixnum (x), make_fixnum (y)); } INLINE Lisp_Object list3i (EMACS_INT x, EMACS_INT y, EMACS_INT w) { - return list3 (make_number (x), make_number (y), make_number (w)); + return list3 (make_fixnum (x), make_fixnum (y), make_fixnum (w)); } INLINE Lisp_Object list4i (EMACS_INT x, EMACS_INT y, EMACS_INT w, EMACS_INT h) { - return list4 (make_number (x), make_number (y), - make_number (w), make_number (h)); + return list4 (make_fixnum (x), make_fixnum (y), + make_fixnum (w), make_fixnum (h)); } extern Lisp_Object make_uninit_bool_vector (EMACS_INT); @@ -3652,8 +3669,9 @@ build_string (const char *str) } extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); +extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object); extern void make_byte_code (struct Lisp_Vector *); -extern struct Lisp_Vector *allocate_vector (EMACS_INT); +extern struct Lisp_Vector *allocate_vector (ptrdiff_t); /* Make an uninitialized vector for SIZE objects. NOTE: you must be sure that GC cannot happen until the vector is completely @@ -3667,12 +3685,7 @@ extern struct Lisp_Vector *allocate_vector (EMACS_INT); INLINE Lisp_Object make_uninit_vector (ptrdiff_t size) { - Lisp_Object v; - struct Lisp_Vector *p; - - p = allocate_vector (size); - XSETVECTOR (v, p); - return v; + return make_lisp_ptr (allocate_vector (size), Lisp_Vectorlike); } /* Like above, but special for sub char-tables. */ @@ -3689,6 +3702,16 @@ make_uninit_sub_char_table (int depth, int min_char) return v; } +/* Make a vector of SIZE nils. */ + +INLINE Lisp_Object +make_nil_vector (ptrdiff_t size) +{ + Lisp_Object vec = make_uninit_vector (size); + memclear (XVECTOR (vec)->contents, size * word_size); + return vec; +} + extern struct Lisp_Vector *allocate_pseudovector (int, int, int, enum pvec_type); @@ -3712,16 +3735,6 @@ extern bool gc_in_progress; extern Lisp_Object make_float (double); extern void display_malloc_warning (void); extern ptrdiff_t inhibit_garbage_collection (void); -extern Lisp_Object make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t); -extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object); -extern Lisp_Object make_save_ptr (void *); -extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t); -extern Lisp_Object make_save_ptr_ptr (void *, void *); -extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *, - Lisp_Object); -extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t); -extern void free_save_value (Lisp_Object); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); extern void free_cons (struct Lisp_Cons *); extern void init_alloc_once (void); @@ -3809,7 +3822,8 @@ LOADHIST_ATTACH (Lisp_Object x) } extern int openp (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object *, Lisp_Object, bool); -extern Lisp_Object string_to_number (char const *, int, bool); +enum { S2N_IGNORE_TRAILING = 1 }; +extern Lisp_Object string_to_number (char const *, int, ptrdiff_t *); extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object), Lisp_Object); extern void dir_warning (const char *, Lisp_Object); @@ -3859,6 +3873,7 @@ extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object); extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern _Noreturn void signal_error (const char *, Lisp_Object); +extern _Noreturn void overflow_error (void); extern bool FUNCTIONP (Lisp_Object); extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector); extern Lisp_Object eval_sub (Lisp_Object form); @@ -3880,13 +3895,16 @@ extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp extern Lisp_Object internal_condition_case_n (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *)); +extern Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (Lisp_Object)); extern struct handler *push_handler (Lisp_Object, enum handlertype); extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype); extern void specbind (Lisp_Object, Lisp_Object); extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); +extern void record_unwind_protect_array (Lisp_Object *, ptrdiff_t); extern void record_unwind_protect_ptr (void (*) (void *), void *); extern void record_unwind_protect_int (void (*) (int), int); extern void record_unwind_protect_void (void (*) (void)); +extern void record_unwind_protect_excursion (void); extern void record_unwind_protect_nothing (void); extern void clear_unwind_protect (ptrdiff_t); extern void set_unwind_protect (ptrdiff_t, void (*) (Lisp_Object), Lisp_Object); @@ -3946,7 +3964,7 @@ struct Lisp_Module_Function ptrdiff_t min_arity, max_arity; emacs_subr subr; void *data; -}; +} GCALIGNED_STRUCT; INLINE bool MODULE_FUNCTIONP (Lisp_Object o) @@ -3958,7 +3976,7 @@ INLINE struct Lisp_Module_Function * XMODULE_FUNCTION (Lisp_Object o) { eassert (MODULE_FUNCTIONP (o)); - return XUNTAG (o, Lisp_Vectorlike); + return XUNTAG (o, Lisp_Vectorlike, struct Lisp_Module_Function); } #ifdef HAVE_MODULES @@ -3975,18 +3993,18 @@ extern void syms_of_module (void); /* Defined in thread.c. */ extern void mark_threads (void); +extern void unmark_main_thread (void); /* Defined in editfns.c. */ extern void insert1 (Lisp_Object); -extern Lisp_Object save_excursion_save (void); +extern void save_excursion_save (union specbinding *); +extern void save_excursion_restore (Lisp_Object, Lisp_Object); extern Lisp_Object save_restriction_save (void); -extern void save_excursion_restore (Lisp_Object); extern void save_restriction_restore (Lisp_Object); -extern _Noreturn void time_overflow (void); extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool); extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool); -extern void init_editfns (bool); +extern void init_editfns (void); extern void syms_of_editfns (void); /* Defined in buffer.c. */ @@ -4024,6 +4042,8 @@ extern void syms_of_marker (void); /* Defined in fileio.c. */ +extern char *splice_dir_file (char *, char const *, char const *); +extern char const *get_homedir (void); extern Lisp_Object expand_and_dir_to_file (Lisp_Object); extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, @@ -4037,7 +4057,7 @@ extern _Noreturn void report_file_error (const char *, Lisp_Object); extern _Noreturn void report_file_notify_error (const char *, Lisp_Object); extern bool internal_delete_file (Lisp_Object); extern Lisp_Object emacs_readlinkat (int, const char *); -extern bool file_directory_p (const char *); +extern bool file_directory_p (Lisp_Object); extern bool file_accessible_directory_p (Lisp_Object); extern void init_fileio (void); extern void syms_of_fileio (void); @@ -4048,10 +4068,6 @@ extern void restore_search_regs (void); extern void update_search_regs (ptrdiff_t oldstart, ptrdiff_t oldend, ptrdiff_t newend); extern void record_unwind_save_match_data (void); -struct re_registers; -extern struct re_pattern_buffer *compile_pattern (Lisp_Object, - struct re_registers *, - Lisp_Object, bool, bool); extern ptrdiff_t fast_string_match_internal (Lisp_Object, Lisp_Object, Lisp_Object); @@ -4152,6 +4168,7 @@ extern void syms_of_frame (void); /* Defined in emacs.c. */ extern char **initial_argv; extern int initial_argc; +extern char const *emacs_wd; #if defined (HAVE_X_WINDOWS) || defined (HAVE_NS) extern bool display_arg; #endif @@ -4292,9 +4309,13 @@ struct tty_display_info; /* Defined in sysdep.c. */ #ifdef HAVE_PERSONALITY_ADDR_NO_RANDOMIZE -extern bool disable_address_randomization (void); +extern int maybe_disable_address_randomization (bool, int, char **); #else -INLINE bool disable_address_randomization (void) { return false; } +INLINE int +maybe_disable_address_randomization (bool dumping, int argc, char **argv) +{ + return argc; +} #endif extern int emacs_exec_file (char const *, char *const *, char *const *); extern void init_standard_fds (void); @@ -4327,6 +4348,7 @@ extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t); extern void emacs_perror (char const *); extern int renameat_noreplace (int, char const *, int, char const *); extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); +extern void syms_of_sysdep (void); /* Defined in filelock.c. */ extern void lock_file (Lisp_Object); @@ -4392,6 +4414,11 @@ extern void syms_of_gfilenotify (void); extern void syms_of_w32notify (void); #endif +#if defined HAVE_NTGUI || defined CYGWIN +/* Defined in w32cygwinx.c. */ +extern void syms_of_w32cygwinx (void); +#endif + /* Defined in xfaces.c. */ extern Lisp_Object Vface_alternative_font_family_alist; extern Lisp_Object Vface_alternative_font_registry_alist; @@ -4417,9 +4444,9 @@ extern void syms_of_xterm (void); extern char *x_get_keysym_name (int); #endif /* HAVE_WINDOW_SYSTEM */ -#ifdef HAVE_LIBXML2 /* Defined in xml.c. */ extern void syms_of_xml (void); +#ifdef HAVE_LIBXML2 extern void xml_cleanup_parser (void); #endif @@ -4500,12 +4527,6 @@ extern void init_system_name (void); because 'abs' is reserved by the C standard. */ #define eabs(x) ((x) < 0 ? -(x) : (x)) -/* Return a fixnum or float, depending on whether the integer VAL fits - in a Lisp fixnum. */ - -#define make_fixnum_or_float(val) \ - (FIXNUM_OVERFLOW_P (val) ? make_float (val) : make_number (val)) - /* SAFE_ALLOCA normally allocates memory on the stack, but if size is larger than MAX_ALLOCA, use xmalloc to avoid overflowing the stack. */ @@ -4515,7 +4536,7 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); #define USE_SAFE_ALLOCA \ ptrdiff_t sa_avail = MAX_ALLOCA; \ - ptrdiff_t sa_count = SPECPDL_INDEX (); bool sa_must_free = false + ptrdiff_t sa_count = SPECPDL_INDEX () #define AVAIL_ALLOCA(size) (sa_avail -= (size), alloca (size)) @@ -4523,7 +4544,7 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); #define SAFE_ALLOCA(size) ((size) <= sa_avail \ ? AVAIL_ALLOCA (size) \ - : (sa_must_free = true, record_xmalloc (size))) + : record_xmalloc (size)) /* SAFE_NALLOCA sets BUF to a newly allocated array of MULTIPLIER * NITEMS items, each of the same type as *BUF. MULTIPLIER must @@ -4536,7 +4557,6 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); else \ { \ (buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \ - sa_must_free = true; \ record_unwind_protect_ptr (xfree, buf); \ } \ } while (false) @@ -4549,15 +4569,44 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); memcpy (ptr, SDATA (string), SBYTES (string) + 1); \ } while (false) -/* SAFE_FREE frees xmalloced memory and enables GC as needed. */ +/* Free xmalloced memory and enable GC as needed. */ -#define SAFE_FREE() \ - do { \ - if (sa_must_free) { \ - sa_must_free = false; \ - unbind_to (sa_count, Qnil); \ - } \ - } while (false) +#define SAFE_FREE() safe_free (sa_count) + +INLINE void +safe_free (ptrdiff_t sa_count) +{ + while (specpdl_ptr != specpdl + sa_count) + { + specpdl_ptr--; + if (specpdl_ptr->kind == SPECPDL_UNWIND_PTR) + { + eassert (specpdl_ptr->unwind_ptr.func == xfree); + xfree (specpdl_ptr->unwind_ptr.arg); + } + else + { + eassert (specpdl_ptr->kind == SPECPDL_UNWIND_ARRAY); + xfree (specpdl_ptr->unwind_array.array); + } + } +} + +/* Pop the specpdl stack back to COUNT, and return VAL. + Prefer this to { SAFE_FREE (); unbind_to (COUNT, VAL); } + when COUNT predates USE_SAFE_ALLOCA, as it is a bit more efficient + and also lets callers intermix SAFE_ALLOCA calls with other calls + that grow the specpdl stack. */ + +#define SAFE_FREE_UNBIND_TO(count, val) \ + safe_free_unbind_to (count, sa_count, val) + +INLINE Lisp_Object +safe_free_unbind_to (ptrdiff_t count, ptrdiff_t sa_count, Lisp_Object val) +{ + eassert (count <= sa_count); + return unbind_to (count, val); +} /* Set BUF to point to an allocated array of NELT Lisp_Objects, immediately followed by EXTRA spare bytes. */ @@ -4573,11 +4622,8 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); (buf) = AVAIL_ALLOCA (alloca_nbytes); \ else \ { \ - Lisp_Object arg_; \ (buf) = xmalloc (alloca_nbytes); \ - arg_ = make_save_memory (buf, nelt); \ - sa_must_free = true; \ - record_unwind_protect (free_save_value, arg_); \ + record_unwind_protect_array (buf, nelt); \ } \ } while (false) @@ -4586,13 +4632,14 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); #define SAFE_ALLOCA_LISP(buf, nelt) SAFE_ALLOCA_LISP_EXTRA (buf, nelt, 0) -/* If USE_STACK_LISP_OBJECTS, define macros that and functions that allocate - block-scoped conses and strings. These objects are not - managed by the garbage collector, so they are dangerous: passing them - out of their scope (e.g., to user code) results in undefined behavior. - Conversely, they have better performance because GC is not involved. +/* If USE_STACK_LISP_OBJECTS, define macros and functions that + allocate some Lisp objects on the C stack. As the storage is not + managed by the garbage collector, these objects are dangerous: + passing them to user code could result in undefined behavior if the + objects are in use after the C function returns. Conversely, these + objects have better performance because GC is not involved. - This feature is experimental and requires careful debugging. + While debugging you may want to disable allocation on the C stack. Build with CPPFLAGS='-DUSE_STACK_LISP_OBJECTS=0' to disable it. */ #if (!defined USE_STACK_LISP_OBJECTS \ @@ -4657,7 +4704,8 @@ enum Take its unibyte value from the null-terminated string STR, an expression that should not have side effects. STR's value is not necessarily copied. The resulting Lisp string - should not be modified or made visible to user code. */ + should not be modified or given text properties or made visible to + user code. */ #define AUTO_STRING(name, str) \ AUTO_STRING_WITH_LEN (name, str, strlen (str)) @@ -4666,7 +4714,8 @@ enum Take its unibyte value from the null-terminated string STR with length LEN. STR may have side effects and may contain null bytes. STR's value is not necessarily copied. The resulting Lisp string - should not be modified or made visible to user code. */ + should not be modified or given text properties or made visible to + user code. */ #define AUTO_STRING_WITH_LEN(name, str, len) \ Lisp_Object name = \ @@ -4676,6 +4725,11 @@ enum Lisp_String)) \ : make_unibyte_string (str, len)) +/* The maximum length of "small" lists, as a heuristic. These lists + are so short that code need not check for cycles or quits while + traversing. */ +enum { SMALL_LIST_LEN_MAX = 127 }; + /* Loop over conses of the list TAIL, signaling if a cycle is found, and possibly quitting after each loop iteration. In the loop body, set TAIL to the current cons. If the loop exits normally, @@ -4686,7 +4740,7 @@ enum #define FOR_EACH_TAIL(tail) \ FOR_EACH_TAIL_INTERNAL (tail, circular_list (tail), true) -/* Like FOR_EACH_TAIL (LIST), except do not signal or quit. +/* Like FOR_EACH_TAIL (TAIL), except do not signal or quit. If the loop exits due to a cycle, TAIL’s value is undefined. */ #define FOR_EACH_TAIL_SAFE(tail) \ |