X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f2b31075364c17574955493ec5effa7baa12ee24..99027bdd81f63ea690394a153ef49a08f55e498d:/src/lisp.h diff --git a/src/lisp.h b/src/lisp.h index 2c54c9b41e..d6cc886bae 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1,5 +1,5 @@ /* Fundamental definitions for GNU Emacs Lisp interpreter. - Copyright (C) 1985-1987, 1993-1995, 1997-2011 + Copyright (C) 1985-1987, 1993-1995, 1997-2012 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -41,25 +41,36 @@ extern void check_cons_list (void); Build with CFLAGS='-DWIDE_EMACS_INT' to try them out. */ /* #undef WIDE_EMACS_INT */ -/* These are default choices for the types to use. */ +/* EMACS_INT - signed integer wide enough to hold an Emacs value + EMACS_INT_MAX - maximum value of EMACS_INT; can be used in #if + pI - printf length modifier for EMACS_INT + EMACS_UINT - unsigned variant of EMACS_INT */ #ifndef EMACS_INT -# if BITS_PER_LONG < BITS_PER_LONG_LONG && defined WIDE_EMACS_INT +# if LONG_MAX < LLONG_MAX && defined WIDE_EMACS_INT # define EMACS_INT long long -# define BITS_PER_EMACS_INT BITS_PER_LONG_LONG +# define EMACS_INT_MAX LLONG_MAX # define pI "ll" -# elif BITS_PER_INT < BITS_PER_LONG +# elif INT_MAX < LONG_MAX # define EMACS_INT long -# define BITS_PER_EMACS_INT BITS_PER_LONG +# define EMACS_INT_MAX LONG_MAX # define pI "l" # else # define EMACS_INT int -# define BITS_PER_EMACS_INT BITS_PER_INT +# define EMACS_INT_MAX INT_MAX # define pI "" # endif #endif -#ifndef EMACS_UINT -# define EMACS_UINT unsigned EMACS_INT -#endif +#define EMACS_UINT unsigned EMACS_INT + +/* Number of bits in some machine integer types. */ +enum + { + BITS_PER_CHAR = CHAR_BIT, + BITS_PER_SHORT = CHAR_BIT * sizeof (short), + BITS_PER_INT = CHAR_BIT * sizeof (int), + BITS_PER_LONG = CHAR_BIT * sizeof (long int), + BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT) + }; /* printmax_t and uprintmax_t are types for printing large integers. These are the widest integers that are supported for printing. @@ -95,65 +106,43 @@ typedef EMACS_UINT uprintmax_t; /* Extra internal type checking? */ -#ifdef ENABLE_CHECKING +/* Define an Emacs version of 'assert (COND)', since some + system-defined 'assert's are flaky. COND should be free of side + effects; it may or may not be evaluated. */ +#ifndef ENABLE_CHECKING +# define eassert(X) ((void) (0 && (X))) /* Check that X compiles. */ +#else /* ENABLE_CHECKING */ -extern void die (const char *, const char *, int) NO_RETURN; +extern _Noreturn void die (const char *, const char *, int); /* The suppress_checking variable is initialized to 0 in alloc.c. Set it to 1 using a debugger to temporarily disable aborting on detected internal inconsistencies or error conditions. - Testing suppress_checking after the supplied condition ensures that - the side effects produced by CHECK will be consistent, independent - of whether ENABLE_CHECKING is defined, or whether the checks are - suppressed at run time. - In some cases, a good compiler may be able to optimize away the - CHECK macro altogether, e.g., if XSTRING (x) uses CHECK to test + eassert macro altogether, e.g., if XSTRING (x) uses eassert to test STRINGP (x), but a particular use of XSTRING is invoked only after testing that STRINGP (x) is true, making the test redundant. */ - extern int suppress_checking EXTERNALLY_VISIBLE; -#define CHECK(check,msg) (((check) || suppress_checking \ - ? (void) 0 \ - : die ((msg), __FILE__, __LINE__)), \ - 0) -#else - -/* Produce same side effects and result, but don't complain. */ -#define CHECK(check,msg) ((check),0) - -#endif - -/* Define an Emacs version of "assert", since some system ones are - flaky. */ -#ifndef ENABLE_CHECKING -#define eassert(X) ((void) (0 && (X))) /* Check that X compiles. */ -#else /* ENABLE_CHECKING */ -#if defined (__GNUC__) && __GNUC__ >= 2 && defined (__STDC__) -#define eassert(cond) CHECK (cond, "assertion failed: " #cond) -#else -#define eassert(cond) CHECK (cond, "assertion failed") -#endif +# define eassert(cond) \ + ((cond) || suppress_checking \ + ? (void) 0 \ + : die ("assertion failed: " # cond, __FILE__, __LINE__)) #endif /* ENABLE_CHECKING */ -/* Use the configure flag --enable-use-lisp-union-type to make - Lisp_Object use a union type instead of the default int. The flag - causes USE_LISP_UNION_TYPE to be defined. */ +/* Use the configure flag --enable-check-lisp-object-type to make + Lisp_Object use a struct type instead of the default int. The flag + causes CHECK_LISP_OBJECT_TYPE to be defined. */ /***** Select the tagging scheme. *****/ -/* There are basically two options that control the tagging scheme: - - USE_LISP_UNION_TYPE says that Lisp_Object should be a union instead - of an integer. +/* The following option controls the tagging scheme: - USE_LSB_TAG means that we can assume the least 3 bits of pointers are always 0, and we can thus use them to hold tag bits, without restricting our addressing space. - If USE_LSB_TAG is not set, then we use the top 3 bits for tagging, thus - restricting our possible address range. Currently USE_LSB_TAG is not - allowed together with a union. This is not due to any fundamental - technical (or political ;-) problem: nobody wrote the code to do it yet. + If ! USE_LSB_TAG, then use the top 3 bits for tagging, thus + restricting our possible address range. 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 @@ -162,30 +151,59 @@ extern int suppress_checking EXTERNALLY_VISIBLE; /* First, try and define DECL_ALIGN(type,var) which declares a static variable VAR of type TYPE with the added requirement that it be - TYPEBITS-aligned. */ + TYPEBITS-aligned. */ + +#define GCTYPEBITS 3 +#define VALBITS (BITS_PER_EMACS_INT - GCTYPEBITS) + +/* 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. + This can be used in #if, e.g., '#if VAL_MAX < UINTPTR_MAX' below. */ +#define VAL_MAX (EMACS_INT_MAX >> (GCTYPEBITS - 1)) + #ifndef NO_DECL_ALIGN # ifndef DECL_ALIGN # if HAVE_ATTRIBUTE_ALIGNED # define DECL_ALIGN(type, var) \ type __attribute__ ((__aligned__ (1 << GCTYPEBITS))) var +# elif defined(_MSC_VER) +# define ALIGN_GCTYPEBITS 8 +# if (1 << GCTYPEBITS) != ALIGN_GCTYPEBITS +# error ALIGN_GCTYPEBITS is wrong! +# endif +# define DECL_ALIGN(type, var) \ + type __declspec(align(ALIGN_GCTYPEBITS)) var # else /* What directives do other compilers use? */ # endif # endif #endif -/* Let's USE_LSB_TAG on systems where we know malloc returns mult-of-8. */ -#if (defined GNU_MALLOC || defined DOUG_LEA_MALLOC || defined __GLIBC__ \ - || defined DARWIN_OS || defined __sun) -/* We also need to be able to specify mult-of-8 alignment on static vars. */ -# if defined DECL_ALIGN -# define USE_LSB_TAG +/* Unless otherwise specified, use USE_LSB_TAG on systems where: */ +#ifndef USE_LSB_TAG +/* 1. We know malloc returns a multiple of 8. */ +# if (defined GNU_MALLOC || defined DOUG_LEA_MALLOC || defined __GLIBC__ \ + || defined DARWIN_OS || defined __sun) +/* 2. We can specify multiple-of-8 alignment on static variables. */ +# ifdef DECL_ALIGN +/* 3. Pointers-as-ints exceed VAL_MAX. + On hosts where pointers-as-ints do not exceed VAL_MAX, USE_LSB_TAG is: + a. unnecessary, because the top bits of an EMACS_INT are unused, and + b. slower, because it typically requires extra masking. + So, default USE_LSB_TAG to 1 only on hosts where it might be useful. */ +# if VAL_MAX < UINTPTR_MAX +# define USE_LSB_TAG 1 +# endif +# endif # endif #endif +#ifndef USE_LSB_TAG +# define USE_LSB_TAG 0 +#endif /* If we cannot use 8-byte alignment, make DECL_ALIGN a no-op. */ #ifndef DECL_ALIGN -# ifdef USE_LSB_TAG +# if USE_LSB_TAG # error "USE_LSB_TAG used without defining DECL_ALIGN" # endif # define DECL_ALIGN(type, var) type var @@ -194,46 +212,33 @@ extern int suppress_checking EXTERNALLY_VISIBLE; /* Define the fundamental Lisp data structures. */ -/* If USE_2_TAGBITS_FOR_INTS is defined, then Lisp integers use - 2 tags, to give them one extra bit, thus extending their range from - e.g -2^28..2^28-1 to -2^29..2^29-1. */ -#define USE_2_TAGS_FOR_INTS - -/* Making it work for the union case is too much trouble. */ -#ifdef USE_LISP_UNION_TYPE -# undef USE_2_TAGS_FOR_INTS -#endif - /* This is the set of Lisp data types. */ -#if !defined USE_2_TAGS_FOR_INTS -# define LISP_INT_TAG Lisp_Int -# define case_Lisp_Int case Lisp_Int -# define LISP_STRING_TAG 4 -# define LISP_INT_TAG_P(x) ((x) == Lisp_Int) +/* Lisp integers use 2 tags, to give them one extra bit, thus + extending their range from, e.g., -2^28..2^28-1 to -2^29..2^29-1. */ +#define INTTYPEBITS (GCTYPEBITS - 1) +#define FIXNUM_BITS (VALBITS + 1) +#define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1)) +#define LISP_INT_TAG Lisp_Int0 +#define case_Lisp_Int case Lisp_Int0: case Lisp_Int1 +#define LISP_INT1_TAG (USE_LSB_TAG ? 1 << INTTYPEBITS : 1) +#define LISP_STRING_TAG (5 - LISP_INT1_TAG) +#define LISP_INT_TAG_P(x) (((x) & ~LISP_INT1_TAG) == 0) + +/* Stolen from GDB. The only known compiler that doesn't support + enums in bitfields is MSVC. */ +#ifdef _MSC_VER +#define ENUM_BF(TYPE) unsigned int #else -# define LISP_INT_TAG Lisp_Int0 -# define case_Lisp_Int case Lisp_Int0: case Lisp_Int1 -# ifdef USE_LSB_TAG -# define LISP_INT1_TAG 4 -# define LISP_STRING_TAG 1 -# define LISP_INT_TAG_P(x) (((x) & 3) == 0) -# else -# define LISP_INT1_TAG 1 -# define LISP_STRING_TAG 4 -# define LISP_INT_TAG_P(x) (((x) & 6) == 0) -# endif +#define ENUM_BF(TYPE) enum TYPE #endif + enum Lisp_Type { /* Integer. XINT (obj) is the integer value. */ -#ifdef USE_2_TAGS_FOR_INTS Lisp_Int0 = 0, Lisp_Int1 = LISP_INT1_TAG, -#else - Lisp_Int = 0, -#endif /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ Lisp_Symbol = 2, @@ -288,89 +293,36 @@ enum Lisp_Fwd_Type Lisp_Fwd_Kboard_Obj, /* Fwd to a Lisp_Object field of kboards. */ }; -#ifndef GCTYPEBITS -#define GCTYPEBITS 3 -#endif - -/* These values are overridden by the m- file on some machines. */ -#ifndef VALBITS -#define VALBITS (BITS_PER_EMACS_INT - GCTYPEBITS) -#endif - -#ifdef USE_LISP_UNION_TYPE +#ifdef CHECK_LISP_OBJECT_TYPE -#ifndef WORDS_BIGENDIAN +typedef struct { EMACS_INT i; } Lisp_Object; -/* Definition of Lisp_Object for little-endian machines. */ - -typedef -union Lisp_Object - { - /* Used for comparing two Lisp_Objects; - also, positive integers can be accessed fast this way. */ - EMACS_INT i; - - struct - { - /* Use explict signed, the signedness of a bit-field of type - int is implementation defined. */ - signed EMACS_INT val : VALBITS; - enum Lisp_Type type : GCTYPEBITS; - } s; - struct - { - EMACS_UINT val : VALBITS; - enum Lisp_Type type : GCTYPEBITS; - } u; - } -Lisp_Object; - -#else /* If WORDS_BIGENDIAN */ - -typedef -union Lisp_Object - { - /* Used for comparing two Lisp_Objects; - also, positive integers can be accessed fast this way. */ - EMACS_INT i; - - struct - { - enum Lisp_Type type : GCTYPEBITS; - /* Use explict signed, the signedness of a bit-field of type - int is implementation defined. */ - signed EMACS_INT val : VALBITS; - } s; - struct - { - enum Lisp_Type type : GCTYPEBITS; - EMACS_UINT val : VALBITS; - } u; - } -Lisp_Object; - -#endif /* WORDS_BIGENDIAN */ +#define XLI(o) (o).i +static inline Lisp_Object +XIL (EMACS_INT i) +{ + Lisp_Object o = { i }; + return o; +} -#ifdef __GNUC__ static inline Lisp_Object LISP_MAKE_RVALUE (Lisp_Object o) { return o; } -#else -/* This is more portable to pre-C99 non-GCC compilers, but for - backwards compatibility GCC still accepts an old GNU extension - which caused this to only generate a warning. */ -#define LISP_MAKE_RVALUE(o) (0 ? (o) : (o)) -#endif -#else /* USE_LISP_UNION_TYPE */ +#define LISP_INITIALLY_ZERO {0} -/* If union type is not wanted, define Lisp_Object as just a number. */ +#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 XLI(o) (o) +#define XIL(i) (i) #define LISP_MAKE_RVALUE(o) (0+(o)) -#endif /* USE_LISP_UNION_TYPE */ +#define LISP_INITIALLY_ZERO 0 +#endif /* CHECK_LISP_OBJECT_TYPE */ /* In the size word of a vector, this bit means the vector has been marked. */ @@ -428,127 +380,55 @@ enum pvec_type For example, if tem is a Lisp_Object whose type is Lisp_Cons, XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ -#ifndef USE_LISP_UNION_TYPE - /* Return a perfect hash of the Lisp_Object representation. */ -#define XHASH(a) (a) +#define XHASH(a) XLI (a) -#ifdef USE_LSB_TAG +#if USE_LSB_TAG -#define TYPEMASK ((((EMACS_INT) 1) << GCTYPEBITS) - 1) -#define XTYPE(a) ((enum Lisp_Type) ((a) & TYPEMASK)) -#ifdef USE_2_TAGS_FOR_INTS -# define XINT(a) (((EMACS_INT) (a)) >> (GCTYPEBITS - 1)) -# define XUINT(a) (((EMACS_UINT) (a)) >> (GCTYPEBITS - 1)) -# define make_number(N) (((EMACS_INT) (N)) << (GCTYPEBITS - 1)) -#else -# define XINT(a) (((EMACS_INT) (a)) >> GCTYPEBITS) -# define XUINT(a) (((EMACS_UINT) (a)) >> GCTYPEBITS) -# define make_number(N) (((EMACS_INT) (N)) << GCTYPEBITS) -#endif -#define XSET(var, type, ptr) \ - (eassert (XTYPE ((intptr_t) (ptr)) == 0), /* Check alignment. */ \ - (var) = (type) | (intptr_t) (ptr)) +#define TYPEMASK ((1 << GCTYPEBITS) - 1) +#define XTYPE(a) ((enum Lisp_Type) (XLI (a) & TYPEMASK)) +#define XINT(a) (XLI (a) >> INTTYPEBITS) +#define XUINT(a) ((EMACS_UINT) XLI (a) >> INTTYPEBITS) +#define make_number(N) XIL ((EMACS_INT) (N) << INTTYPEBITS) +#define XSET(var, type, ptr) \ + (eassert (XTYPE (XIL ((intptr_t) (ptr))) == 0), /* Check alignment. */ \ + (var) = XIL ((type) | (intptr_t) (ptr))) -#define XPNTR(a) ((intptr_t) ((a) & ~TYPEMASK)) +#define XPNTR(a) ((intptr_t) (XLI (a) & ~TYPEMASK)) +#define XUNTAG(a, type) ((intptr_t) (XLI (a) - (type))) #else /* not USE_LSB_TAG */ -#define VALMASK ((((EMACS_INT) 1) << VALBITS) - 1) +#define VALMASK VAL_MAX -/* One need to override this if there must be high bits set in data space - (doing the result of the below & ((1 << (GCTYPE + 1)) - 1) would work - on all machines, but would penalize machines which don't need it) - */ -#define XTYPE(a) ((enum Lisp_Type) (((EMACS_UINT) (a)) >> VALBITS)) +#define XTYPE(a) ((enum Lisp_Type) ((EMACS_UINT) XLI (a) >> VALBITS)) /* For integers known to be positive, XFASTINT provides fast retrieval and XSETFASTINT provides fast storage. This takes advantage of the - fact that Lisp_Int is 0. */ -#define XFASTINT(a) ((a) + 0) -#define XSETFASTINT(a, b) ((a) = (b)) + fact that Lisp integers have zero-bits in their tags. */ +#define XFASTINT(a) (XLI (a) + 0) +#define XSETFASTINT(a, b) ((a) = XIL (b)) /* Extract the value of a Lisp_Object as a (un)signed integer. */ -#ifdef USE_2_TAGS_FOR_INTS -# define XINT(a) ((((EMACS_INT) (a)) << (GCTYPEBITS - 1)) >> (GCTYPEBITS - 1)) -# define XUINT(a) ((EMACS_UINT) ((a) & (1 + (VALMASK << 1)))) -# define make_number(N) ((((EMACS_INT) (N)) & (1 + (VALMASK << 1)))) -#else -# define XINT(a) ((((EMACS_INT) (a)) << (BITS_PER_EMACS_INT - VALBITS)) \ - >> (BITS_PER_EMACS_INT - VALBITS)) -# define XUINT(a) ((EMACS_UINT) ((a) & VALMASK)) -# define make_number(N) \ - ((((EMACS_INT) (N)) & VALMASK) | ((EMACS_INT) Lisp_Int) << VALBITS) -#endif +#define XINT(a) (XLI (a) << INTTYPEBITS >> INTTYPEBITS) +#define XUINT(a) ((EMACS_UINT) (XLI (a) & INTMASK)) +#define make_number(N) XIL ((EMACS_INT) (N) & INTMASK) -#define XSET(var, type, ptr) \ - ((var) = ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \ - + ((intptr_t) (ptr) & VALMASK))) +#define XSET(var, type, ptr) \ + ((var) = XIL ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \ + + ((intptr_t) (ptr) & VALMASK))) #ifdef DATA_SEG_BITS /* DATA_SEG_BITS forces extra bits to be or'd in with any pointers which were stored in a Lisp_Object */ -#define XPNTR(a) ((uintptr_t) (((a) & VALMASK)) | DATA_SEG_BITS)) +#define XPNTR(a) ((uintptr_t) ((XLI (a) & VALMASK)) | DATA_SEG_BITS)) #else -#define XPNTR(a) ((uintptr_t) ((a) & VALMASK)) +#define XPNTR(a) ((uintptr_t) (XLI (a) & VALMASK)) #endif #endif /* not USE_LSB_TAG */ -#else /* USE_LISP_UNION_TYPE */ - -#ifdef USE_2_TAGS_FOR_INTS -# error "USE_2_TAGS_FOR_INTS is not supported with USE_LISP_UNION_TYPE" -#endif - -#define XHASH(a) ((a).i) -#define XTYPE(a) ((enum Lisp_Type) (a).u.type) -#define XINT(a) ((EMACS_INT) (a).s.val) -#define XUINT(a) ((EMACS_UINT) (a).u.val) - -#ifdef USE_LSB_TAG - -# define XSET(var, vartype, ptr) \ - (eassert ((((uintptr_t) (ptr)) & ((1 << GCTYPEBITS) - 1)) == 0), \ - (var).u.val = ((uintptr_t) (ptr)) >> GCTYPEBITS, \ - (var).u.type = ((char) (vartype))) - -/* Some versions of gcc seem to consider the bitfield width when issuing - the "cast to pointer from integer of different size" warning, so the - cast is here to widen the value back to its natural size. */ -# define XPNTR(v) ((intptr_t) (v).s.val << GCTYPEBITS) - -#else /* !USE_LSB_TAG */ - -/* For integers known to be positive, XFASTINT provides fast retrieval - and XSETFASTINT provides fast storage. This takes advantage of the - fact that Lisp_Int is 0. */ -# define XFASTINT(a) ((a).i + 0) -# define XSETFASTINT(a, b) ((a).i = (b)) - -# define XSET(var, vartype, ptr) \ - (((var).s.val = ((intptr_t) (ptr))), ((var).s.type = ((char) (vartype)))) - -#ifdef DATA_SEG_BITS -/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers - which were stored in a Lisp_Object */ -#define XPNTR(a) ((intptr_t) (XUINT (a) | DATA_SEG_BITS)) -#else -#define XPNTR(a) ((intptr_t) XUINT (a)) -#endif - -#endif /* !USE_LSB_TAG */ - -#if __GNUC__ >= 2 && defined (__OPTIMIZE__) -#define make_number(N) \ - (__extension__ ({ Lisp_Object _l; _l.s.val = (N); _l.s.type = Lisp_Int; _l; })) -#else -extern Lisp_Object make_number (EMACS_INT); -#endif - -#endif /* USE_LISP_UNION_TYPE */ - /* For integers known to be positive, XFASTINT sometimes provides faster retrieval and XSETFASTINT provides faster storage. If not, fallback on the non-accelerated path. */ @@ -557,21 +437,18 @@ extern Lisp_Object make_number (EMACS_INT); # define XSETFASTINT(a, b) (XSETINT (a, b)) #endif -#define EQ(x, y) (XHASH (x) == XHASH (y)) - -/* Number of bits in a fixnum, including the sign bit. */ -#ifdef USE_2_TAGS_FOR_INTS -# define FIXNUM_BITS (VALBITS + 1) -#else -# define FIXNUM_BITS VALBITS +/* Extract the pointer value of the Lisp object A, under the + assumption that A's type is TYPE. This is a fallback + implementation if nothing faster is available. */ +#ifndef XUNTAG +# define XUNTAG(a, type) XPNTR (a) #endif -/* Mask indicating the significant bits of a fixnum. */ -#define INTMASK (((EMACS_INT) 1 << FIXNUM_BITS) - 1) +#define EQ(x, y) (XHASH (x) == XHASH (y)) /* Largest and smallest representable fixnum values. These are the C values. */ -#define MOST_POSITIVE_FIXNUM (INTMASK / 2) +#define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) /* Value is non-zero if I doesn't fit into a Lisp fixnum. It is @@ -589,15 +466,20 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) /* Extract a value or address from a Lisp_Object. */ -#define XCONS(a) (eassert (CONSP (a)), (struct Lisp_Cons *) XPNTR (a)) -#define XVECTOR(a) (eassert (VECTORLIKEP (a)), (struct Lisp_Vector *) XPNTR (a)) -#define XSTRING(a) (eassert (STRINGP (a)), (struct Lisp_String *) XPNTR (a)) -#define XSYMBOL(a) (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XPNTR (a)) -#define XFLOAT(a) (eassert (FLOATP (a)), (struct Lisp_Float *) XPNTR (a)) +#define XCONS(a) (eassert (CONSP (a)), \ + (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) +#define XVECTOR(a) (eassert (VECTORLIKEP (a)), \ + (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike)) +#define XSTRING(a) (eassert (STRINGP (a)), \ + (struct Lisp_String *) XUNTAG (a, Lisp_String)) +#define XSYMBOL(a) (eassert (SYMBOLP (a)), \ + (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) +#define XFLOAT(a) (eassert (FLOATP (a)), \ + (struct Lisp_Float *) XUNTAG (a, Lisp_Float)) /* Misc types. */ -#define XMISC(a) ((union Lisp_Misc *) XPNTR (a)) +#define XMISC(a) ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc)) #define XMISCANY(a) (eassert (MISCP (a)), &(XMISC (a)->u_any)) #define XMISCTYPE(a) (XMISCANY (a)->type) #define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker)) @@ -617,14 +499,24 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) /* Pseudovector types. */ -#define XPROCESS(a) (eassert (PROCESSP (a)), (struct Lisp_Process *) XPNTR (a)) -#define XWINDOW(a) (eassert (WINDOWP (a)), (struct window *) XPNTR (a)) -#define XTERMINAL(a) (eassert (TERMINALP (a)), (struct terminal *) XPNTR (a)) -#define XSUBR(a) (eassert (SUBRP (a)), (struct Lisp_Subr *) XPNTR (a)) -#define XBUFFER(a) (eassert (BUFFERP (a)), (struct buffer *) XPNTR (a)) -#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), (struct Lisp_Char_Table *) XPNTR (a)) -#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), (struct Lisp_Sub_Char_Table *) XPNTR (a)) -#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), (struct Lisp_Bool_Vector *) XPNTR (a)) +#define XPROCESS(a) (eassert (PROCESSP (a)), \ + (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike)) +#define XWINDOW(a) (eassert (WINDOWP (a)), \ + (struct window *) XUNTAG (a, Lisp_Vectorlike)) +#define XTERMINAL(a) (eassert (TERMINALP (a)), \ + (struct terminal *) XUNTAG (a, Lisp_Vectorlike)) +#define XSUBR(a) (eassert (SUBRP (a)), \ + (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike)) +#define XBUFFER(a) (eassert (BUFFERP (a)), \ + (struct buffer *) XUNTAG (a, Lisp_Vectorlike)) +#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \ + (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike)) +#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \ + ((struct Lisp_Sub_Char_Table *) \ + XUNTAG (a, Lisp_Vectorlike))) +#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \ + ((struct Lisp_Bool_Vector *) \ + XUNTAG (a, Lisp_Vectorlike))) /* Construct a Lisp_Object from a value or address. */ @@ -651,7 +543,9 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) /* The cast to struct vectorlike_header * avoids aliasing issues. */ #define XSETPSEUDOVECTOR(a, b, code) \ XSETTYPED_PSEUDOVECTOR(a, b, \ - ((struct vectorlike_header *) XPNTR (a))->size, \ + (((struct vectorlike_header *) \ + XUNTAG (a, Lisp_Vectorlike)) \ + ->size), \ code) #define XSETTYPED_PSEUDOVECTOR(a, b, size, code) \ (XSETVECTOR (a, b), \ @@ -857,11 +751,15 @@ struct vectorlike_header { ptrdiff_t size; - /* Pointer to the next vector-like object. It is generally a buffer or a + /* When the vector is allocated from a vector block, NBYTES is used + if the vector is not on a free list, and VECTOR is used otherwise. + For large vector-like objects, BUFFER or VECTOR is used as a pointer + to the next vector-like object. It is generally a buffer or a Lisp_Vector alias, so for convenience it is a union instead of a pointer: this way, one can write P->next.vector instead of ((struct Lisp_Vector *) P->next). */ union { + ptrdiff_t nbytes; struct buffer *buffer; struct Lisp_Vector *vector; } next; @@ -936,7 +834,7 @@ struct Lisp_Vector /* Compute A OP B, using the unsigned comparison operator OP. A and B should be integer expressions. This is not the same as - mathemeatical comparison; for example, UNSIGNED_CMP (0, <, -1) + mathematical comparison; for example, UNSIGNED_CMP (0, <, -1) returns 1. For efficiency, prefer plain unsigned comparison if A and B's sizes both fit (after integer promotion). */ #define UNSIGNED_CMP(a, op, b) \ @@ -1089,11 +987,9 @@ enum symbol_redirect SYMBOL_PLAINVAL = 4, SYMBOL_VARALIAS = 1, SYMBOL_LOCALIZED = 2, - SYMBOL_FORWARDED = 3 + SYMBOL_FORWARDED = 3 }; -/* In a symbol, the markbit of the plist is used as the gc mark bit */ - struct Lisp_Symbol { unsigned gcmarkbit : 1; @@ -1102,9 +998,8 @@ struct Lisp_Symbol 0 : it's a plain var, the value is in the `value' field. 1 : it's a varalias, the value is really in the `alias' symbol. 2 : it's a localized var, the value is in the `blv' object. - 3 : it's a forwarding variable, the value is in `forward'. - */ - enum symbol_redirect redirect : 3; + 3 : it's a forwarding variable, the value is in `forward'. */ + ENUM_BF (symbol_redirect) redirect : 3; /* Non-zero means symbol is constant, i.e. changing its value should signal an error. If the value is 3, then the var @@ -1120,15 +1015,12 @@ struct Lisp_Symbol unsigned declared_special : 1; /* The symbol's name, as a Lisp string. - The name "xname" is used to intentionally break code referring to the old field "name" of type pointer to struct Lisp_String. */ Lisp_Object xname; - /* Value of the symbol or Qunbound if unbound. If this symbol is a - defvaralias, `alias' contains the symbol for which it is an - alias. Use the SYMBOL_VALUE and SET_SYMBOL_VALUE macros to get - and set a symbol's value, to take defvaralias into account. */ + /* Value of the symbol or Qunbound if unbound. Which alternative of the + union is used depends on the `redirect' field above. */ union { Lisp_Object value; struct Lisp_Symbol *alias; @@ -1265,7 +1157,7 @@ struct Lisp_Hash_Table #define XHASH_TABLE(OBJ) \ - ((struct Lisp_Hash_Table *) XPNTR (OBJ)) + ((struct Lisp_Hash_Table *) XUNTAG (OBJ, Lisp_Vectorlike)) #define XSET_HASH_TABLE(VAR, PTR) \ (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE)) @@ -1320,16 +1212,14 @@ struct Lisp_Hash_Table struct Lisp_Misc_Any /* Supertype of all Misc types. */ { - enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_??? */ + ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_??? */ unsigned gcmarkbit : 1; int spacer : 15; - /* Make it as long as "Lisp_Free without padding". */ - void *fill; }; struct Lisp_Marker { - enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Marker */ + ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Marker */ unsigned gcmarkbit : 1; int spacer : 13; /* This flag is temporarily used in the functions @@ -1479,7 +1369,7 @@ struct Lisp_Overlay I.e. 9words plus 2 bits, 3words of which are for external linked lists. */ { - enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Overlay */ + ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Overlay */ unsigned gcmarkbit : 1; int spacer : 15; struct Lisp_Overlay *next; @@ -1498,7 +1388,7 @@ struct Lisp_Kboard_Objfwd This type of object is used in the arg to record_unwind_protect. */ struct Lisp_Save_Value { - enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Save_Value */ + ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */ unsigned gcmarkbit : 1; int spacer : 14; /* If DOGC is set, POINTER is the address of a memory @@ -1512,17 +1402,10 @@ struct Lisp_Save_Value /* A miscellaneous object, when it's on the free list. */ struct Lisp_Free { - enum Lisp_Misc_Type type : 16; /* = Lisp_Misc_Free */ + ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Free */ unsigned gcmarkbit : 1; int spacer : 15; union Lisp_Misc *chain; -#ifdef USE_LSB_TAG - /* Try to make sure that sizeof(Lisp_Misc) preserves TYPEBITS-alignment. - This assumes that Lisp_Marker is the largest of the alternatives and - that Lisp_Misc_Any has the same size as "Lisp_Free w/o padding". */ - char padding[((((sizeof (struct Lisp_Marker) - 1) >> GCTYPEBITS) + 1) - << GCTYPEBITS) - sizeof (struct Lisp_Misc_Any)]; -#endif }; /* To get the type field of a union Lisp_Misc, use XMISCTYPE. @@ -1531,19 +1414,19 @@ struct Lisp_Free union Lisp_Misc { struct Lisp_Misc_Any u_any; /* Supertype of all Misc types. */ - struct Lisp_Free u_free; /* Includes padding to force alignment. */ - struct Lisp_Marker u_marker; /* 5 */ - struct Lisp_Overlay u_overlay; /* 5 */ - struct Lisp_Save_Value u_save_value; /* 3 */ + struct Lisp_Free u_free; + struct Lisp_Marker u_marker; + struct Lisp_Overlay u_overlay; + struct Lisp_Save_Value u_save_value; }; union Lisp_Fwd { - struct Lisp_Intfwd u_intfwd; /* 2 */ - struct Lisp_Boolfwd u_boolfwd; /* 2 */ - struct Lisp_Objfwd u_objfwd; /* 2 */ - struct Lisp_Buffer_Objfwd u_buffer_objfwd; /* 2 */ - struct Lisp_Kboard_Objfwd u_kboard_objfwd; /* 2 */ + struct Lisp_Intfwd u_intfwd; + struct Lisp_Boolfwd u_boolfwd; + struct Lisp_Objfwd u_objfwd; + struct Lisp_Buffer_Objfwd u_buffer_objfwd; + struct Lisp_Kboard_Objfwd u_kboard_objfwd; }; /* Lisp floating point type */ @@ -1740,7 +1623,7 @@ typedef struct { code is CODE. */ #define TYPED_PSEUDOVECTORP(x, t, code) \ (VECTORLIKEP (x) \ - && (((((struct t *) XPNTR (x))->size \ + && (((((struct t *) XUNTAG (x, Lisp_Vectorlike))->size \ & (PSEUDOVECTOR_FLAG | (code)))) \ == (PSEUDOVECTOR_FLAG | (code)))) @@ -1903,9 +1786,6 @@ typedef struct { CHECK_NATNUM (tmp); \ XSETCDR ((x), tmp); \ } while (0) - -/* Cast pointers to this type to compare them. */ -#define PNTR_COMPARISON_TYPE uintptr_t /* Define a built-in function for calling from Lisp. `lname' should be the name to give the function in Lisp, @@ -1934,13 +1814,23 @@ typedef struct { /* This version of DEFUN declares a function prototype with the right arguments, so we can catch errors with maxargs at compile-time. */ -#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ - Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ - static DECL_ALIGN (struct Lisp_Subr, sname) = \ - { PVEC_SUBR, \ - { .a ## maxargs = fnname }, \ - minargs, maxargs, lname, intspec, 0}; \ - Lisp_Object fnname +#ifdef _MSC_VER +#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ + Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ + static DECL_ALIGN (struct Lisp_Subr, sname) = \ + { PVEC_SUBR | (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) \ + Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ + static DECL_ALIGN (struct Lisp_Subr, sname) = \ + { PVEC_SUBR, \ + { .a ## maxargs = fnname }, \ + minargs, maxargs, lname, intspec, 0}; \ + Lisp_Object fnname +#endif /* Note that the weird token-substitution semantics of ANSI C makes this work for MANY and UNEVALLED. */ @@ -2142,7 +2032,10 @@ extern char *stack_bottom; Exception: if you set immediate_quit to nonzero, then the handler that responds to the C-g does the quit itself. This is a good thing to do around a loop that has no side effects - and (in particular) cannot call arbitrary Lisp code. */ + and (in particular) cannot call arbitrary Lisp code. + + If quit-flag is set to `kill-emacs' the SIGINT handler has received + a request to exit Emacs when it is safe to do. */ #ifdef SYNC_INPUT extern void process_pending_signals (void); @@ -2154,16 +2047,11 @@ extern int pending_signals; #define ELSE_PENDING_SIGNALS #endif /* not SYNC_INPUT */ +extern void process_quit_flag (void); #define QUIT \ do { \ if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \ - { \ - Lisp_Object flag = Vquit_flag; \ - Vquit_flag = Qnil; \ - if (EQ (Vthrow_on_input, flag)) \ - Fthrow (Vthrow_on_input, Qt); \ - Fsignal (Qquit, Qnil); \ - } \ + process_quit_flag (); \ ELSE_PENDING_SIGNALS \ } while (0) @@ -2229,7 +2117,7 @@ struct gcpro #define GC_USE_GCPROS_CHECK_ZOMBIES 3 #ifndef GC_MARK_STACK -#define GC_MARK_STACK GC_USE_GCPROS_AS_BEFORE +#define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS #endif /* Whether we do the stack marking manually. */ @@ -2237,143 +2125,127 @@ struct gcpro || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS) -#define GCPRO1(var) \ - GCPRO1_VAR (var, gcpro) -#define GCPRO2(var1, var2) \ - GCPRO2_VAR (var1, var2, gcpro) -#define GCPRO3(var1, var2, var3) \ - GCPRO3_VAR (var1, var2, var3, gcpro) -#define GCPRO4(var1, var2, var3, var4) \ - GCPRO4_VAR (var1, var2, var3, var4, gcpro) -#define GCPRO5(var1, var2, var3, var4, var5) \ - GCPRO5_VAR (var1, var2, var3, var4, var5, gcpro) -#define GCPRO6(var1, var2, var3, var4, var5, var6) \ - GCPRO6_VAR (var1, var2, var3, var4, var5, var6, gcpro) -#define UNGCPRO UNGCPRO_VAR (gcpro) - #if GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS /* Do something silly with gcproN vars just so gcc shuts up. */ /* You get warnings from MIPSPro... */ -#define GCPRO1_VAR(var, gcpro) ((void) gcpro##1) -#define GCPRO2_VAR(var1, var2, gcpro) \ - ((void) gcpro##2, (void) gcpro##1) -#define GCPRO3_VAR(var1, var2, var3, gcpro) \ - ((void) gcpro##3, (void) gcpro##2, (void) gcpro##1) -#define GCPRO4_VAR(var1, var2, var3, var4, gcpro) \ - ((void) gcpro##4, (void) gcpro##3, (void) gcpro##2, (void) gcpro##1) -#define GCPRO5_VAR(var1, var2, var3, var4, var5, gcpro) \ - ((void) gcpro##5, (void) gcpro##4, (void) gcpro##3, (void) gcpro##2, \ - (void) gcpro##1) -#define GCPRO6_VAR(var1, var2, var3, var4, var5, var6, gcpro) \ - ((void) gcpro##6, (void) gcpro##5, (void) gcpro##4, (void) gcpro##3, \ - (void) gcpro##2, (void) gcpro##1) -#define UNGCPRO_VAR(gcpro) ((void) 0) +#define GCPRO1(varname) ((void) gcpro1) +#define GCPRO2(varname1, varname2) ((void) gcpro2, (void) gcpro1) +#define GCPRO3(varname1, varname2, varname3) \ + ((void) gcpro3, (void) gcpro2, (void) gcpro1) +#define GCPRO4(varname1, varname2, varname3, varname4) \ + ((void) gcpro4, (void) gcpro3, (void) gcpro2, (void) gcpro1) +#define GCPRO5(varname1, varname2, varname3, varname4, varname5) \ + ((void) gcpro5, (void) gcpro4, (void) gcpro3, (void) gcpro2, (void) gcpro1) +#define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \ + ((void) gcpro6, (void) gcpro5, (void) gcpro4, (void) gcpro3, (void) gcpro2, \ + (void) gcpro1) +#define UNGCPRO ((void) 0) #else /* GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS */ #ifndef DEBUG_GCPRO -#define GCPRO1_VAR(var, gcpro) \ - {gcpro##1.next = gcprolist; gcpro##1.var = &var; gcpro##1.nvars = 1; \ - gcprolist = &gcpro##1; } - -#define GCPRO2_VAR(var1, var2, gcpro) \ - {gcpro##1.next = gcprolist; gcpro##1.var = &var1; gcpro##1.nvars = 1; \ - gcpro##2.next = &gcpro##1; gcpro##2.var = &var2; gcpro##2.nvars = 1; \ - gcprolist = &gcpro##2; } - -#define GCPRO3_VAR(var1, var2, var3, gcpro) \ - {gcpro##1.next = gcprolist; gcpro##1.var = &var1; gcpro##1.nvars = 1; \ - gcpro##2.next = &gcpro##1; gcpro##2.var = &var2; gcpro##2.nvars = 1; \ - gcpro##3.next = &gcpro##2; gcpro##3.var = &var3; gcpro##3.nvars = 1; \ - gcprolist = &gcpro##3; } - -#define GCPRO4_VAR(var1, var2, var3, var4, gcpro) \ - {gcpro##1.next = gcprolist; gcpro##1.var = &var1; gcpro##1.nvars = 1; \ - gcpro##2.next = &gcpro##1; gcpro##2.var = &var2; gcpro##2.nvars = 1; \ - gcpro##3.next = &gcpro##2; gcpro##3.var = &var3; gcpro##3.nvars = 1; \ - gcpro##4.next = &gcpro##3; gcpro##4.var = &var4; gcpro##4.nvars = 1; \ - gcprolist = &gcpro##4; } - -#define GCPRO5_VAR(var1, var2, var3, var4, var5, gcpro) \ - {gcpro##1.next = gcprolist; gcpro##1.var = &var1; gcpro##1.nvars = 1; \ - gcpro##2.next = &gcpro##1; gcpro##2.var = &var2; gcpro##2.nvars = 1; \ - gcpro##3.next = &gcpro##2; gcpro##3.var = &var3; gcpro##3.nvars = 1; \ - gcpro##4.next = &gcpro##3; gcpro##4.var = &var4; gcpro##4.nvars = 1; \ - gcpro##5.next = &gcpro##4; gcpro##5.var = &var5; gcpro##5.nvars = 1; \ - gcprolist = &gcpro##5; } - -#define GCPRO6_VAR(var1, var2, var3, var4, var5, var6, gcpro) \ - {gcpro##1.next = gcprolist; gcpro##1.var = &var1; gcpro##1.nvars = 1; \ - gcpro##2.next = &gcpro##1; gcpro##2.var = &var2; gcpro##2.nvars = 1; \ - gcpro##3.next = &gcpro##2; gcpro##3.var = &var3; gcpro##3.nvars = 1; \ - gcpro##4.next = &gcpro##3; gcpro##4.var = &var4; gcpro##4.nvars = 1; \ - gcpro##5.next = &gcpro##4; gcpro##5.var = &var5; gcpro##5.nvars = 1; \ - gcpro##6.next = &gcpro##5; gcpro##6.var = &var6; gcpro##6.nvars = 1; \ - gcprolist = &gcpro##6; } - -#define UNGCPRO_VAR(gcpro) (gcprolist = gcpro##1.next) +#define GCPRO1(varname) \ + {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \ + gcprolist = &gcpro1; } + +#define GCPRO2(varname1, varname2) \ + {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ + gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ + gcprolist = &gcpro2; } + +#define GCPRO3(varname1, varname2, varname3) \ + {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ + gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ + gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ + gcprolist = &gcpro3; } + +#define GCPRO4(varname1, varname2, varname3, varname4) \ + {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ + gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ + gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ + gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \ + gcprolist = &gcpro4; } + +#define GCPRO5(varname1, varname2, varname3, varname4, varname5) \ + {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ + gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ + gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ + gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \ + gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \ + gcprolist = &gcpro5; } + +#define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \ + {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ + gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ + gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ + gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \ + gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \ + gcpro6.next = &gcpro5; gcpro6.var = &varname6; gcpro6.nvars = 1; \ + gcprolist = &gcpro6; } + +#define UNGCPRO (gcprolist = gcpro1.next) #else extern int gcpro_level; -#define GCPRO1_VAR(var, gcpro) \ - {gcpro##1.next = gcprolist; gcpro##1.var = &var; gcpro##1.nvars = 1; \ - gcpro##1.level = gcpro_level++; \ - gcprolist = &gcpro##1; } - -#define GCPRO2_VAR(var1, var2, gcpro) \ - {gcpro##1.next = gcprolist; gcpro##1.var = &var1; gcpro##1.nvars = 1; \ - gcpro##1.level = gcpro_level; \ - gcpro##2.next = &gcpro##1; gcpro##2.var = &var2; gcpro##2.nvars = 1; \ - gcpro##2.level = gcpro_level++; \ - gcprolist = &gcpro##2; } - -#define GCPRO3_VAR(var1, var2, var3, gcpro) \ - {gcpro##1.next = gcprolist; gcpro##1.var = &var1; gcpro##1.nvars = 1; \ - gcpro##1.level = gcpro_level; \ - gcpro##2.next = &gcpro##1; gcpro##2.var = &var2; gcpro##2.nvars = 1; \ - gcpro##3.next = &gcpro##2; gcpro##3.var = &var3; gcpro##3.nvars = 1; \ - gcpro##3.level = gcpro_level++; \ - gcprolist = &gcpro##3; } - -#define GCPRO4_VAR(var1, var2, var3, var4, gcpro) \ - {gcpro##1.next = gcprolist; gcpro##1.var = &var1; gcpro##1.nvars = 1; \ - gcpro##1.level = gcpro_level; \ - gcpro##2.next = &gcpro##1; gcpro##2.var = &var2; gcpro##2.nvars = 1; \ - gcpro##3.next = &gcpro##2; gcpro##3.var = &var3; gcpro##3.nvars = 1; \ - gcpro##4.next = &gcpro##3; gcpro##4.var = &var4; gcpro##4.nvars = 1; \ - gcpro##4.level = gcpro_level++; \ - gcprolist = &gcpro##4; } - -#define GCPRO5_VAR(var1, var2, var3, var4, var5, gcpro) \ - {gcpro##1.next = gcprolist; gcpro##1.var = &var1; gcpro##1.nvars = 1; \ - gcpro##1.level = gcpro_level; \ - gcpro##2.next = &gcpro##1; gcpro##2.var = &var2; gcpro##2.nvars = 1; \ - gcpro##3.next = &gcpro##2; gcpro##3.var = &var3; gcpro##3.nvars = 1; \ - gcpro##4.next = &gcpro##3; gcpro##4.var = &var4; gcpro##4.nvars = 1; \ - gcpro##5.next = &gcpro##4; gcpro##5.var = &var5; gcpro##5.nvars = 1; \ - gcpro##5.level = gcpro_level++; \ - gcprolist = &gcpro##5; } - -#define GCPRO6_VAR(var1, var2, var3, var4, var5, var6, gcpro) \ - {gcpro##1.next = gcprolist; gcpro##1.var = &var1; gcpro##1.nvars = 1; \ - gcpro##1.level = gcpro_level; \ - gcpro##2.next = &gcpro##1; gcpro##2.var = &var2; gcpro##2.nvars = 1; \ - gcpro##3.next = &gcpro##2; gcpro##3.var = &var3; gcpro##3.nvars = 1; \ - gcpro##4.next = &gcpro##3; gcpro##4.var = &var4; gcpro##4.nvars = 1; \ - gcpro##5.next = &gcpro##4; gcpro##5.var = &var5; gcpro##5.nvars = 1; \ - gcpro##6.next = &gcpro##5; gcpro##6.var = &var6; gcpro##6.nvars = 1; \ - gcpro##6.level = gcpro_level++; \ - gcprolist = &gcpro##6; } - -#define UNGCPRO_VAR(gcpro) \ - ((--gcpro_level != gcpro##1.level) \ - ? (abort (), 0) \ - : ((gcprolist = gcpro##1.next), 0)) +#define GCPRO1(varname) \ + {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \ + gcpro1.level = gcpro_level++; \ + gcprolist = &gcpro1; } + +#define GCPRO2(varname1, varname2) \ + {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ + gcpro1.level = gcpro_level; \ + gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ + gcpro2.level = gcpro_level++; \ + gcprolist = &gcpro2; } + +#define GCPRO3(varname1, varname2, varname3) \ + {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ + gcpro1.level = gcpro_level; \ + gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ + gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ + gcpro3.level = gcpro_level++; \ + gcprolist = &gcpro3; } + +#define GCPRO4(varname1, varname2, varname3, varname4) \ + {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ + gcpro1.level = gcpro_level; \ + gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ + gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ + gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \ + gcpro4.level = gcpro_level++; \ + gcprolist = &gcpro4; } + +#define GCPRO5(varname1, varname2, varname3, varname4, varname5) \ + {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ + gcpro1.level = gcpro_level; \ + gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ + gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ + gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \ + gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \ + gcpro5.level = gcpro_level++; \ + gcprolist = &gcpro5; } + +#define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \ + {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ + gcpro1.level = gcpro_level; \ + gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ + gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ + gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \ + gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \ + gcpro6.next = &gcpro5; gcpro6.var = &varname6; gcpro6.nvars = 1; \ + gcpro6.level = gcpro_level++; \ + gcprolist = &gcpro6; } + +#define UNGCPRO \ + ((--gcpro_level != gcpro1.level) \ + ? (abort (), 0) \ + : ((gcprolist = gcpro1.next), 0)) #endif /* DEBUG_GCPRO */ #endif /* GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS */ @@ -2412,7 +2284,7 @@ extern Lisp_Object Qerror, Qquit, Qargs_out_of_range; extern Lisp_Object Qvoid_variable, Qvoid_function; extern Lisp_Object Qinvalid_read_syntax; extern Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch; -extern Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive; +extern Lisp_Object Quser_error, Qend_of_file, Qarith_error, Qmark_inactive; extern Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; extern Lisp_Object Qtext_read_only; extern Lisp_Object Qinteractive_form; @@ -2516,10 +2388,10 @@ extern intmax_t cons_to_signed (Lisp_Object, intmax_t, intmax_t); extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t); extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *); -extern void args_out_of_range (Lisp_Object, Lisp_Object) NO_RETURN; -extern void args_out_of_range_3 (Lisp_Object, Lisp_Object, - Lisp_Object) NO_RETURN; -extern Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object) NO_RETURN; +extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object); +extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object, + Lisp_Object); +extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, int); extern void syms_of_data (void); @@ -2682,7 +2554,7 @@ extern void init_image (void); extern Lisp_Object Qinhibit_modification_hooks; extern void move_gap (ptrdiff_t); extern void move_gap_both (ptrdiff_t, ptrdiff_t); -extern void buffer_overflow (void) NO_RETURN; +extern _Noreturn void buffer_overflow (void); extern void make_gap (ptrdiff_t); extern ptrdiff_t copy_text (const unsigned char *, unsigned char *, ptrdiff_t, int, int); @@ -2725,6 +2597,10 @@ 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__)) +_Noreturn void __executable_start (void); +#endif extern Lisp_Object selected_frame; extern Lisp_Object Vwindow_system; EXFUN (Fding, 1); @@ -2791,7 +2667,7 @@ extern int pos_visible_p (struct window *, ptrdiff_t, int *, extern void syms_of_xsettings (void); /* Defined in vm-limit.c. */ -extern void memory_warnings (POINTER_TYPE *, void (*warnfun) (const char *)); +extern void memory_warnings (void *, void (*warnfun) (const char *)); /* Defined in alloc.c */ extern void check_pure_size (void); @@ -2799,8 +2675,8 @@ extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT); extern void reset_malloc_hooks (void); extern void uninterrupt_malloc (void); extern void malloc_warning (const char *); -extern void memory_full (size_t) NO_RETURN; -extern void buffer_memory_full (ptrdiff_t) NO_RETURN; +extern _Noreturn void memory_full (size_t); +extern _Noreturn void buffer_memory_full (ptrdiff_t); extern int survives_gc_p (Lisp_Object); extern void mark_object (Lisp_Object); #if defined REL_ALLOC && !defined SYSTEM_MALLOC @@ -2822,7 +2698,7 @@ EXFUN (Fmake_vector, 2); EXFUN (Fvector, MANY); EXFUN (Fmake_symbol, 1); EXFUN (Fmake_marker, 0); -extern void string_overflow (void) NO_RETURN; +extern _Noreturn void string_overflow (void); EXFUN (Fmake_string, 2); extern Lisp_Object build_string (const char *); extern Lisp_Object make_string (const char *, ptrdiff_t); @@ -2838,8 +2714,8 @@ EXFUN (Fpurecopy, 1); extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, int); extern Lisp_Object make_pure_c_string (const char *data); extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); -extern Lisp_Object make_pure_vector (ptrdiff_t); EXFUN (Fgarbage_collect, 0); +extern void make_byte_code (struct Lisp_Vector *); EXFUN (Fmake_byte_code, MANY); EXFUN (Fmake_bool_vector, 2); extern Lisp_Object Qchar_table_extra_slots; @@ -2868,6 +2744,15 @@ extern void syms_of_alloc (void); extern struct buffer * allocate_buffer (void); extern int valid_lisp_object_p (Lisp_Object); +#ifdef REL_ALLOC +/* Defined in ralloc.c */ +extern void *r_alloc (void **, size_t); +extern void r_alloc_free (void **); +extern void *r_re_alloc (void **, size_t); +extern void r_alloc_reset_variable (void **, void **); +extern void r_alloc_inhibit_buffer_relocation (int); +#endif + /* Defined in chartab.c */ EXFUN (Fmake_char_table, 2); EXFUN (Fset_char_table_parent, 2); @@ -2912,7 +2797,7 @@ extern void print_error_message (Lisp_Object, Lisp_Object, const char *, extern Lisp_Object internal_with_output_to_temp_buffer (const char *, Lisp_Object (*) (Lisp_Object), Lisp_Object); #define FLOAT_TO_STRING_BUFSIZE 350 -extern void float_to_string (char *, double); +extern int float_to_string (char *, double); extern void syms_of_print (void); /* Defined in doprnt.c */ @@ -2959,11 +2844,12 @@ extern void init_lread (void); extern void syms_of_lread (void); /* Defined in eval.c. */ -extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro; +extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qmacro; extern Lisp_Object Qinhibit_quit, Qclosure; extern Lisp_Object Qand_rest; extern Lisp_Object Vautoload_queue; extern Lisp_Object Vsignaling_function; +extern Lisp_Object inhibit_lisp_code; extern int handling_signal; #if BYTE_MARK_STACK extern struct catchtag *catchlist; @@ -2986,14 +2872,15 @@ extern Lisp_Object run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args, (ptrdiff_t nargs, Lisp_Object *args)); EXFUN (Fprogn, UNEVALLED); EXFUN (Finteractive_p, 0); -EXFUN (Fthrow, 2) NO_RETURN; +_Noreturn EXFUN (Fthrow, 2); EXFUN (Fsignal, 2); -extern void xsignal (Lisp_Object, Lisp_Object) NO_RETURN; -extern void xsignal0 (Lisp_Object) NO_RETURN; -extern void xsignal1 (Lisp_Object, Lisp_Object) NO_RETURN; -extern void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object) NO_RETURN; -extern void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) NO_RETURN; -extern void signal_error (const char *, Lisp_Object) NO_RETURN; +extern _Noreturn void xsignal (Lisp_Object, Lisp_Object); +extern _Noreturn void xsignal0 (Lisp_Object); +extern _Noreturn void xsignal1 (Lisp_Object, Lisp_Object); +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); EXFUN (Fcommandp, 2); EXFUN (Ffunctionp, 1); EXFUN (Feval, 2); @@ -3019,9 +2906,9 @@ extern Lisp_Object internal_condition_case_n (Lisp_Object (*) (ptrdiff_t, Lisp_O extern void specbind (Lisp_Object, Lisp_Object); extern void record_unwind_protect (Lisp_Object (*) (Lisp_Object), Lisp_Object); extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object); -extern void error (const char *, ...) NO_RETURN ATTRIBUTE_FORMAT_PRINTF (1, 2); -extern void verror (const char *, va_list) - NO_RETURN ATTRIBUTE_FORMAT_PRINTF (1, 0); +extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2); +extern _Noreturn void verror (const char *, va_list) + ATTRIBUTE_FORMAT_PRINTF (1, 0); extern void do_autoload (Lisp_Object, Lisp_Object); extern Lisp_Object un_autoload (Lisp_Object); extern void init_eval_once (void); @@ -3068,6 +2955,7 @@ EXFUN (Fnarrow_to_region, 2); EXFUN (Fwiden, 0); EXFUN (Fuser_login_name, 1); EXFUN (Fsystem_name, 0); +extern _Noreturn void time_overflow (void); EXFUN (Fcurrent_time, 0); EXFUN (Fget_internal_run_time, 0); extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, int); @@ -3082,7 +2970,7 @@ extern void set_time_zone_rule (const char *); /* Defined in buffer.c */ extern int mouse_face_overlay_overlaps (Lisp_Object); -extern void nsberror (Lisp_Object) NO_RETURN; +extern _Noreturn void nsberror (Lisp_Object); EXFUN (Fset_buffer_multibyte, 1); EXFUN (Foverlay_start, 1); EXFUN (Foverlay_end, 1); @@ -3165,16 +3053,12 @@ EXFUN (Ffile_readable_p, 1); EXFUN (Fread_file_name, 6); extern Lisp_Object close_file_unwind (Lisp_Object); extern Lisp_Object restore_point_unwind (Lisp_Object); -extern void report_file_error (const char *, Lisp_Object) NO_RETURN; +extern _Noreturn void report_file_error (const char *, Lisp_Object); extern int internal_delete_file (Lisp_Object); extern void syms_of_fileio (void); extern Lisp_Object make_temp_name (Lisp_Object, int); extern Lisp_Object Qdelete_file; -/* Defined in abbrev.c */ - -extern void syms_of_abbrev (void); - /* Defined in search.c */ extern void shrink_regexp_cache (void); EXFUN (Fstring_match, 3); @@ -3257,7 +3141,7 @@ extern Lisp_Object Qtop; extern int input_pending; EXFUN (Fdiscard_input, 0); EXFUN (Frecursive_edit, 0); -EXFUN (Ftop_level, 0) NO_RETURN; +_Noreturn EXFUN (Ftop_level, 0); extern Lisp_Object menu_bar_items (Lisp_Object); extern Lisp_Object tool_bar_items (Lisp_Object, int *); extern void discard_mouse_events (void); @@ -3325,7 +3209,8 @@ extern Lisp_Object Qfile_name_handler_alist; #ifdef FLOAT_CATCH_SIGILL extern void fatal_error_signal (int); #endif -EXFUN (Fkill_emacs, 1) NO_RETURN; +extern Lisp_Object Qkill_emacs; +_Noreturn EXFUN (Fkill_emacs, 1); #if HAVE_SETLOCALE void fixup_locale (void); void synchronize_system_messages_locale (void); @@ -3361,10 +3246,18 @@ EXFUN (Fkill_process, 2); EXFUN (Fwaiting_for_user_input_p, 0); extern Lisp_Object Qprocessp; extern void kill_buffer_processes (Lisp_Object); -extern int wait_reading_process_output (int, int, int, int, +extern int wait_reading_process_output (intmax_t, int, int, int, Lisp_Object, struct Lisp_Process *, int); +/* Max value for the first argument of wait_reading_process_output. */ +#if __GNUC__ == 3 || (__GNUC__ == 4 && __GNUC_MINOR__ <= 5) +/* Work around a bug in GCC 3.4.2, known to be fixed in GCC 4.6.3. + The bug merely causes a bogus warning, but the warning is annoying. */ +# define WAIT_READING_MAX min (TYPE_MAXIMUM (time_t), INTMAX_MAX) +#else +# define WAIT_READING_MAX INTMAX_MAX +#endif extern void add_keyboard_wait_descriptor (int); extern void delete_keyboard_wait_descriptor (int); #ifdef HAVE_GPM @@ -3377,11 +3270,10 @@ extern void syms_of_process (void); extern void setup_process_coding_systems (Lisp_Object); EXFUN (Fcall_process, MANY); -extern int child_setup (int, int, int, char **, int, Lisp_Object) #ifndef DOS_NT - NO_RETURN + _Noreturn #endif - ; +extern int child_setup (int, int, int, char **, int, Lisp_Object); extern void init_callproc_1 (void); extern void init_callproc (void); extern void set_initial_environment (void); @@ -3514,8 +3406,8 @@ extern Lisp_Object directory_files_internal (Lisp_Object, Lisp_Object, extern int *char_ins_del_vector; extern void mark_ttys (void); extern void syms_of_term (void); -extern void fatal (const char *msgid, ...) - NO_RETURN ATTRIBUTE_FORMAT_PRINTF (1, 2); +extern _Noreturn void fatal (const char *msgid, ...) + ATTRIBUTE_FORMAT_PRINTF (1, 2); /* Defined in terminal.c */ EXFUN (Fframe_terminal, 1); @@ -3577,6 +3469,7 @@ EXFUN (Fmsdos_downcase_filename, 1); #ifdef HAVE_LIBXML2 /* Defined in xml.c */ extern void syms_of_xml (void); +extern void xml_cleanup_parser (void); #endif #ifdef HAVE_MENUS @@ -3600,9 +3493,9 @@ extern int initialized; extern int immediate_quit; /* Nonzero means ^G can quit instantly */ -extern POINTER_TYPE *xmalloc (size_t); -extern POINTER_TYPE *xrealloc (POINTER_TYPE *, size_t); -extern void xfree (POINTER_TYPE *); +extern void *xmalloc (size_t); +extern void *xrealloc (void *, size_t); +extern void xfree (void *); extern void *xnmalloc (ptrdiff_t, ptrdiff_t); extern void *xnrealloc (void *, ptrdiff_t, ptrdiff_t); extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t); @@ -3635,7 +3528,7 @@ extern void init_system_name (void); #define SWITCH_ENUM_CAST(x) (x) -/* Use this to suppress gcc's warnings. */ +/* Use this to suppress gcc's warnings. */ #ifdef lint /* Use CODE only if lint checking is in effect. */