diff options
Diffstat (limited to 'src/lisp.h')
| -rw-r--r-- | src/lisp.h | 1396 |
1 files changed, 785 insertions, 611 deletions
diff --git a/src/lisp.h b/src/lisp.h index aa939ba157e..f5242ab84a1 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -36,46 +36,21 @@ INLINE_HEADER_BEGIN /* 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. */ @@ -84,6 +59,27 @@ INLINE_HEADER_BEGIN #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 @@ -91,16 +87,18 @@ INLINE_HEADER_BEGIN #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; @@ -119,7 +117,7 @@ enum { BOOL_VECTOR_BITS_PER_CHAR = }; /* 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; @@ -137,7 +135,6 @@ 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) }; @@ -236,17 +233,11 @@ extern bool suppress_checking EXTERNALLY_VISIBLE; USE_LSB_TAG not only requires the least 3 bits of pointers returned by malloc to be 0 but also needs to be able to impose a mult-of-8 alignment - on the few static Lisp_Objects used: all 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 @@ -267,34 +258,23 @@ enum Lisp_Bits /* 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 @@ -304,6 +284,11 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = false }; # 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 @@ -348,12 +333,12 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = false }; #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) @@ -370,18 +355,21 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = false }; (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 @@ -395,7 +383,7 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = false }; # 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) @@ -413,7 +401,6 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = false }; # 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 @@ -421,6 +408,7 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = false }; # 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 @@ -462,20 +450,20 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = false }; 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 @@ -484,7 +472,7 @@ enum Lisp_Type 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 }; @@ -577,7 +565,7 @@ enum Lisp_Fwd_Type 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 }; @@ -586,10 +574,179 @@ 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) + +/* 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 bool TERMINALP (Lisp_Object); +INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object); +INLINE struct Lisp_Symbol *(XSYMBOL) (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); + + +/* 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))) + +/* XLI_BUILTIN_LISPSYM (iQwhatever) is equivalent to + XLI (builtin_lisp_symbol (Qwhatever)), + except the former expands to an integer constant expression. */ +#define XLI_BUILTIN_LISPSYM(iname) TAG_SYMOFFSET ((iname) * sizeof *lispsym) + +/* 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 (XLI_BUILTIN_LISPSYM (i##name))) + +#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)) @@ -597,25 +754,15 @@ LISP_MACRO_DEFUN (XIL, Lisp_Object, (EMACS_INT i), (i)) /* 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 @@ -641,18 +788,8 @@ enum pvec_type 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). @@ -678,28 +815,21 @@ enum More_Lisp_Bits 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. */ #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) -/* Extract the pointer hidden within A. */ -LISP_MACRO_DEFUN (XPNTR, void *, (Lisp_Object a), (a)) - #if USE_LSB_TAG 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)) @@ -714,7 +844,19 @@ 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. */ @@ -722,7 +864,12 @@ INLINE EMACS_INT 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. @@ -731,11 +878,23 @@ XINT (Lisp_Object a) 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) @@ -748,16 +907,15 @@ 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 */ +/* Extract the pointer hidden within A. */ +LISP_MACRO_DEFUN (XPNTR, void *, (Lisp_Object a), (a)) + /* Extract A's value as an unsigned integer. */ INLINE EMACS_UINT XUINT (Lisp_Object a) @@ -776,7 +934,8 @@ INLINE Lisp_Object 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. */ @@ -795,69 +954,6 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) return num < lower ? lower : num <= upper ? num : upper; } -/* 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; - /* Extract a value or address from a Lisp_Object. */ @@ -877,7 +973,9 @@ XSTRING (Lisp_Object a) 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) @@ -905,6 +1003,7 @@ XWINDOW (Lisp_Object a) INLINE struct terminal * XTERMINAL (Lisp_Object a) { + eassert (TERMINALP (a)); return XUNTAG (a, Lisp_Vectorlike); } @@ -948,17 +1047,23 @@ XBOOL_VECTOR (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_proc (struct Lisp_Process *p) +make_lisp_symbol (struct Lisp_Symbol *sym) { - return make_lisp_ptr (p, Lisp_Vectorlike); + 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); } #define XSETINT(a, b) ((a) = make_number (b)) @@ -966,7 +1071,7 @@ 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)) @@ -1004,10 +1109,30 @@ make_lisp_proc (struct Lisp_Process *p) #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. */ @@ -1017,7 +1142,7 @@ LISP_MACRO_DEFUN_VOID (CHECK_TYPE, (int ok, Lisp_Object Qxxxp, Lisp_Object x), typedef struct interval *INTERVAL; -struct Lisp_Cons +struct GCALIGNED Lisp_Cons { /* Car of this cons cell. */ Lisp_Object car; @@ -1099,7 +1224,7 @@ CDR_SAFE (Lisp_Object c) /* 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; @@ -1201,12 +1326,6 @@ STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize) { 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 @@ -1384,6 +1503,22 @@ gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val) XVECTOR (array)->contents[idx] = val; } +/* True, since Qnil's representation is zero. Every place in the code + that assumes Qnil is zero should verify (NIL_IS_ZERO), to make it easy + to find such assumptions later if we change Qnil to be nonzero. */ +enum { NIL_IS_ZERO = XLI_BUILTIN_LISPSYM (iQnil) == 0 }; + +/* Clear the object addressed by P, with size NBYTES, so that all its + bytes are zero and all its Lisp values are nil. */ +INLINE void +memclear (void *p, ptrdiff_t nbytes) +{ + eassert (0 <= nbytes); + verify (NIL_IS_ZERO); + /* Since Qnil is zero, memset suffices. */ + memset (p, 0, nbytes); +} + /* If a struct is made to look like a vector, this macro returns the length of the shortest vector that would hold that struct. */ @@ -1415,10 +1550,11 @@ gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val) 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 { @@ -1473,10 +1609,10 @@ struct Lisp_Sub_Char_Table 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]; @@ -1547,12 +1683,16 @@ struct Lisp_Subr 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. */ @@ -1564,77 +1704,14 @@ CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct) - CHAR_TABLE_STANDARD_SLOTS); } - +/* Make sure that sub char-table contents slot is where we think it is. */ +verify (offsetof (struct Lisp_Sub_Char_Table, contents) + == offsetof (struct Lisp_Vector, contents[SUB_CHAR_TABLE_OFFSET])); + /*********************************************************************** 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)) @@ -1708,8 +1785,9 @@ SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object 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 */ /*********************************************************************** @@ -2555,15 +2633,20 @@ CHECK_BOOL_VECTOR (Lisp_Object x) { 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) @@ -2690,38 +2773,14 @@ CHECK_NUMBER_CDR (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) @@ -2739,6 +2798,15 @@ enum maxargs UNEVALLED = -1 }; +/* Call a function F that accepts many args, passing it ARRAY's elements. */ +#define CALLMANY(f, array) (f) (ARRAYELTS (array), array) + +/* Call a function F that accepts many args, passing it the remaining args, + E.g., 'return CALLN (Fformat, fmt, text);' is less error-prone than + '{ Lisp_Object a[2]; a[0] = fmt; a[1] = text; return Fformat (2, a); }'. + CALLN is overkill for simple usages like 'Finsert (1, &text);'. */ +#define CALLN(f, ...) CALLMANY (f, ((Lisp_Object []) {__VA_ARGS__})) + extern void defvar_lisp (struct Lisp_Objfwd *, const char *, Lisp_Object *); extern void defvar_lisp_nopro (struct Lisp_Objfwd *, const char *, Lisp_Object *); extern void defvar_bool (struct Lisp_Boolfwd *, const char *, bool *); @@ -3036,6 +3104,16 @@ struct gcpro 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 }; @@ -3091,122 +3169,150 @@ struct gcpro #ifndef DEBUG_GCPRO -#define GCPRO1(varname) \ - {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \ - gcprolist = &gcpro1; } - -#define GCPRO2(varname1, varname2) \ - {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ - gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ - gcprolist = &gcpro2; } +#define 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 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 \ @@ -3232,15 +3338,6 @@ extern int gcpro_level; void staticpro (Lisp_Object *); -/* 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; @@ -3359,38 +3456,6 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object 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); enum Arith_Comparison { @@ -3436,7 +3501,6 @@ extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *); 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); @@ -3447,7 +3511,6 @@ extern void syms_of_cmds (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); @@ -3455,11 +3518,8 @@ extern void init_coding_once (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. */ @@ -3469,23 +3529,15 @@ extern void syms_of_charset (void); /* 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, @@ -3494,7 +3546,8 @@ ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); 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); @@ -3512,7 +3565,6 @@ extern Lisp_Object string_make_unibyte (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); @@ -3525,14 +3577,11 @@ extern void init_fringe_once (void); #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); @@ -3585,22 +3634,8 @@ _Noreturn void __executable_start (void); #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); @@ -3623,7 +3658,6 @@ extern void message_log_maybe_newline (void); 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); @@ -3638,6 +3672,10 @@ extern void syms_of_xsettings (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); @@ -3647,7 +3685,7 @@ extern _Noreturn void memory_full (size_t); 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; @@ -3731,8 +3769,6 @@ build_string (const char *str) 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 @@ -3755,16 +3791,39 @@ make_uninit_vector (ptrdiff_t size) return v; } -extern struct Lisp_Vector *allocate_pseudovector (int, int, enum pvec_type); -#define ALLOCATE_PSEUDOVECTOR(typ,field,tag) \ - ((typ*) \ - allocate_pseudovector \ - (VECSIZE (typ), PSEUDOVECSIZE (typ, field), tag)) -extern struct Lisp_Hash_Table *allocate_hash_table (void); -extern struct window *allocate_window (void); -extern struct frame *allocate_frame (void); -extern struct Lisp_Process *allocate_process (void); -extern struct terminal *allocate_terminal (void); +/* 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, int, + enum pvec_type); + +/* Allocate partially initialized pseudovector where all Lisp_Object + slots are set to Qnil but the rest (if any) is left uninitialized. */ + +#define ALLOCATE_PSEUDOVECTOR(type, field, tag) \ + ((type *) allocate_pseudovector (VECSIZE (type), \ + PSEUDOVECSIZE (type, field), \ + PSEUDOVECSIZE (type, field), tag)) + +/* Allocate fully initialized pseudovector where all Lisp_Object + slots are set to Qnil and the rest (if any) is zeroed. */ + +#define ALLOCATE_ZEROED_PSEUDOVECTOR(type, field, tag) \ + ((type *) allocate_pseudovector (VECSIZE (type), \ + PSEUDOVECSIZE (type, field), \ + VECSIZE (type), tag)) + extern bool gc_in_progress; extern bool abort_on_gc; extern Lisp_Object make_float (double); @@ -3788,6 +3847,7 @@ extern void init_alloc (void); 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 @@ -3796,21 +3856,18 @@ INLINE void (check_cons_list) (void) { lisp_h_check_cons_list (); } #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); @@ -3824,11 +3881,8 @@ extern void syms_of_chartab (void); /* 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); @@ -3852,12 +3906,11 @@ extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char const *, ptrdiff_t, 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) @@ -3888,10 +3941,9 @@ intern_c_string (const char *str) } /* 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; @@ -3903,7 +3955,7 @@ 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) @@ -3964,7 +4016,6 @@ extern bool let_shadows_global_binding_p (Lisp_Object symbol); /* 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); @@ -3977,7 +4028,6 @@ extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, 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); @@ -3991,7 +4041,7 @@ extern bool overlay_touches_p (ptrdiff_t); 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); @@ -4012,17 +4062,10 @@ extern void syms_of_marker (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); @@ -4031,11 +4074,10 @@ extern _Noreturn void report_file_error (const char *, Lisp_Object); extern bool internal_delete_file (Lisp_Object); extern Lisp_Object emacs_readlinkat (int, const char *); extern bool file_directory_p (const char *); -extern bool file_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); @@ -4045,16 +4087,30 @@ struct re_registers; extern struct re_pattern_buffer *compile_pattern (Lisp_Object, struct re_registers *, Lisp_Object, bool, bool); -extern ptrdiff_t fast_string_match (Lisp_Object, Lisp_Object); +extern ptrdiff_t fast_string_match_internal (Lisp_Object, Lisp_Object, + Lisp_Object); + +INLINE ptrdiff_t +fast_string_match (Lisp_Object regexp, Lisp_Object string) +{ + return fast_string_match_internal (regexp, string, Qnil); +} + +INLINE ptrdiff_t +fast_string_match_ignore_case (Lisp_Object regexp, Lisp_Object string) +{ + return fast_string_match_internal (regexp, string, Vascii_canon_table); +} + extern ptrdiff_t fast_c_string_match_ignore_case (Lisp_Object, const char *, ptrdiff_t); -extern ptrdiff_t fast_string_match_ignore_case (Lisp_Object, Lisp_Object); extern ptrdiff_t fast_looking_at (Lisp_Object, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, Lisp_Object); extern ptrdiff_t find_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, 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, @@ -4064,7 +4120,6 @@ extern void clear_regexp_cache (void); /* 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); @@ -4073,14 +4128,10 @@ extern void syms_of_minibuf (void); /* 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); @@ -4094,11 +4145,11 @@ extern void syms_of_casetab (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); @@ -4127,15 +4178,10 @@ extern bool indented_beyond_p (ptrdiff_t, ptrdiff_t, EMACS_INT); 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); @@ -4147,9 +4193,7 @@ extern bool display_arg; #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 @@ -4184,12 +4228,9 @@ extern bool inhibit_window_system; 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. @@ -4198,6 +4239,9 @@ extern bool wait_reading_process_output (intmax_t, int, int, bool, #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 @@ -4219,7 +4263,6 @@ extern void set_initial_environment (void); 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); @@ -4240,8 +4283,6 @@ extern void init_macros (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); @@ -4251,12 +4292,8 @@ extern void record_property_change (ptrdiff_t, ptrdiff_t, 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. */ @@ -4277,12 +4314,9 @@ extern char *get_current_dir_name (void); #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); @@ -4308,6 +4342,7 @@ extern void lock_file (Lisp_Object); 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); @@ -4342,9 +4377,6 @@ extern void init_font (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 */ @@ -4364,16 +4396,6 @@ extern void syms_of_w32notify (void); #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); @@ -4389,6 +4411,7 @@ extern void syms_of_xsmfns (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 */ @@ -4410,6 +4433,7 @@ extern void syms_of_decompress (void); #ifdef HAVE_DBUS /* Defined in dbusbind.c. */ +void init_dbusbind (void); void syms_of_dbusbind (void); #endif @@ -4424,34 +4448,49 @@ extern void syms_of_profiler (void); /* Defined in msdos.c, w32.c. */ extern char *emacs_root_dir (void); #endif /* DOS_NT */ - -/* 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; +} + +extern void xputenv (const char *); + +extern char *egetenv_internal (const char *, ptrdiff_t); -#define xlispstrdupa(string) \ - memcpy (alloca (SBYTES (string) + 1), \ - SSDATA (string), SBYTES (string) + 1) +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); @@ -4473,15 +4512,18 @@ 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 * @@ -4490,8 +4532,8 @@ extern void *record_xmalloc (size_t); #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)); \ @@ -4500,6 +4542,14 @@ extern void *record_xmalloc (size_t); } \ } 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() \ @@ -4511,13 +4561,29 @@ extern void *record_xmalloc (size_t); } 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); \ @@ -4529,6 +4595,114 @@ extern void *record_xmalloc (size_t); 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'. */ |