/* Fundamental definitions for GNU Emacs Lisp interpreter.
-Copyright (C) 1985-1987, 1993-1995, 1997-2014 Free Software Foundation,
+Copyright (C) 1985-1987, 1993-1995, 1997-2015 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
/* Define a TYPE constant ID as an externally visible name. Use like this:
- #define ID_val (some integer preprocessor expression)
- #if ENUMABLE (ID_val)
- DEFINE_GDB_SYMBOL_ENUM (ID)
- #else
DEFINE_GDB_SYMBOL_BEGIN (TYPE, ID)
- # define ID ID_val
+ # define ID (some integer preprocessor expression of type TYPE)
DEFINE_GDB_SYMBOL_END (ID)
- #endif
This hack is for the benefit of compilers that do not make macro
- definitions visible to the debugger. It's used for symbols that
- .gdbinit needs, symbols whose values may not fit in 'int' (where an
- enum would suffice).
+ definitions or enums visible to the debugger. It's used for symbols
+ that .gdbinit needs. */
- Some GCC versions before GCC 4.2 omit enums in debugging output;
- see GCC bug 23336. So don't use enums with older GCC. */
-
-#if !defined __GNUC__ || 4 < __GNUC__ + (2 <= __GNUC_MINOR__)
-# define ENUMABLE(val) (INT_MIN <= (val) && (val) <= INT_MAX)
-#else
-# define ENUMABLE(val) 0
-#endif
-
-/* On AIX 7.1 ENUMABLE should return true when possible, otherwise the
- linker can optimize the symbols away, making it harder to debug.
- This was discovered only late in the release process, so to play it
- safe for now, non-AIX platforms do not use enums for debugging symbols.
- FIXME: remove this comment and the following four lines of code. */
-#ifndef _AIX
-# undef ENUMABLE
-# define ENUMABLE(val) 0
-#endif
-
-#define DEFINE_GDB_SYMBOL_ENUM(id) enum { id = id##_val };
-#if defined MAIN_PROGRAM
-# define DEFINE_GDB_SYMBOL_BEGIN(type, id) type const id EXTERNALLY_VISIBLE
+#define DECLARE_GDB_SYM(type, id) type const id EXTERNALLY_VISIBLE
+#ifdef MAIN_PROGRAM
+# define DEFINE_GDB_SYMBOL_BEGIN(type, id) DECLARE_GDB_SYM (type, id)
# define DEFINE_GDB_SYMBOL_END(id) = id;
#else
-# define DEFINE_GDB_SYMBOL_BEGIN(type, id)
-# define DEFINE_GDB_SYMBOL_END(val)
+# define DEFINE_GDB_SYMBOL_BEGIN(type, id) extern DECLARE_GDB_SYM (type, id)
+# define DEFINE_GDB_SYMBOL_END(val) ;
#endif
/* The ubiquitous max and min macros. */
#define max(a, b) ((a) > (b) ? (a) : (b))
#define min(a, b) ((a) < (b) ? (a) : (b))
+/* Number of elements in an array. */
+#define ARRAYELTS(arr) (sizeof (arr) / sizeof (arr)[0])
+
+/* Number of bits in a Lisp_Object tag. */
+DEFINE_GDB_SYMBOL_BEGIN (int, GCTYPEBITS)
+#define GCTYPEBITS 3
+DEFINE_GDB_SYMBOL_END (GCTYPEBITS)
+
+/* The number of bits needed in an EMACS_INT over and above the number
+ of bits in a pointer. This is 0 on systems where:
+ 1. We can specify multiple-of-8 alignment on static variables.
+ 2. We know malloc returns a multiple of 8. */
+#if (defined alignas \
+ && (defined GNU_MALLOC || defined DOUG_LEA_MALLOC || defined __GLIBC__ \
+ || defined DARWIN_OS || defined __sun || defined __MINGW32__ \
+ || defined CYGWIN))
+# define NONPOINTER_BITS 0
+#else
+# define NONPOINTER_BITS GCTYPEBITS
+#endif
+
/* 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
#ifndef EMACS_INT_MAX
# if INTPTR_MAX <= 0
# error "INTPTR_MAX misconfigured"
-# elif INTPTR_MAX <= INT_MAX && !defined WIDE_EMACS_INT
+# elif INTPTR_MAX <= INT_MAX >> NONPOINTER_BITS && !defined WIDE_EMACS_INT
typedef int EMACS_INT;
typedef unsigned int EMACS_UINT;
# define EMACS_INT_MAX INT_MAX
# define pI ""
-# elif INTPTR_MAX <= LONG_MAX && !defined WIDE_EMACS_INT
+# elif INTPTR_MAX <= LONG_MAX >> NONPOINTER_BITS && !defined WIDE_EMACS_INT
typedef long int EMACS_INT;
typedef unsigned long EMACS_UINT;
# define EMACS_INT_MAX LONG_MAX
# define pI "l"
+/* Check versus LLONG_MAX, not LLONG_MAX >> NONPOINTER_BITS.
+ In theory this is not safe, but in practice it seems to be OK. */
# elif INTPTR_MAX <= LLONG_MAX
typedef long long int EMACS_INT;
typedef unsigned long long int EMACS_UINT;
};
/* An unsigned integer type representing a fixed-length bit sequence,
- suitable for words in a Lisp bool vector. Normally it is size_t
+ suitable for bool vector words, GC mark bits, etc. Normally it is size_t
for speed, but it is unsigned char on weird platforms. */
#if BOOL_VECTOR_BITS_PER_CHAR == CHAR_BIT
typedef size_t bits_word;
{
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)
};
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 the defsubr as well
- as the two special buffers buffer_defaults and buffer_local_symbols. */
+ on the few static Lisp_Objects used: lispsym, all the defsubr, and
+ the two special buffers buffer_defaults and buffer_local_symbols. */
enum Lisp_Bits
{
- /* Number of bits in a Lisp_Object tag. This can be used in #if,
- and for GDB's sake also as a regular symbol. */
- GCTYPEBITS =
-#define GCTYPEBITS 3
- GCTYPEBITS,
-
/* 2**GCTYPEBITS. This must be a macro that expands to a literal
integer constant, for MSVC. */
#define GCALIGNMENT 8
/* 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. */
+ This can be used in #if, e.g., '#if USB_TAG' below expands to an
+ expression involving VAL_MAX. */
#define VAL_MAX (EMACS_INT_MAX >> (GCTYPEBITS - 1))
-/* 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 alignas
-/* 3. Pointers-as-ints exceed VAL_MAX.
- On hosts where pointers-as-ints do not exceed VAL_MAX, USE_LSB_TAG is:
+/* Whether the least-significant bits of an EMACS_INT contain the tag.
+ On hosts where pointers-as-ints do not exceed VAL_MAX / 2, 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 true only on hosts where it might be useful. */
-# if VAL_MAX < UINTPTR_MAX
-# define USE_LSB_TAG true
-# endif
-# endif
-# endif
-#endif
-#ifdef USE_LSB_TAG
-# undef USE_LSB_TAG
-enum enum_USE_LSB_TAG { USE_LSB_TAG = true };
-# define USE_LSB_TAG true
-#else
-enum enum_USE_LSB_TAG { USE_LSB_TAG = false };
-# define USE_LSB_TAG false
+ So, USE_LSB_TAG is true only on hosts where it might be useful. */
+DEFINE_GDB_SYMBOL_BEGIN (bool, USE_LSB_TAG)
+#define USE_LSB_TAG (VAL_MAX / 2 < INTPTR_MAX)
+DEFINE_GDB_SYMBOL_END (USE_LSB_TAG)
+
+#if !USE_LSB_TAG && !defined WIDE_EMACS_INT
+# error "USE_LSB_TAG not supported on this platform; please report this." \
+ "Try 'configure --with-wide-int' to work around the problem."
+error !;
#endif
#ifndef alignas
# endif
#endif
+#ifdef HAVE_STRUCT_ATTRIBUTE_ALIGNED
+# define GCALIGNED __attribute__ ((aligned (GCALIGNMENT)))
+#else
+# define GCALIGNED /* empty */
+#endif
/* Some operations are so commonly executed that they are implemented
as macros, not functions, because otherwise runtime performance would
#define lisp_h_CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y)
#define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x)
#define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
-#define lisp_h_CHECK_TYPE(ok, Qxxxp, x) \
- ((ok) ? (void) 0 : (void) wrong_type_argument (Qxxxp, x))
+#define lisp_h_CHECK_TYPE(ok, predicate, x) \
+ ((ok) ? (void) 0 : (void) wrong_type_argument (predicate, x))
#define lisp_h_CONSP(x) (XTYPE (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_Int1) == 0)
+#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_NILP(x) EQ (x, Qnil)
(eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons))
#define lisp_h_XHASH(a) XUINT (a)
#define lisp_h_XPNTR(a) \
- ((void *) (intptr_t) ((XLI (a) & VALMASK) | (DATA_SEG_BITS & ~VALMASK)))
-#define lisp_h_XSYMBOL(a) \
- (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol))
+ (SYMBOLP (a) ? XSYMBOL (a) : (void *) ((intptr_t) (XLI (a) & VALMASK)))
#ifndef GC_CHECK_CONS_LIST
# define lisp_h_check_cons_list() ((void) 0)
#endif
#if USE_LSB_TAG
-# define lisp_h_make_number(n) XIL ((EMACS_INT) (n) << INTTYPEBITS)
+# define lisp_h_make_number(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) \
+ (eassert (SYMBOLP (a)), \
+ (struct Lisp_Symbol *) ((uintptr_t) XLI (a) - Lisp_Symbol \
+ + (char *) lispsym))
# define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
-# define lisp_h_XUNTAG(a, type) ((void *) (XLI (a) - (type)))
+# define lisp_h_XUNTAG(a, type) ((void *) (intptr_t) (XLI (a) - (type)))
#endif
/* When compiling via gcc -O0, define the key operations as macros, as
# define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y)
# define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x)
# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x)
-# define CHECK_TYPE(ok, Qxxxp, x) lisp_h_CHECK_TYPE (ok, Qxxxp, 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 XCONS(a) lisp_h_XCONS (a)
# define XHASH(a) lisp_h_XHASH (a)
# define XPNTR(a) lisp_h_XPNTR (a)
-# define XSYMBOL(a) lisp_h_XSYMBOL (a)
# ifndef GC_CHECK_CONS_LIST
# define check_cons_list() lisp_h_check_cons_list ()
# endif
# define make_number(n) lisp_h_make_number (n)
# define XFASTINT(a) lisp_h_XFASTINT (a)
# define XINT(a) lisp_h_XINT (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
enum Lisp_Type
{
- /* Integer. XINT (obj) is the integer value. */
- Lisp_Int0 = 0,
- Lisp_Int1 = USE_LSB_TAG ? 1 << INTTYPEBITS : 1,
-
/* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
- Lisp_Symbol = 2,
+ Lisp_Symbol = 0,
/* Miscellaneous. XMISC (object) points to a union Lisp_Misc,
whose first member indicates the subtype. */
- Lisp_Misc = 3,
+ Lisp_Misc = 1,
+
+ /* Integer. XINT (obj) is the integer value. */
+ Lisp_Int0 = 2,
+ Lisp_Int1 = USE_LSB_TAG ? 6 : 3,
/* String. XSTRING (object) points to a struct Lisp_String.
The length of the string, and its contents, are stored therein. */
- Lisp_String = USE_LSB_TAG ? 1 : 1 << INTTYPEBITS,
+ Lisp_String = 4,
/* Vector of Lisp objects, or something resembling it.
XVECTOR (object) points to a struct Lisp_Vector, which contains
Lisp_Vectorlike = 5,
/* Cons. XCONS (object) points to a struct Lisp_Cons. */
- Lisp_Cons = 6,
+ Lisp_Cons = USE_LSB_TAG ? 3 : 6,
Lisp_Float = 7
};
typedef struct { EMACS_INT i; } Lisp_Object;
-#define LISP_INITIALLY_ZERO {0}
+#define LISP_INITIALLY(i) {i}
#undef CHECK_LISP_OBJECT_TYPE
enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true };
/* If a struct type is not wanted, define Lisp_Object as just a number. */
typedef EMACS_INT Lisp_Object;
-#define LISP_INITIALLY_ZERO 0
+#define LISP_INITIALLY(i) (i)
enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false };
#endif /* CHECK_LISP_OBJECT_TYPE */
+#define LISP_INITIALLY_ZERO LISP_INITIALLY (0)
+\f
+/* Forward declarations. */
+
+/* Defined in this file. */
+union Lisp_Fwd;
+INLINE bool BOOL_VECTOR_P (Lisp_Object);
+INLINE bool BUFFER_OBJFWDP (union Lisp_Fwd *);
+INLINE bool BUFFERP (Lisp_Object);
+INLINE bool CHAR_TABLE_P (Lisp_Object);
+INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t);
+INLINE bool (CONSP) (Lisp_Object);
+INLINE bool (FLOATP) (Lisp_Object);
+INLINE bool functionp (Lisp_Object);
+INLINE bool (INTEGERP) (Lisp_Object);
+INLINE bool (MARKERP) (Lisp_Object);
+INLINE bool (MISCP) (Lisp_Object);
+INLINE bool (NILP) (Lisp_Object);
+INLINE bool OVERLAYP (Lisp_Object);
+INLINE bool PROCESSP (Lisp_Object);
+INLINE bool PSEUDOVECTORP (Lisp_Object, int);
+INLINE bool SAVE_VALUEP (Lisp_Object);
+INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
+ Lisp_Object);
+INLINE bool STRINGP (Lisp_Object);
+INLINE bool SUB_CHAR_TABLE_P (Lisp_Object);
+INLINE bool SUBRP (Lisp_Object);
+INLINE bool (SYMBOLP) (Lisp_Object);
+INLINE bool (VECTORLIKEP) (Lisp_Object);
+INLINE bool WINDOWP (Lisp_Object);
+INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object);
+INLINE struct Lisp_Symbol *(XSYMBOL) (Lisp_Object);
+INLINE enum Lisp_Type (XTYPE) (Lisp_Object);
+INLINE void *(XUNTAG) (Lisp_Object, int);
+
+/* Defined in chartab.c. */
+extern Lisp_Object char_table_ref (Lisp_Object, int);
+extern void char_table_set (Lisp_Object, int, Lisp_Object);
+
+/* Defined in data.c. */
+extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
+extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object);
+
+/* Defined in emacs.c. */
+extern bool might_dump;
+/* True means Emacs has already been initialized.
+ Used during startup to detect startup of dumped Emacs. */
+extern bool initialized;
+
+/* Defined in floatfns.c. */
+extern double extract_float (Lisp_Object);
+
+\f
+/* Interned state of a symbol. */
+
+enum symbol_interned
+{
+ SYMBOL_UNINTERNED = 0,
+ SYMBOL_INTERNED = 1,
+ SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2
+};
+
+enum symbol_redirect
+{
+ SYMBOL_PLAINVAL = 4,
+ SYMBOL_VARALIAS = 1,
+ SYMBOL_LOCALIZED = 2,
+ SYMBOL_FORWARDED = 3
+};
+
+struct Lisp_Symbol
+{
+ bool_bf gcmarkbit : 1;
+
+ /* Indicates where the value can be found:
+ 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_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
+ can be changed, but only by `defconst'. */
+ unsigned constant : 2;
+
+ /* Interned state of the symbol. This is an enumerator from
+ enum symbol_interned. */
+ unsigned interned : 2;
+
+ /* True means that this variable has been explicitly declared
+ special (with `defvar' etc), and shouldn't be lexically bound. */
+ bool_bf declared_special : 1;
+
+ /* True if pointed to from purespace and hence can't be GC'd. */
+ bool_bf pinned : 1;
+
+ /* The symbol's name, as a Lisp string. */
+ Lisp_Object name;
+
+ /* 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;
+ struct Lisp_Buffer_Local_Value *blv;
+ union Lisp_Fwd *fwd;
+ } val;
+
+ /* Function value of the symbol or Qnil if not fboundp. */
+ Lisp_Object function;
+
+ /* The symbol's property list. */
+ Lisp_Object plist;
+
+ /* Next symbol in obarray bucket, if the symbol is interned. */
+ struct Lisp_Symbol *next;
+};
+
+/* Declare a Lisp-callable function. The MAXARGS parameter has the same
+ meaning as in the DEFUN macro, and is used to construct a prototype. */
+/* We can use the same trick as in the DEFUN macro to generate the
+ appropriate prototype. */
+#define EXFUN(fnname, maxargs) \
+ extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs
+
+/* Note that the weird token-substitution semantics of ANSI C makes
+ this work for MANY and UNEVALLED. */
+#define DEFUN_ARGS_MANY (ptrdiff_t, Lisp_Object *)
+#define DEFUN_ARGS_UNEVALLED (Lisp_Object)
+#define DEFUN_ARGS_0 (void)
+#define DEFUN_ARGS_1 (Lisp_Object)
+#define DEFUN_ARGS_2 (Lisp_Object, Lisp_Object)
+#define DEFUN_ARGS_3 (Lisp_Object, Lisp_Object, Lisp_Object)
+#define DEFUN_ARGS_4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
+#define DEFUN_ARGS_5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
+ Lisp_Object)
+#define DEFUN_ARGS_6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
+ Lisp_Object, Lisp_Object)
+#define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
+ Lisp_Object, Lisp_Object, Lisp_Object)
+#define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
+ Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
+
+/* Yield an integer that contains TAG along with PTR. */
+#define TAG_PTR(tag, ptr) \
+ ((USE_LSB_TAG ? (tag) : (EMACS_UINT) (tag) << VALBITS) + (uintptr_t) (ptr))
+
+/* Yield an integer that contains a symbol tag along with OFFSET.
+ OFFSET should be the offset in bytes from 'lispsym' to the symbol. */
+#define TAG_SYMOFFSET(offset) \
+ TAG_PTR (Lisp_Symbol, \
+ ((uintptr_t) (offset) >> (USE_LSB_TAG ? 0 : GCTYPEBITS)))
+
+/* 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_BEGIN(name) \
+ DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name)
+#define DEFINE_LISP_SYMBOL_END(name) \
+ DEFINE_GDB_SYMBOL_END (LISP_INITIALLY (TAG_SYMOFFSET (i##name \
+ * sizeof *lispsym)))
+
+#include "globals.h"
+
/* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa.
At the machine level, these operations are no-ops. */
LISP_MACRO_DEFUN (XLI, EMACS_INT, (Lisp_Object o), (o))
/* In the size word of a vector, this bit means the vector has been marked. */
-#define ARRAY_MARK_FLAG_val PTRDIFF_MIN
-#if ENUMABLE (ARRAY_MARK_FLAG_val)
-DEFINE_GDB_SYMBOL_ENUM (ARRAY_MARK_FLAG)
-#else
DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, ARRAY_MARK_FLAG)
-# define ARRAY_MARK_FLAG ARRAY_MARK_FLAG_val
+# define ARRAY_MARK_FLAG PTRDIFF_MIN
DEFINE_GDB_SYMBOL_END (ARRAY_MARK_FLAG)
-#endif
/* In the size word of a struct Lisp_Vector, this bit means it's really
some other vector-like object. */
-#define PSEUDOVECTOR_FLAG_val (PTRDIFF_MAX - PTRDIFF_MAX / 2)
-#if ENUMABLE (PSEUDOVECTOR_FLAG_val)
-DEFINE_GDB_SYMBOL_ENUM (PSEUDOVECTOR_FLAG)
-#else
DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, PSEUDOVECTOR_FLAG)
-# define PSEUDOVECTOR_FLAG PSEUDOVECTOR_FLAG_val
+# define PSEUDOVECTOR_FLAG (PTRDIFF_MAX - PTRDIFF_MAX / 2)
DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
-#endif
/* In a pseudovector, the size field actually contains a word with one
PSEUDOVECTOR_FLAG bit set, and one of the following values extracted
PVEC_FONT /* Should be last because it's used for range checking. */
};
-/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
- which were stored in a Lisp_Object. */
-#ifndef DATA_SEG_BITS
-# define DATA_SEG_BITS 0
-#endif
-enum { gdb_DATA_SEG_BITS = DATA_SEG_BITS };
-#undef DATA_SEG_BITS
-
enum More_Lisp_Bits
{
- DATA_SEG_BITS = gdb_DATA_SEG_BITS,
-
/* For convenience, we also store the number of elements in these bits.
Note that this size is not necessarily the memory-footprint size, but
only the number of Lisp_Object fields (that need to be traced by GC).
that cons. */
/* Mask for the value (as opposed to the type bits) of a Lisp object. */
-#define VALMASK_val (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX)
-#if ENUMABLE (VALMASK_val)
-DEFINE_GDB_SYMBOL_ENUM (VALMASK)
-#else
DEFINE_GDB_SYMBOL_BEGIN (EMACS_INT, VALMASK)
-# define VALMASK VALMASK_val
+# define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX)
DEFINE_GDB_SYMBOL_END (VALMASK)
-#endif
/* Largest and smallest representable fixnum values. These are the C
values. They are macros for use in static initializers. */
LISP_MACRO_DEFUN (make_number, Lisp_Object, (EMACS_INT n), (n))
LISP_MACRO_DEFUN (XINT, EMACS_INT, (Lisp_Object a), (a))
LISP_MACRO_DEFUN (XFASTINT, EMACS_INT, (Lisp_Object a), (a))
+LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a))
LISP_MACRO_DEFUN (XTYPE, enum Lisp_Type, (Lisp_Object a), (a))
LISP_MACRO_DEFUN (XUNTAG, void *, (Lisp_Object a, int type), (a, type))
INLINE Lisp_Object
make_number (EMACS_INT n)
{
- return XIL (USE_LSB_TAG ? n << INTTYPEBITS : n & INTMASK);
+ EMACS_INT int0 = Lisp_Int0;
+ if (USE_LSB_TAG)
+ {
+ EMACS_UINT u = n;
+ n = u << INTTYPEBITS;
+ n += int0;
+ }
+ else
+ {
+ n &= INTMASK;
+ n += (int0 << VALBITS);
+ }
+ return XIL (n);
}
/* Extract A's value as a signed integer. */
XINT (Lisp_Object a)
{
EMACS_INT i = XLI (a);
- return (USE_LSB_TAG ? i : i << INTTYPEBITS) >> INTTYPEBITS;
+ if (! USE_LSB_TAG)
+ {
+ EMACS_UINT u = i;
+ i = u << INTTYPEBITS;
+ }
+ return i >> INTTYPEBITS;
}
/* Like XINT (A), but may be faster. A must be nonnegative.
INLINE EMACS_INT
XFASTINT (Lisp_Object a)
{
- EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a);
+ EMACS_INT int0 = Lisp_Int0;
+ EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a) - (int0 << VALBITS);
eassert (0 <= n);
return n;
}
+/* Extract A's value as a symbol. */
+INLINE struct Lisp_Symbol *
+XSYMBOL (Lisp_Object a)
+{
+ uintptr_t i = (uintptr_t) XUNTAG (a, Lisp_Symbol);
+ if (! USE_LSB_TAG)
+ i <<= GCTYPEBITS;
+ void *p = (char *) lispsym + i;
+ return p;
+}
+
/* Extract A's type. */
INLINE enum Lisp_Type
XTYPE (Lisp_Object a)
INLINE void *
XUNTAG (Lisp_Object a, int type)
{
- if (USE_LSB_TAG)
- {
- intptr_t i = XLI (a) - type;
- return (void *) i;
- }
- return XPNTR (a);
+ intptr_t i = USE_LSB_TAG ? XLI (a) - type : XLI (a) & VALMASK;
+ return (void *) i;
}
#endif /* ! USE_LSB_TAG */
make_natnum (EMACS_INT n)
{
eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM);
- return USE_LSB_TAG ? make_number (n) : XIL (n);
+ EMACS_INT int0 = Lisp_Int0;
+ return USE_LSB_TAG ? make_number (n) : XIL (n + (int0 << VALBITS));
}
/* Return true if X and Y are the same object. */
return num < lower ? lower : num <= upper ? num : upper;
}
\f
-/* Forward declarations. */
-
-/* Defined in this file. */
-union Lisp_Fwd;
-INLINE bool BOOL_VECTOR_P (Lisp_Object);
-INLINE bool BUFFER_OBJFWDP (union Lisp_Fwd *);
-INLINE bool BUFFERP (Lisp_Object);
-INLINE bool CHAR_TABLE_P (Lisp_Object);
-INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t);
-INLINE bool (CONSP) (Lisp_Object);
-INLINE bool (FLOATP) (Lisp_Object);
-INLINE bool functionp (Lisp_Object);
-INLINE bool (INTEGERP) (Lisp_Object);
-INLINE bool (MARKERP) (Lisp_Object);
-INLINE bool (MISCP) (Lisp_Object);
-INLINE bool (NILP) (Lisp_Object);
-INLINE bool OVERLAYP (Lisp_Object);
-INLINE bool PROCESSP (Lisp_Object);
-INLINE bool PSEUDOVECTORP (Lisp_Object, int);
-INLINE bool SAVE_VALUEP (Lisp_Object);
-INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
- Lisp_Object);
-INLINE bool STRINGP (Lisp_Object);
-INLINE bool SUB_CHAR_TABLE_P (Lisp_Object);
-INLINE bool SUBRP (Lisp_Object);
-INLINE bool (SYMBOLP) (Lisp_Object);
-INLINE bool (VECTORLIKEP) (Lisp_Object);
-INLINE bool WINDOWP (Lisp_Object);
-INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object);
-
-/* Defined in chartab.c. */
-extern Lisp_Object char_table_ref (Lisp_Object, int);
-extern void char_table_set (Lisp_Object, int, Lisp_Object);
-extern int char_table_translate (Lisp_Object, int);
-
-/* Defined in data.c. */
-extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p;
-extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil;
-extern Lisp_Object Qnumberp, Qstringp, Qsymbolp, Qt, Qvectorp;
-extern Lisp_Object Qbool_vector_p;
-extern Lisp_Object Qvector_or_char_table_p, Qwholenump;
-extern Lisp_Object Qwindow;
-extern Lisp_Object Ffboundp (Lisp_Object);
-extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
-
-/* Defined in emacs.c. */
-extern bool initialized;
-
-/* Defined in eval.c. */
-extern Lisp_Object Qautoload;
-
-/* Defined in floatfns.c. */
-extern double extract_float (Lisp_Object);
-
-/* Defined in process.c. */
-extern Lisp_Object Qprocessp;
-
-/* Defined in window.c. */
-extern Lisp_Object Qwindowp;
-
-/* Defined in xdisp.c. */
-extern Lisp_Object Qimage;
-\f
/* Extract a value or address from a Lisp_Object. */
return XUNTAG (a, Lisp_String);
}
-LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a))
+/* The index of the C-defined Lisp symbol SYM.
+ This can be used in a static initializer. */
+#define SYMBOL_INDEX(sym) i##sym
INLINE struct Lisp_Float *
XFLOAT (Lisp_Object a)
INLINE Lisp_Object
make_lisp_ptr (void *ptr, enum Lisp_Type type)
{
- EMACS_UINT utype = type;
- EMACS_UINT typebits = USE_LSB_TAG ? type : utype << VALBITS;
- Lisp_Object a = XIL (typebits | (uintptr_t) ptr);
+ Lisp_Object a = XIL (TAG_PTR (type, ptr));
eassert (XTYPE (a) == type && XUNTAG (a, type) == ptr);
return a;
}
+INLINE Lisp_Object
+make_lisp_symbol (struct Lisp_Symbol *sym)
+{
+ Lisp_Object a = XIL (TAG_SYMOFFSET ((char *) sym - (char *) lispsym));
+ eassert (XSYMBOL (a) == sym);
+ return a;
+}
+
+INLINE Lisp_Object
+builtin_lisp_symbol (int index)
+{
+ return make_lisp_symbol (lispsym + index);
+}
+
INLINE Lisp_Object
make_lisp_proc (struct Lisp_Process *p)
{
#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_ptr (b, Lisp_Symbol))
+#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))
#define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
#define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE))
+/* Efficiently convert a pointer to a Lisp object and back. The
+ pointer is represented as a Lisp integer, so the garbage collector
+ does not know about it. The pointer should not have both Lisp_Int1
+ bits set, which makes this conversion inherently unportable. */
+
+INLINE void *
+XINTPTR (Lisp_Object a)
+{
+ return XUNTAG (a, Lisp_Int0);
+}
+
+INLINE Lisp_Object
+make_pointer_integer (void *p)
+{
+ Lisp_Object a = XIL (TAG_PTR (Lisp_Int0, p));
+ eassert (INTEGERP (a) && XINTPTR (a) == p);
+ return a;
+}
+
/* Type checking. */
-LISP_MACRO_DEFUN_VOID (CHECK_TYPE, (int ok, Lisp_Object Qxxxp, Lisp_Object x),
- (ok, Qxxxp, x))
+LISP_MACRO_DEFUN_VOID (CHECK_TYPE,
+ (int ok, Lisp_Object predicate, Lisp_Object x),
+ (ok, predicate, x))
/* Deprecated and will be removed soon. */
typedef struct interval *INTERVAL;
-struct Lisp_Cons
+struct GCALIGNED Lisp_Cons
{
/* Car of this cons cell. */
Lisp_Object car;
/* In a string or vector, the sign bit of the `size' is the gc mark bit. */
-struct Lisp_String
+struct GCALIGNED Lisp_String
{
ptrdiff_t size;
ptrdiff_t size_byte;
{
XSTRING (string)->size = newsize;
}
-INLINE void
-STRING_COPYIN (Lisp_Object string, ptrdiff_t index, char const *new,
- ptrdiff_t count)
-{
- memcpy (SDATA (string) + index, new, count);
-}
/* Header of vector-like objects. This documents the layout constraints on
vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents
sense to handle a char-table with type struct Lisp_Vector. An
element of a char table can be any Lisp objects, but if it is a sub
char-table, we treat it a table that contains information of a
- specific range of characters. A sub char-table has the same
- structure as a vector. A sub char table appears only in an element
- of a char-table, and there's no way to access it directly from
- Emacs Lisp program. */
+ specific range of characters. A sub char-table is like a vector but
+ with two integer fields between the header and Lisp data, which means
+ that it has to be marked with some precautions (see mark_char_table
+ in alloc.c). A sub char-table appears only in an element of a char-table,
+ and there's no way to access it directly from Emacs Lisp program. */
enum CHARTAB_SIZE_BITS
{
contains 32 elements, and each element covers 128 characters. A
sub char-table of depth 3 contains 128 elements, and each element
is for one character. */
- Lisp_Object depth;
+ int depth;
/* Minimum character covered by the sub char-table. */
- Lisp_Object min_char;
+ int min_char;
/* Use set_sub_char_table_contents to set this. */
Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER];
const char *doc;
};
-/* This is the number of slots that every char table must have. This
- counts the ordinary slots and the top, defalt, parent, and purpose
- slots. */
-enum CHAR_TABLE_STANDARD_SLOTS
+enum char_table_specials
{
- CHAR_TABLE_STANDARD_SLOTS = PSEUDOVECSIZE (struct Lisp_Char_Table, extras)
+ /* This is the number of slots that every char table must have. This
+ counts the ordinary slots and the top, defalt, parent, and purpose
+ slots. */
+ CHAR_TABLE_STANDARD_SLOTS = PSEUDOVECSIZE (struct Lisp_Char_Table, extras),
+
+ /* This is an index of first Lisp_Object field in Lisp_Sub_Char_Table
+ when the latter is treated as an ordinary Lisp_Vector. */
+ SUB_CHAR_TABLE_OFFSET = PSEUDOVECSIZE (struct Lisp_Sub_Char_Table, contents)
};
/* Return the number of "extra" slots in the char table CT. */
- CHAR_TABLE_STANDARD_SLOTS);
}
-\f
+/* Make sure that sub char-table contents slot
+ is aligned on a multiple of Lisp_Objects. */
+verify ((offsetof (struct Lisp_Sub_Char_Table, contents)
+ - offsetof (struct Lisp_Sub_Char_Table, depth)) % word_size == 0);
+
/***********************************************************************
Symbols
***********************************************************************/
-/* Interned state of a symbol. */
-
-enum symbol_interned
-{
- SYMBOL_UNINTERNED = 0,
- SYMBOL_INTERNED = 1,
- SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2
-};
-
-enum symbol_redirect
-{
- SYMBOL_PLAINVAL = 4,
- SYMBOL_VARALIAS = 1,
- SYMBOL_LOCALIZED = 2,
- SYMBOL_FORWARDED = 3
-};
-
-struct Lisp_Symbol
-{
- bool_bf gcmarkbit : 1;
-
- /* Indicates where the value can be found:
- 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_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
- can be changed, but only by `defconst'. */
- unsigned constant : 2;
-
- /* Interned state of the symbol. This is an enumerator from
- enum symbol_interned. */
- unsigned interned : 2;
-
- /* True means that this variable has been explicitly declared
- special (with `defvar' etc), and shouldn't be lexically bound. */
- bool_bf declared_special : 1;
-
- /* True if pointed to from purespace and hence can't be GC'd. */
- bool_bf pinned : 1;
-
- /* The symbol's name, as a Lisp string. */
- Lisp_Object name;
-
- /* 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;
- struct Lisp_Buffer_Local_Value *blv;
- union Lisp_Fwd *fwd;
- } val;
-
- /* Function value of the symbol or Qnil if not fboundp. */
- Lisp_Object function;
-
- /* The symbol's property list. */
- Lisp_Object plist;
-
- /* Next symbol in obarray bucket, if the symbol is interned. */
- struct Lisp_Symbol *next;
-};
-
/* Value is name of symbol. */
LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (struct Lisp_Symbol *sym), (sym))
LISP_MACRO_DEFUN (SYMBOL_CONSTANT_P, int, (Lisp_Object sym), (sym))
-#define DEFSYM(sym, name) \
- do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (false)
+/* Placeholder for make-docfile to process. The actual symbol
+ definition is done by lread.c's defsym. */
+#define DEFSYM(sym, name) /* empty */
\f
/***********************************************************************
{
CHECK_TYPE (BOOL_VECTOR_P (x), Qbool_vector_p, x);
}
-INLINE void
+/* This is a bit special because we always need size afterwards. */
+INLINE ptrdiff_t
CHECK_VECTOR_OR_STRING (Lisp_Object x)
{
- CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x);
+ if (VECTORP (x))
+ return ASIZE (x);
+ if (STRINGP (x))
+ return SCHARS (x);
+ wrong_type_argument (Qarrayp, x);
}
INLINE void
-CHECK_ARRAY (Lisp_Object x, Lisp_Object Qxxxp)
+CHECK_ARRAY (Lisp_Object x, Lisp_Object predicate)
{
- CHECK_TYPE (ARRAYP (x), Qxxxp, x);
+ CHECK_TYPE (ARRAYP (x), predicate, x);
}
INLINE void
CHECK_BUFFER (Lisp_Object x)
minargs, maxargs, lname, intspec, 0}; \
Lisp_Object fnname
#else /* not _MSC_VER */
-# if __STDC_VERSION__ < 199901
-# define DEFUN_FUNCTION_INIT(fnname, maxargs) (Lisp_Object (*) (void)) fnname
-# else
-# define DEFUN_FUNCTION_INIT(fnname, maxargs) .a ## maxargs = fnname
-# endif
#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
- Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
static struct Lisp_Subr alignas (GCALIGNMENT) sname = \
{ { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \
- { DEFUN_FUNCTION_INIT (fnname, maxargs) }, \
+ { .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. */
-#define DEFUN_ARGS_MANY (ptrdiff_t, Lisp_Object *)
-#define DEFUN_ARGS_UNEVALLED (Lisp_Object)
-#define DEFUN_ARGS_0 (void)
-#define DEFUN_ARGS_1 (Lisp_Object)
-#define DEFUN_ARGS_2 (Lisp_Object, Lisp_Object)
-#define DEFUN_ARGS_3 (Lisp_Object, Lisp_Object, Lisp_Object)
-#define DEFUN_ARGS_4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
-#define DEFUN_ARGS_5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
- Lisp_Object)
-#define DEFUN_ARGS_6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
- Lisp_Object, Lisp_Object)
-#define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
- Lisp_Object, Lisp_Object, Lisp_Object)
-#define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
- Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
-
/* True if OBJ is a Lisp function. */
INLINE bool
FUNCTIONP (Lisp_Object obj)
ptrdiff_t nvars;
#ifdef DEBUG_GCPRO
+ /* File name where this record is used. */
+ const char *name;
+
+ /* Line number in this file. */
+ int lineno;
+
+ /* Index in the local chain of records. */
+ int idx;
+
+ /* Nesting level. */
int level;
#endif
};
#ifndef DEBUG_GCPRO
-#define GCPRO1(varname) \
- {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \
- gcprolist = &gcpro1; }
+#define GCPRO1(a) \
+ { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
+ gcprolist = &gcpro1; }
+
+#define GCPRO2(a, b) \
+ { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
+ gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
+ gcprolist = &gcpro2; }
+
+#define GCPRO3(a, b, c) \
+ { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
+ gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
+ gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
+ gcprolist = &gcpro3; }
+
+#define GCPRO4(a, b, c, d) \
+ { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
+ gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
+ gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
+ gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
+ gcprolist = &gcpro4; }
+
+#define GCPRO5(a, b, c, d, e) \
+ { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
+ gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
+ gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
+ gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
+ gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
+ gcprolist = &gcpro5; }
+
+#define GCPRO6(a, b, c, d, e, f) \
+ { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
+ gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
+ gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
+ gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
+ gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
+ gcpro6.next = &gcpro5; gcpro6.var = &(f); gcpro6.nvars = 1; \
+ gcprolist = &gcpro6; }
-#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 GCPRO7(a, b, c, d, e, f, g) \
- {gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
- gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
- gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
- gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
- gcpro6.next = &gcpro5; gcpro6.var = &(f); gcpro6.nvars = 1; \
- gcpro7.next = &gcpro6; gcpro7.var = &(g); gcpro7.nvars = 1; \
- gcprolist = &gcpro7; }
+#define GCPRO7(a, b, c, d, e, f, g) \
+ { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
+ gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
+ gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
+ gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
+ gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
+ gcpro6.next = &gcpro5; gcpro6.var = &(f); gcpro6.nvars = 1; \
+ gcpro7.next = &gcpro6; gcpro7.var = &(g); gcpro7.nvars = 1; \
+ gcprolist = &gcpro7; }
#define UNGCPRO (gcprolist = gcpro1.next)
-#else
+#else /* !DEBUG_GCPRO */
extern int gcpro_level;
-#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 GCPRO1(a) \
+ { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
+ gcpro1.name = __FILE__; gcpro1.lineno = __LINE__; gcpro1.idx = 1; \
+ gcpro1.level = gcpro_level++; \
+ gcprolist = &gcpro1; }
+
+#define GCPRO2(a, b) \
+ { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
+ gcpro1.name = __FILE__; gcpro1.lineno = __LINE__; gcpro1.idx = 1; \
+ gcpro1.level = gcpro_level; \
+ gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
+ gcpro2.name = __FILE__; gcpro2.lineno = __LINE__; gcpro2.idx = 2; \
+ gcpro2.level = gcpro_level++; \
+ gcprolist = &gcpro2; }
+
+#define GCPRO3(a, b, c) \
+ { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
+ gcpro1.name = __FILE__; gcpro1.lineno = __LINE__; gcpro1.idx = 1; \
+ gcpro1.level = gcpro_level; \
+ gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
+ gcpro2.name = __FILE__; gcpro2.lineno = __LINE__; gcpro2.idx = 2; \
+ gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
+ gcpro3.name = __FILE__; gcpro3.lineno = __LINE__; gcpro3.idx = 3; \
+ gcpro3.level = gcpro_level++; \
+ gcprolist = &gcpro3; }
+
+#define GCPRO4(a, b, c, d) \
+ { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
+ gcpro1.name = __FILE__; gcpro1.lineno = __LINE__; gcpro1.idx = 1; \
+ gcpro1.level = gcpro_level; \
+ gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
+ gcpro2.name = __FILE__; gcpro2.lineno = __LINE__; gcpro2.idx = 2; \
+ gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
+ gcpro3.name = __FILE__; gcpro3.lineno = __LINE__; gcpro3.idx = 3; \
+ gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
+ gcpro4.name = __FILE__; gcpro4.lineno = __LINE__; gcpro4.idx = 4; \
+ gcpro4.level = gcpro_level++; \
+ gcprolist = &gcpro4; }
+
+#define GCPRO5(a, b, c, d, e) \
+ { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
+ gcpro1.name = __FILE__; gcpro1.lineno = __LINE__; gcpro1.idx = 1; \
+ gcpro1.level = gcpro_level; \
+ gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
+ gcpro2.name = __FILE__; gcpro2.lineno = __LINE__; gcpro2.idx = 2; \
+ gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
+ gcpro3.name = __FILE__; gcpro3.lineno = __LINE__; gcpro3.idx = 3; \
+ gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
+ gcpro4.name = __FILE__; gcpro4.lineno = __LINE__; gcpro4.idx = 4; \
+ gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
+ gcpro5.name = __FILE__; gcpro5.lineno = __LINE__; gcpro5.idx = 5; \
+ gcpro5.level = gcpro_level++; \
+ gcprolist = &gcpro5; }
+
+#define GCPRO6(a, b, c, d, e, f) \
+ { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
+ gcpro1.name = __FILE__; gcpro1.lineno = __LINE__; gcpro1.idx = 1; \
+ gcpro1.level = gcpro_level; \
+ gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
+ gcpro2.name = __FILE__; gcpro2.lineno = __LINE__; gcpro2.idx = 2; \
+ gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
+ gcpro3.name = __FILE__; gcpro3.lineno = __LINE__; gcpro3.idx = 3; \
+ gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
+ gcpro4.name = __FILE__; gcpro4.lineno = __LINE__; gcpro4.idx = 4; \
+ gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
+ gcpro5.name = __FILE__; gcpro5.lineno = __LINE__; gcpro5.idx = 5; \
+ gcpro6.next = &gcpro5; gcpro6.var = &(f); gcpro6.nvars = 1; \
+ gcpro6.name = __FILE__; gcpro6.lineno = __LINE__; gcpro6.idx = 6; \
+ gcpro6.level = gcpro_level++; \
+ gcprolist = &gcpro6; }
#define GCPRO7(a, b, c, d, e, f, g) \
- {gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
- gcpro1.level = gcpro_level; \
- gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
- gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
- gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
- gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
- gcpro6.next = &gcpro5; gcpro6.var = &(f); gcpro6.nvars = 1; \
- gcpro7.next = &gcpro6; gcpro7.var = &(g); gcpro7.nvars = 1; \
- gcpro7.level = gcpro_level++; \
- gcprolist = &gcpro7; }
+ { gcpro1.next = gcprolist; gcpro1.var = &(a); gcpro1.nvars = 1; \
+ gcpro1.name = __FILE__; gcpro1.lineno = __LINE__; gcpro1.idx = 1; \
+ gcpro1.level = gcpro_level; \
+ gcpro2.next = &gcpro1; gcpro2.var = &(b); gcpro2.nvars = 1; \
+ gcpro2.name = __FILE__; gcpro2.lineno = __LINE__; gcpro2.idx = 2; \
+ gcpro3.next = &gcpro2; gcpro3.var = &(c); gcpro3.nvars = 1; \
+ gcpro3.name = __FILE__; gcpro3.lineno = __LINE__; gcpro3.idx = 3; \
+ gcpro4.next = &gcpro3; gcpro4.var = &(d); gcpro4.nvars = 1; \
+ gcpro4.name = __FILE__; gcpro4.lineno = __LINE__; gcpro4.idx = 4; \
+ gcpro5.next = &gcpro4; gcpro5.var = &(e); gcpro5.nvars = 1; \
+ gcpro5.name = __FILE__; gcpro5.lineno = __LINE__; gcpro5.idx = 5; \
+ gcpro6.next = &gcpro5; gcpro6.var = &(f); gcpro6.nvars = 1; \
+ gcpro6.name = __FILE__; gcpro6.lineno = __LINE__; gcpro6.idx = 6; \
+ gcpro7.next = &gcpro6; gcpro7.var = &(g); gcpro7.nvars = 1; \
+ gcpro7.name = __FILE__; gcpro7.lineno = __LINE__; gcpro7.idx = 7; \
+ gcpro7.level = gcpro_level++; \
+ gcprolist = &gcpro7; }
#define UNGCPRO \
(--gcpro_level != gcpro1.level \
void staticpro (Lisp_Object *);
\f
-/* Declare a Lisp-callable function. The MAXARGS parameter has the same
- meaning as in the DEFUN macro, and is used to construct a prototype. */
-/* We can use the same trick as in the DEFUN macro to generate the
- appropriate prototype. */
-#define EXFUN(fnname, maxargs) \
- extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs
-
-#include "globals.h"
-
/* Forward declarations for prototypes. */
struct window;
struct frame;
XSUB_CHAR_TABLE (table)->contents[idx] = val;
}
-/* Defined in data.c. */
-extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
-extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
-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 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 Lisp_Object Qcircular_list;
-extern Lisp_Object Qintegerp, Qwholenump, Qsymbolp, Qlistp, Qconsp;
-extern Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
-extern Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
-extern Lisp_Object Qbuffer_or_string_p;
-extern Lisp_Object Qfboundp;
-extern Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
-
-extern Lisp_Object Qcdr;
-
-extern Lisp_Object Qrange_error, Qoverflow_error;
-
-extern Lisp_Object Qfloatp;
-extern Lisp_Object Qnumberp, Qnumber_or_marker_p;
-
-extern Lisp_Object Qbuffer, Qinteger, Qsymbol;
-
-extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
-
-EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST;
-
/* Defined in data.c. */
extern Lisp_Object indirect_function (Lisp_Object);
extern Lisp_Object find_symbol_value (Lisp_Object);
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, bool);
extern void syms_of_data (void);
extern void keys_of_cmds (void);
/* Defined in coding.c. */
-extern Lisp_Object Qcharset;
extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t,
ptrdiff_t, bool, bool, Lisp_Object);
extern void init_coding (void);
extern void syms_of_coding (void);
/* Defined in character.c. */
-EXFUN (Fmax_char, 0) ATTRIBUTE_CONST;
extern ptrdiff_t chars_in_text (const unsigned char *, ptrdiff_t);
extern ptrdiff_t multibyte_chars_in_text (const unsigned char *, ptrdiff_t);
-extern int multibyte_char_to_unibyte (int) ATTRIBUTE_CONST;
-extern int multibyte_char_to_unibyte_safe (int) ATTRIBUTE_CONST;
extern void syms_of_character (void);
/* Defined in charset.c. */
/* Structure forward declarations. */
struct charset;
-/* Defined in composite.c. */
-extern void syms_of_composite (void);
-
/* Defined in syntax.c. */
extern void init_syntax_once (void);
extern void syms_of_syntax (void);
/* Defined in fns.c. */
-extern Lisp_Object QCrehash_size, QCrehash_threshold;
enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
-EXFUN (Fidentity, 1) ATTRIBUTE_CONST;
extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST;
extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t);
extern void sweep_weak_hash_tables (void);
-extern Lisp_Object Qcursor_in_echo_area;
-extern Lisp_Object Qstring_lessp;
-extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq;
EMACS_UINT hash_string (char const *, ptrdiff_t);
EMACS_UINT sxhash (Lisp_Object, int);
Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object,
ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
EMACS_UINT);
extern struct hash_table_test hashtest_eql, hashtest_equal;
-
+extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object,
+ ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t);
extern Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object);
extern void syms_of_fns (void);
/* Defined in floatfns.c. */
-extern double extract_float (Lisp_Object);
extern void syms_of_floatfns (void);
extern Lisp_Object fmod_float (Lisp_Object x, Lisp_Object y);
#endif /* HAVE_WINDOW_SYSTEM */
/* Defined in image.c. */
-extern Lisp_Object QCascent, QCmargin, QCrelief;
-extern Lisp_Object QCconversion;
extern int x_bitmap_mask (struct frame *, ptrdiff_t);
extern void reset_image_types (void);
extern void syms_of_image (void);
/* Defined in insdel.c. */
-extern Lisp_Object Qinhibit_modification_hooks;
extern void move_gap_both (ptrdiff_t, ptrdiff_t);
extern _Noreturn void buffer_overflow (void);
extern void make_gap (ptrdiff_t);
#endif
extern Lisp_Object Vwindow_system;
extern Lisp_Object sit_for (Lisp_Object, bool, int);
-extern void init_display (void);
-extern void syms_of_display (void);
/* Defined in xdisp.c. */
-extern Lisp_Object Qinhibit_point_motion_hooks;
-extern Lisp_Object Qinhibit_redisplay, Qdisplay;
-extern Lisp_Object Qmenu_bar_update_hook;
-extern Lisp_Object Qwindow_scroll_functions;
-extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
-extern Lisp_Object Qimage, Qtext, Qboth, Qboth_horiz, Qtext_image_horiz;
-extern Lisp_Object Qspace, Qcenter, QCalign_to;
-extern Lisp_Object Qbar, Qhbar, Qbox, Qhollow;
-extern Lisp_Object Qleft_margin, Qright_margin;
-extern Lisp_Object QCdata, QCfile;
-extern Lisp_Object QCmap;
-extern Lisp_Object Qrisky_local_variable;
extern bool noninteractive_need_newline;
extern Lisp_Object echo_area_buffer[2];
extern void add_to_log (const char *, Lisp_Object, Lisp_Object);
extern void update_echo_area (void);
extern void truncate_echo_area (ptrdiff_t);
extern void redisplay (void);
-extern void redisplay_preserve_echo_area (int);
void set_frame_cursor_types (struct frame *, Lisp_Object);
extern void syms_of_xdisp (void);
/* Defined in vm-limit.c. */
extern void memory_warnings (void *, void (*warnfun) (const char *));
+/* Defined in character.c. */
+extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t,
+ ptrdiff_t *, ptrdiff_t *);
+
/* Defined in alloc.c. */
extern void check_pure_size (void);
extern void free_misc (Lisp_Object);
extern _Noreturn void buffer_memory_full (ptrdiff_t);
extern bool survives_gc_p (Lisp_Object);
extern void mark_object (Lisp_Object);
-#if defined REL_ALLOC && !defined SYSTEM_MALLOC
+#if defined REL_ALLOC && !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
extern void refill_memory_reserve (void);
#endif
extern const char *pending_malloc_warning;
extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
extern void make_byte_code (struct Lisp_Vector *);
-extern Lisp_Object Qautomatic_gc;
-extern Lisp_Object Qchar_table_extra_slots;
extern struct Lisp_Vector *allocate_vector (EMACS_INT);
/* Make an uninitialized vector for SIZE objects. NOTE: you must
return v;
}
+/* Like above, but special for sub char-tables. */
+
+INLINE Lisp_Object
+make_uninit_sub_char_table (int depth, int min_char)
+{
+ int slots = SUB_CHAR_TABLE_OFFSET + chartab_size[depth];
+ Lisp_Object v = make_uninit_vector (slots);
+
+ XSETPVECTYPE (XVECTOR (v), PVEC_SUB_CHAR_TABLE);
+ XSUB_CHAR_TABLE (v)->depth = depth;
+ XSUB_CHAR_TABLE (v)->min_char = min_char;
+ return v;
+}
+
extern struct Lisp_Vector *allocate_pseudovector (int, int, enum pvec_type);
#define ALLOCATE_PSEUDOVECTOR(typ,field,tag) \
((typ*) \
extern void syms_of_alloc (void);
extern struct buffer * allocate_buffer (void);
extern int valid_lisp_object_p (Lisp_Object);
+extern int relocatable_string_data_p (const char *);
#ifdef GC_CHECK_CONS_LIST
extern void check_cons_list (void);
#else
#ifdef REL_ALLOC
/* Defined in ralloc.c. */
-extern void *r_alloc (void **, size_t);
+extern void *r_alloc (void **, size_t) ATTRIBUTE_ALLOC_SIZE ((2));
extern void r_alloc_free (void **);
-extern void *r_re_alloc (void **, size_t);
+extern void *r_re_alloc (void **, size_t) ATTRIBUTE_ALLOC_SIZE ((2));
extern void r_alloc_reset_variable (void **, void **);
extern void r_alloc_inhibit_buffer_relocation (int);
#endif
/* Defined in chartab.c. */
extern Lisp_Object copy_char_table (Lisp_Object);
-extern Lisp_Object char_table_ref (Lisp_Object, int);
extern Lisp_Object char_table_ref_and_range (Lisp_Object, int,
int *, int *);
-extern void char_table_set (Lisp_Object, int, Lisp_Object);
extern void char_table_set_range (Lisp_Object, int, int, Lisp_Object);
-extern int char_table_translate (Lisp_Object, int);
extern void map_char_table (void (*) (Lisp_Object, Lisp_Object,
Lisp_Object),
Lisp_Object, Lisp_Object, Lisp_Object);
/* Defined in print.c. */
extern Lisp_Object Vprin1_to_string_buffer;
extern void debug_print (Lisp_Object) EXTERNALLY_VISIBLE;
-extern Lisp_Object Qstandard_output;
-extern Lisp_Object Qexternal_debugging_output;
extern void temp_output_buffer_setup (const char *);
extern int print_level;
-extern Lisp_Object Qprint_escape_newlines;
extern void write_string (const char *, int);
extern void print_error_message (Lisp_Object, Lisp_Object, const char *,
Lisp_Object);
ATTRIBUTE_FORMAT_PRINTF (5, 0);
/* Defined in lread.c. */
-extern Lisp_Object Qvariable_documentation, Qstandard_input;
-extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
-extern Lisp_Object Qlexical_binding;
extern Lisp_Object check_obarray (Lisp_Object);
extern Lisp_Object intern_1 (const char *, ptrdiff_t);
extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
+extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, Lisp_Object);
+extern void init_symbol (Lisp_Object, Lisp_Object);
extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
INLINE void
LOADHIST_ATTACH (Lisp_Object x)
}
/* Defined in eval.c. */
-extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qmacro;
-extern Lisp_Object Qinhibit_quit, Qinternal_interpreter_environment, Qclosure;
-extern Lisp_Object Qand_rest;
+extern EMACS_INT lisp_eval_depth;
extern Lisp_Object Vautoload_queue;
+extern Lisp_Object Vrun_hooks;
extern Lisp_Object Vsignaling_function;
extern Lisp_Object inhibit_lisp_code;
extern struct handler *handlerlist;
call1 (Vrun_hooks, Qmy_funny_hook);
should no longer be used. */
-extern Lisp_Object Vrun_hooks;
+extern void run_hook (Lisp_Object);
extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args,
Lisp_Object (*funcall)
/* Defined in editfns.c. */
-extern Lisp_Object Qfield;
extern void insert1 (Lisp_Object);
extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object);
extern Lisp_Object save_excursion_save (void);
ptrdiff_t, bool);
extern void init_editfns (void);
extern void syms_of_editfns (void);
-extern void set_time_zone_rule (const char *);
/* Defined in buffer.c. */
extern bool mouse_face_overlay_overlaps (Lisp_Object);
extern Lisp_Object other_buffer_safely (Lisp_Object);
extern Lisp_Object get_truename_buffer (Lisp_Object);
extern void init_buffer_once (void);
-extern void init_buffer (void);
+extern void init_buffer (int);
extern void syms_of_buffer (void);
extern void keys_of_buffer (void);
/* Defined in fileio.c. */
-extern Lisp_Object Qfile_error;
-extern Lisp_Object Qfile_notify_error;
-extern Lisp_Object Qfile_exists_p;
-extern Lisp_Object Qfile_directory_p;
-extern Lisp_Object Qinsert_file_contents;
-extern Lisp_Object Qfile_name_history;
extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object);
extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, int);
-EXFUN (Fread_file_name, 6); /* Not a normal DEFUN. */
extern void close_file_unwind (int);
extern void fclose_unwind (void *);
extern void restore_point_unwind (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_accessible_directory_p (const char *);
+extern bool file_accessible_directory_p (Lisp_Object);
extern void init_fileio (void);
extern void syms_of_fileio (void);
extern Lisp_Object make_temp_name (Lisp_Object, bool);
-extern Lisp_Object Qdelete_file;
/* Defined in search.c. */
extern void shrink_regexp_cache (void);
ptrdiff_t, ptrdiff_t *, ptrdiff_t *, bool);
extern ptrdiff_t scan_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
ptrdiff_t, bool);
+extern ptrdiff_t scan_newline_from_point (ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
extern ptrdiff_t find_newline_no_quit (ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t *);
extern ptrdiff_t find_before_next_newline (ptrdiff_t, ptrdiff_t,
/* Defined in minibuf.c. */
-extern Lisp_Object Qcompletion_ignore_case;
extern Lisp_Object Vminibuffer_list;
extern Lisp_Object last_minibuf_string;
extern Lisp_Object get_minibuffer (EMACS_INT);
/* Defined in callint.c. */
-extern Lisp_Object Qminus, Qplus;
-extern Lisp_Object Qwhen;
-extern Lisp_Object Qmouse_leave_buffer_hook;
extern void syms_of_callint (void);
/* Defined in casefiddle.c. */
-extern Lisp_Object Qidentity;
extern void syms_of_casefiddle (void);
extern void keys_of_casefiddle (void);
extern Lisp_Object echo_message_buffer;
extern struct kboard *echo_kboard;
extern void cancel_echoing (void);
-extern Lisp_Object Qdisabled, QCfilter;
-extern Lisp_Object Qup, Qdown, Qbottom;
-extern Lisp_Object Qtop;
extern Lisp_Object last_undo_boundary;
extern bool input_pending;
+#ifdef HAVE_STACK_OVERFLOW_HANDLING
+extern sigjmp_buf return_to_command_loop;
+#endif
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 syms_of_indent (void);
/* Defined in frame.c. */
-extern Lisp_Object Qonly, Qnone;
-extern Lisp_Object Qvisible;
-extern void set_frame_param (struct frame *, Lisp_Object, Lisp_Object);
extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object);
extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object);
extern Lisp_Object do_switch_frame (Lisp_Object, int, int, Lisp_Object);
-#if HAVE_NS || HAVE_NTGUI
extern Lisp_Object get_frame_param (struct frame *, Lisp_Object);
-#endif
extern void frames_discard_buffer (Lisp_Object);
extern void syms_of_frame (void);
#endif
extern Lisp_Object decode_env_path (const char *, const char *, bool);
extern Lisp_Object empty_unibyte_string, empty_multibyte_string;
-extern Lisp_Object Qfile_name_handler_alist;
extern _Noreturn void terminate_due_to_signal (int, int);
-extern Lisp_Object Qkill_emacs;
#ifdef WINDOWSNT
extern Lisp_Object Vlibrary_cache;
#endif
extern bool running_asynch_code;
/* Defined in process.c. */
-extern Lisp_Object QCtype, Qlocal;
extern void kill_buffer_processes (Lisp_Object);
-extern bool wait_reading_process_output (intmax_t, int, int, bool,
- Lisp_Object,
- struct Lisp_Process *,
- int);
+extern int wait_reading_process_output (intmax_t, int, int, bool, 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.
#else
# define WAIT_READING_MAX INTMAX_MAX
#endif
+#ifdef HAVE_TIMERFD
+extern void add_timer_wait_descriptor (int);
+#endif
extern void add_keyboard_wait_descriptor (int);
extern void delete_keyboard_wait_descriptor (int);
#ifdef HAVE_GPM
extern void syms_of_callproc (void);
/* Defined in doc.c. */
-extern Lisp_Object Qfunction_documentation;
extern Lisp_Object read_doc_string (Lisp_Object);
extern Lisp_Object get_doc_string (Lisp_Object, bool, bool);
extern void syms_of_doc (void);
extern void syms_of_macros (void);
/* Defined in undo.c. */
-extern Lisp_Object Qapply;
-extern Lisp_Object Qinhibit_read_only;
extern void truncate_undo_list (struct buffer *);
extern void record_insert (ptrdiff_t, ptrdiff_t);
extern void record_delete (ptrdiff_t, Lisp_Object, bool);
Lisp_Object, Lisp_Object,
Lisp_Object);
extern void syms_of_undo (void);
-/* Defined in textprop.c. */
-extern Lisp_Object Qfont, Qmouse_face;
-extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks;
-extern Lisp_Object Qfront_sticky, Qrear_nonsticky;
-extern Lisp_Object Qminibuffer_prompt;
+/* Defined in textprop.c. */
extern void report_interval_modification (Lisp_Object, Lisp_Object);
/* Defined in menu.c. */
#endif
extern void stuff_char (char c);
extern void init_foreground_group (void);
-extern void init_sigio (int);
extern void sys_subshell (void);
extern void sys_suspend (void);
extern void discard_tty_input (void);
-extern void block_tty_out_signal (void);
-extern void unblock_tty_out_signal (void);
extern void init_sys_modes (struct tty_display_info *);
extern void reset_sys_modes (struct tty_display_info *);
extern void init_all_sys_modes (void);
extern void unlock_file (Lisp_Object);
extern void unlock_buffer (struct buffer *);
extern void syms_of_filelock (void);
+extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
/* Defined in sound.c. */
extern void syms_of_sound (void);
#ifdef HAVE_WINDOW_SYSTEM
/* Defined in fontset.c. */
extern void syms_of_fontset (void);
-
-/* Defined in xfns.c, w32fns.c, or macfns.c. */
-extern Lisp_Object Qfont_param;
#endif
/* Defined in gfilenotify.c */
#endif
/* Defined in xfaces.c. */
-extern Lisp_Object Qdefault, Qtool_bar, Qfringe;
-extern Lisp_Object Qheader_line, Qscroll_bar, Qcursor;
-extern Lisp_Object Qmode_line_inactive;
-extern Lisp_Object Qface;
-extern Lisp_Object Qnormal;
-extern Lisp_Object QCfamily, QCweight, QCslant;
-extern Lisp_Object QCheight, QCname, QCwidth, QCforeground, QCbackground;
-extern Lisp_Object Qextra_light, Qlight, Qsemi_light, Qsemi_bold;
-extern Lisp_Object Qbold, Qextra_bold, Qultra_bold;
-extern Lisp_Object Qoblique, Qitalic;
extern Lisp_Object Vface_alternative_font_family_alist;
extern Lisp_Object Vface_alternative_font_registry_alist;
extern void syms_of_xfaces (void);
extern void syms_of_xselect (void);
/* Defined in xterm.c. */
+extern void init_xterm (void);
extern void syms_of_xterm (void);
#endif /* HAVE_X_WINDOWS */
#ifdef HAVE_DBUS
/* Defined in dbusbind.c. */
+void init_dbusbind (void);
void syms_of_dbusbind (void);
#endif
/* Defined in msdos.c, w32.c. */
extern char *emacs_root_dir (void);
#endif /* DOS_NT */
-\f
-/* True means Emacs has already been initialized.
- Used during startup to detect startup of dumped Emacs. */
-extern bool initialized;
+
+/* Defined in lastfile.c. */
+extern char my_edata[];
+extern char my_endbss[];
+extern char *my_endbss_static;
/* True means ^G can quit instantly. */
extern bool immediate_quit;
-extern void *xmalloc (size_t);
-extern void *xzalloc (size_t);
-extern void *xrealloc (void *, size_t);
+extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
+extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
+extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2));
extern void xfree (void *);
-extern void *xnmalloc (ptrdiff_t, ptrdiff_t);
-extern void *xnrealloc (void *, ptrdiff_t, ptrdiff_t);
+extern void *xnmalloc (ptrdiff_t, ptrdiff_t) ATTRIBUTE_MALLOC_SIZE ((1,2));
+extern void *xnrealloc (void *, ptrdiff_t, ptrdiff_t)
+ ATTRIBUTE_ALLOC_SIZE ((2,3));
extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t);
-extern char *xstrdup (const char *);
-extern char *xlispstrdup (Lisp_Object);
+extern char *xstrdup (const char *) ATTRIBUTE_MALLOC;
+extern char *xlispstrdup (Lisp_Object) ATTRIBUTE_MALLOC;
extern void dupstring (char **, char const *);
-extern void xputenv (const char *);
-extern char *egetenv (const char *);
+/* Make DEST a copy of STRING's data. Return a pointer to DEST's terminating
+ null byte. This is like stpcpy, except the source is a Lisp string. */
-/* Copy Lisp string to temporary (allocated on stack) C string. */
+INLINE char *
+lispstpcpy (char *dest, Lisp_Object string)
+{
+ ptrdiff_t len = SBYTES (string);
+ memcpy (dest, SDATA (string), len + 1);
+ return dest + len;
+}
-#define xlispstrdupa(string) \
- memcpy (alloca (SBYTES (string) + 1), \
- SSDATA (string), SBYTES (string) + 1)
+extern void xputenv (const char *);
+
+extern char *egetenv_internal (const char *, ptrdiff_t);
+
+INLINE char *
+egetenv (const char *var)
+{
+ /* When VAR is a string literal, strlen can be optimized away. */
+ return egetenv_internal (var, strlen (var));
+}
/* Set up the name of the machine we're running on. */
extern void init_system_name (void);
enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 };
-extern void *record_xmalloc (size_t);
+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
+#define AVAIL_ALLOCA(size) (sa_avail -= (size), alloca (size))
+
/* SAFE_ALLOCA allocates a simple buffer. */
-#define SAFE_ALLOCA(size) ((size) < MAX_ALLOCA \
- ? alloca (size) \
+#define SAFE_ALLOCA(size) ((size) <= sa_avail \
+ ? AVAIL_ALLOCA (size) \
: (sa_must_free = true, record_xmalloc (size)))
/* SAFE_NALLOCA sets BUF to a newly allocated array of MULTIPLIER *
#define SAFE_NALLOCA(buf, multiplier, nitems) \
do { \
- if ((nitems) <= MAX_ALLOCA / sizeof *(buf) / (multiplier)) \
- (buf) = alloca (sizeof *(buf) * (multiplier) * (nitems)); \
+ if ((nitems) <= sa_avail / sizeof *(buf) / (multiplier)) \
+ (buf) = AVAIL_ALLOCA (sizeof *(buf) * (multiplier) * (nitems)); \
else \
{ \
(buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \
} \
} while (false)
+/* SAFE_ALLOCA_STRING allocates a C copy of a Lisp string. */
+
+#define SAFE_ALLOCA_STRING(ptr, string) \
+ do { \
+ (ptr) = SAFE_ALLOCA (SBYTES (string) + 1); \
+ memcpy (ptr, SDATA (string), SBYTES (string) + 1); \
+ } while (false)
+
/* SAFE_FREE frees xmalloced memory and enables GC as needed. */
#define SAFE_FREE() \
} while (false)
+/* Return floor (NBYTES / WORD_SIZE). */
+
+INLINE ptrdiff_t
+lisp_word_count (ptrdiff_t nbytes)
+{
+ if (-1 >> 1 == -1)
+ switch (word_size)
+ {
+ case 2: return nbytes >> 1;
+ case 4: return nbytes >> 2;
+ case 8: return nbytes >> 3;
+ case 16: return nbytes >> 4;
+ }
+ return nbytes / word_size - (nbytes % word_size < 0);
+}
+
/* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects. */
#define SAFE_ALLOCA_LISP(buf, nelt) \
do { \
- if ((nelt) < MAX_ALLOCA / word_size) \
- (buf) = alloca ((nelt) * word_size); \
- else if ((nelt) < min (PTRDIFF_MAX, SIZE_MAX) / word_size) \
+ if ((nelt) <= lisp_word_count (sa_avail)) \
+ (buf) = AVAIL_ALLOCA ((nelt) * word_size); \
+ else if ((nelt) <= min (PTRDIFF_MAX, SIZE_MAX) / word_size) \
{ \
Lisp_Object arg_; \
(buf) = xmalloc ((nelt) * word_size); \
memory_full (SIZE_MAX); \
} while (false)
+
+/* 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.
+
+ This feature is experimental and requires careful debugging.
+ Build with CPPFLAGS='-DUSE_STACK_LISP_OBJECTS=0' to disable it. */
+
+#ifndef USE_STACK_LISP_OBJECTS
+# define USE_STACK_LISP_OBJECTS true
+#endif
+
+/* USE_STACK_LISP_OBJECTS requires GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS. */
+
+#if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS
+# undef USE_STACK_LISP_OBJECTS
+# define USE_STACK_LISP_OBJECTS false
+#endif
+
+#ifdef GC_CHECK_STRING_BYTES
+enum { defined_GC_CHECK_STRING_BYTES = true };
+#else
+enum { defined_GC_CHECK_STRING_BYTES = false };
+#endif
+
+/* Struct inside unions that are typically no larger and aligned enough. */
+
+union Aligned_Cons
+{
+ struct Lisp_Cons s;
+ double d; intmax_t i; void *p;
+};
+
+union Aligned_String
+{
+ struct Lisp_String s;
+ double d; intmax_t i; void *p;
+};
+
+/* True for stack-based cons and string implementations, respectively.
+ Use stack-based strings only if stack-based cons also works.
+ Otherwise, STACK_CONS would create heap-based cons cells that
+ could point to stack-based strings, which is a no-no. */
+
+enum
+ {
+ USE_STACK_CONS = (USE_STACK_LISP_OBJECTS
+ && alignof (union Aligned_Cons) % GCALIGNMENT == 0),
+ USE_STACK_STRING = (USE_STACK_CONS
+ && !defined_GC_CHECK_STRING_BYTES
+ && alignof (union Aligned_String) % GCALIGNMENT == 0)
+ };
+
+/* Auxiliary macros used for auto allocation of Lisp objects. Please
+ use these only in macros like AUTO_CONS that declare a local
+ variable whose lifetime will be clear to the programmer. */
+#define STACK_CONS(a, b) \
+ make_lisp_ptr (&(union Aligned_Cons) { { a, { b } } }.s, Lisp_Cons)
+#define AUTO_CONS_EXPR(a, b) \
+ (USE_STACK_CONS ? STACK_CONS (a, b) : Fcons (a, b))
+
+/* Declare NAME as an auto Lisp cons or short list if possible, a
+ GC-based one otherwise. This is in the sense of the C keyword
+ 'auto'; i.e., the object has the lifetime of the containing block.
+ The resulting object should not be made visible to user Lisp code. */
+
+#define AUTO_CONS(name, a, b) Lisp_Object name = AUTO_CONS_EXPR (a, b)
+#define AUTO_LIST1(name, a) \
+ Lisp_Object name = (USE_STACK_CONS ? STACK_CONS (a, Qnil) : list1 (a))
+#define AUTO_LIST2(name, a, b) \
+ Lisp_Object name = (USE_STACK_CONS \
+ ? STACK_CONS (a, STACK_CONS (b, Qnil)) \
+ : list2 (a, b))
+#define AUTO_LIST3(name, a, b, c) \
+ Lisp_Object name = (USE_STACK_CONS \
+ ? STACK_CONS (a, STACK_CONS (b, STACK_CONS (c, Qnil))) \
+ : list3 (a, b, c))
+#define AUTO_LIST4(name, a, b, c, d) \
+ Lisp_Object name \
+ = (USE_STACK_CONS \
+ ? STACK_CONS (a, STACK_CONS (b, STACK_CONS (c, \
+ STACK_CONS (d, Qnil)))) \
+ : list4 (a, b, c, d))
+
+/* Check whether stack-allocated strings are ASCII-only. */
+
+#if defined (ENABLE_CHECKING) && USE_STACK_LISP_OBJECTS
+extern const char *verify_ascii (const char *);
+#else
+# define verify_ascii(str) (str)
+#endif
+
+/* Declare NAME as an auto Lisp string if possible, a GC-based one if not.
+ Take its value from STR. STR is not necessarily copied and should
+ contain only ASCII characters. The resulting Lisp string should
+ not be modified or made visible to user code. */
+
+#define AUTO_STRING(name, str) \
+ Lisp_Object name = \
+ (USE_STACK_STRING \
+ ? (make_lisp_ptr \
+ ((&(union Aligned_String) \
+ {{strlen (str), -1, 0, (unsigned char *) verify_ascii (str)}}.s), \
+ Lisp_String)) \
+ : build_string (verify_ascii (str)))
+
/* Loop over all tails of a list, checking for cycles.
FIXME: Make tortoise and n internal declarations.
FIXME: Unroll the loop body so we don't need `n'. */