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.
/* 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 */
\f
-/* 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
variable VAR of type TYPE with the added requirement that it be
TYPEBITS-aligned. */
-#ifndef GCTYPEBITS
#define GCTYPEBITS 3
-#endif
-
-#ifndef VALBITS
#define VALBITS (BITS_PER_EMACS_INT - GCTYPEBITS)
-#endif
+
+/* 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
# 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
-/* On hosts where VALBITS is greater than the pointer width in bits,
- USE_LSB_TAG is:
-
- a. unnecessary, because the top bits of an EMACS_INT are unused,
-
- b. slower, because it typically requires extra masking, and
-
- c. harmful, because it can create Lisp_Object values that are so scrambled
- that mark_maybe_object cannot decipher them. mark_maybe_object assumes
- that EMACS_INT values are contiguous, but a host where EMACS_INT is
- wider than a pointer might allocate the top half of an EMACS_INT in
- (say) a 32-bit word on the stack, putting the bottom half in a 32-bit
- register that is saved elsewhere in a jmp_buf. When this happens,
- since USE_LSB_TAG is not defined the bottom half alone is a valid
- pointer that mark_maybe_pointer can follow; but if USE_LSB_TAG were
- defined, the bottom half would not be a valid pointer and neither
- mark_maybe_object nor mark_maybe_pointer would follow it.
-
- So, define USE_LSB_TAG only on hosts where it might be useful. */
-# if UINTPTR_MAX >> VALBITS != 0
-# 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
/* 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)
-#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
-#endif
+/* 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. */
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,
Lisp_Fwd_Kboard_Obj, /* Fwd to a Lisp_Object field of kboards. */
};
-#ifdef USE_LISP_UNION_TYPE
-
-#ifndef WORDS_BIGENDIAN
+#ifdef CHECK_LISP_OBJECT_TYPE
-/* Definition of Lisp_Object for little-endian machines. */
+typedef struct { EMACS_INT i; } Lisp_Object;
-typedef
-union Lisp_Object
- {
- /* Used for comparing two Lisp_Objects;
- also, positive integers can be accessed fast this way. */
- EMACS_INT i;
-
- struct
- {
- /* Use explicit signed, the signedness of a bit-field of type
- int is implementation defined. */
- signed EMACS_INT val : VALBITS;
- ENUM_BF (Lisp_Type) type : GCTYPEBITS;
- } s;
- struct
- {
- EMACS_UINT val : VALBITS;
- ENUM_BF (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_BF (Lisp_Type) type : GCTYPEBITS;
- /* Use explicit signed, the signedness of a bit-field of type
- int is implementation defined. */
- signed EMACS_INT val : VALBITS;
- } s;
- struct
- {
- ENUM_BF (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}
+
+#else /* CHECK_LISP_OBJECT_TYPE */
-/* If union type is not wanted, define Lisp_Object as just a number. */
+/* 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. */
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. */
# 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
/* 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))
/* 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. */
/* 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), \
{
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;
#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))
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
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.
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;
};
\f
/* Lisp floating point type */
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))))
#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. */
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;
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);
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);
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);
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);
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
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);
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;
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);
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;
(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);
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);
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);
/* 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);
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 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);
extern void fatal_error_signal (int);
#endif
extern Lisp_Object Qkill_emacs;
-EXFUN (Fkill_emacs, 1) NO_RETURN;
+_Noreturn EXFUN (Fkill_emacs, 1);
#if HAVE_SETLOCALE
void fixup_locale (void);
void synchronize_system_messages_locale (void);
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
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);
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);
#ifdef HAVE_LIBXML2
/* Defined in xml.c */
extern void syms_of_xml (void);
+extern void xml_cleanup_parser (void);
#endif
#ifdef HAVE_MENUS
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);
HCoop / bpt / emacs.git / blobdiff