X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/70de5e86d84fc12c6115153c3d6276243cf2b995..7479dd3e8afeac3925c1d5e23d5296623852cff8:/src/lisp.h
diff --git a/src/lisp.h b/src/lisp.h
index b70ca9e9f7..bbe2e4e9ce 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1,6 +1,6 @@
/* Fundamental definitions for GNU Emacs Lisp interpreter.
-Copyright (C) 1985-1987, 1993-1995, 1997-2013 Free Software Foundation,
+Copyright (C) 1985-1987, 1993-1995, 1997-2014 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
@@ -24,7 +24,6 @@ along with GNU Emacs. If not, see . */
#include
#include
#include
-#include
#include
#include
#include
@@ -45,7 +44,7 @@ INLINE_HEADER_BEGIN
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). */
-#ifdef MAIN_PROGRAM
+#if defined MAIN_PROGRAM
# define DEFINE_GDB_SYMBOL_BEGIN(type, id) type const id EXTERNALLY_VISIBLE
# define DEFINE_GDB_SYMBOL_END(id) = id;
#else
@@ -59,26 +58,52 @@ 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__))
+# 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
EMACS_UINT - unsigned variant of EMACS_INT */
#ifndef EMACS_INT_MAX
-# if LONG_MAX < LLONG_MAX && defined WIDE_EMACS_INT
-typedef long long int EMACS_INT;
-typedef unsigned long long int EMACS_UINT;
-# define EMACS_INT_MAX LLONG_MAX
-# define pI "ll"
-# elif INT_MAX < LONG_MAX
+# if INTPTR_MAX <= 0
+# error "INTPTR_MAX misconfigured"
+# 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 >> 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;
+# define EMACS_INT_MAX LLONG_MAX
+# define pI "ll"
# else
-typedef int EMACS_INT;
-typedef unsigned int EMACS_UINT;
-# define EMACS_INT_MAX INT_MAX
-# define pI ""
+# error "INTPTR_MAX too large"
# endif
#endif
@@ -90,25 +115,24 @@ 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 (BITSIZEOF_SIZE_T == CHAR_BIT * SIZEOF_SIZE_T \
- && BOOL_VECTOR_BITS_PER_CHAR == CHAR_BIT)
+#if BOOL_VECTOR_BITS_PER_CHAR == CHAR_BIT
typedef size_t bits_word;
-#define BITS_WORD_MAX SIZE_MAX
+# define BITS_WORD_MAX SIZE_MAX
enum { BITS_PER_BITS_WORD = CHAR_BIT * sizeof (bits_word) };
#else
typedef unsigned char bits_word;
-#define BITS_WORD_MAX ((1u << BOOL_VECTOR_BITS_PER_CHAR) - 1)
+# define BITS_WORD_MAX ((1u << BOOL_VECTOR_BITS_PER_CHAR) - 1)
enum { BITS_PER_BITS_WORD = BOOL_VECTOR_BITS_PER_CHAR };
#endif
+verify (BITS_WORD_MAX >> (BITS_PER_BITS_WORD - 1) == 1);
/* Number of bits in some machine integer types. */
enum
{
BITS_PER_CHAR = CHAR_BIT,
BITS_PER_SHORT = CHAR_BIT * sizeof (short),
- BITS_PER_INT = CHAR_BIT * sizeof (int),
BITS_PER_LONG = CHAR_BIT * sizeof (long int),
BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT)
};
@@ -171,7 +195,7 @@ typedef EMACS_UINT uprintmax_t;
for COND to call external functions or access volatile storage. */
#ifndef ENABLE_CHECKING
-# define eassert(cond) ((void) (0 && (cond))) /* Check that COND compiles. */
+# define eassert(cond) ((void) (false && (cond))) /* Check COND compiles. */
# define eassume(cond) assume (cond)
#else /* ENABLE_CHECKING */
@@ -212,12 +236,6 @@ extern bool suppress_checking EXTERNALLY_VISIBLE;
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
@@ -241,31 +259,19 @@ enum Lisp_Bits
This can be used in #if, e.g., '#if VAL_MAX < UINTPTR_MAX' below. */
#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.
+/* Whether the least-significant bits of an EMACS_INT contain the tag.
On hosts where pointers-as-ints do not exceed VAL_MAX, USE_LSB_TAG is:
a. unnecessary, because the top bits of an EMACS_INT are unused, and
b. slower, because it typically requires extra masking.
- So, default USE_LSB_TAG to 1 only on hosts where it might be useful. */
-# if VAL_MAX < UINTPTR_MAX
-# define USE_LSB_TAG 1
-# endif
-# endif
-# endif
-#endif
-#ifdef USE_LSB_TAG
-# undef USE_LSB_TAG
-enum enum_USE_LSB_TAG { USE_LSB_TAG = 1 };
-# define USE_LSB_TAG 1
-#else
-enum enum_USE_LSB_TAG { USE_LSB_TAG = 0 };
-# define USE_LSB_TAG 0
+ 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 (EMACS_INT_MAX >> GCTYPEBITS < 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
@@ -340,15 +346,15 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = 0 };
#define lisp_h_XCONS(a) \
(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))
+#define lisp_h_XPNTR(a) ((void *) (intptr_t) (XLI (a) & VALMASK))
#define lisp_h_XSYMBOL(a) \
(eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol))
#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))
# define lisp_h_XFASTINT(a) XINT (a)
# define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS)
# define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
@@ -357,7 +363,7 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = 0 };
/* When compiling via gcc -O0, define the key operations as macros, as
Emacs is too slow otherwise. To disable this optimization, compile
- with -DINLINING=0. */
+ with -DINLINING=false. */
#if (defined __NO_INLINE__ \
&& ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \
&& ! (defined INLINING && ! INLINING))
@@ -551,14 +557,14 @@ typedef struct { EMACS_INT i; } Lisp_Object;
#define LISP_INITIALLY_ZERO {0}
#undef CHECK_LISP_OBJECT_TYPE
-enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 1 };
+enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true };
#else /* CHECK_LISP_OBJECT_TYPE */
/* If a struct type is not wanted, define Lisp_Object as just a number. */
typedef EMACS_INT Lisp_Object;
#define LISP_INITIALLY_ZERO 0
-enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 0 };
+enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false };
#endif /* CHECK_LISP_OBJECT_TYPE */
/* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa.
@@ -602,18 +608,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).
@@ -630,7 +626,7 @@ enum More_Lisp_Bits
/* Used to extract pseudovector subtype information. */
PSEUDOVECTOR_AREA_BITS = PSEUDOVECTOR_SIZE_BITS + PSEUDOVECTOR_REST_BITS,
- PVEC_TYPE_MASK = 0x3f << PSEUDOVECTOR_AREA_BITS,
+ PVEC_TYPE_MASK = 0x3f << PSEUDOVECTOR_AREA_BITS
};
/* These functions extract various sorts of values from a Lisp_Object.
@@ -669,7 +665,14 @@ 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);
+ if (USE_LSB_TAG)
+ {
+ EMACS_UINT u = n;
+ n = u << INTTYPEBITS;
+ }
+ else
+ n &= INTMASK;
+ return XIL (n);
}
/* Extract A's value as a signed integer. */
@@ -677,7 +680,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.
@@ -737,7 +745,7 @@ make_natnum (EMACS_INT n)
/* Return true if X and Y are the same object. */
LISP_MACRO_DEFUN (EQ, bool, (Lisp_Object x, Lisp_Object y), (x, y))
-/* Value is non-zero if I doesn't fit into a Lisp fixnum. It is
+/* Value is true if I doesn't fit into a Lisp fixnum. It is
written this way so that it also works if I is of unsigned
type or if I is a NaN. */
@@ -797,6 +805,7 @@ extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
/* Defined in emacs.c. */
extern bool initialized;
+extern bool might_dump;
/* Defined in eval.c. */
extern Lisp_Object Qautoload;
@@ -1086,17 +1095,23 @@ STRING_MULTIBYTE (Lisp_Object str)
((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, min (SIZE_MAX, PTRDIFF_MAX) - 1))
/* Mark STR as a unibyte string. */
-#define STRING_SET_UNIBYTE(STR) \
- do { if (EQ (STR, empty_multibyte_string)) \
- (STR) = empty_unibyte_string; \
- else XSTRING (STR)->size_byte = -1; } while (0)
+#define STRING_SET_UNIBYTE(STR) \
+ do { \
+ if (EQ (STR, empty_multibyte_string)) \
+ (STR) = empty_unibyte_string; \
+ else \
+ XSTRING (STR)->size_byte = -1; \
+ } while (false)
/* Mark STR as a multibyte string. Assure that STR contains only
ASCII characters in advance. */
-#define STRING_SET_MULTIBYTE(STR) \
- do { if (EQ (STR, empty_unibyte_string)) \
- (STR) = empty_multibyte_string; \
- else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0)
+#define STRING_SET_MULTIBYTE(STR) \
+ do { \
+ if (EQ (STR, empty_unibyte_string)) \
+ (STR) = empty_multibyte_string; \
+ else \
+ XSTRING (STR)->size_byte = XSTRING (STR)->size; \
+ } while (false)
/* Convenience functions for dealing with Lisp strings. */
@@ -1212,7 +1227,10 @@ struct Lisp_Bool_Vector
struct vectorlike_header header;
/* This is the size in bits. */
EMACS_INT size;
- /* This contains the actual bits, packed into bytes. */
+ /* The actual bits, packed into bytes.
+ Zeros fill out the last word if needed.
+ The bits are in little-endian order in the bytes, and
+ the bytes are in little-endian order in the words. */
bits_word data[FLEXIBLE_ARRAY_MEMBER];
};
@@ -1236,7 +1254,7 @@ bool_vector_uchar_data (Lisp_Object a)
return (unsigned char *) bool_vector_data (a);
}
-/* The number of data words in a bool vector with SIZE bits. */
+/* The number of data words and bytes in a bool vector with SIZE bits. */
INLINE EMACS_INT
bool_vector_words (EMACS_INT size)
@@ -1245,6 +1263,13 @@ bool_vector_words (EMACS_INT size)
return (size + BITS_PER_BITS_WORD - 1) / BITS_PER_BITS_WORD;
}
+INLINE EMACS_INT
+bool_vector_bytes (EMACS_INT size)
+{
+ eassume (0 <= size && size <= EMACS_INT_MAX - (BITS_PER_BITS_WORD - 1));
+ return (size + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR;
+}
+
/* True if A's Ith bit is set. */
INLINE bool
@@ -1339,14 +1364,14 @@ gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
/* Compute A OP B, using the unsigned comparison operator OP. A and B
should be integer expressions. This is not the same as
mathematical comparison; for example, UNSIGNED_CMP (0, <, -1)
- returns 1. For efficiency, prefer plain unsigned comparison if A
+ returns true. For efficiency, prefer plain unsigned comparison if A
and B's sizes both fit (after integer promotion). */
#define UNSIGNED_CMP(a, op, b) \
(max (sizeof ((a) + 0), sizeof ((b) + 0)) <= sizeof (unsigned) \
? ((a) + (unsigned) 0) op ((b) + (unsigned) 0) \
: ((a) + (uintmax_t) 0) op ((b) + (uintmax_t) 0))
-/* Nonzero iff C is an ASCII character. */
+/* True iff C is an ASCII character. */
#define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80)
/* A char-table is a kind of vectorlike, with contents are like a
@@ -1527,7 +1552,7 @@ enum symbol_redirect
struct Lisp_Symbol
{
- unsigned gcmarkbit : 1;
+ bool_bf gcmarkbit : 1;
/* Indicates where the value can be found:
0 : it's a plain var, the value is in the `value' field.
@@ -1545,9 +1570,12 @@ struct Lisp_Symbol
enum symbol_interned. */
unsigned interned : 2;
- /* Non-zero means that this variable has been explicitly declared
+ /* True means that this variable has been explicitly declared
special (with `defvar' etc), and shouldn't be lexically bound. */
- unsigned declared_special : 1;
+ 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;
@@ -1645,7 +1673,7 @@ 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 (0)
+ do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (false)
/***********************************************************************
@@ -1690,8 +1718,8 @@ struct Lisp_Hash_Table
ratio, a float. */
Lisp_Object rehash_threshold;
- /* Vector of hash codes.. If hash[I] is nil, this means that that
- entry I is unused. */
+ /* Vector of hash codes. If hash[I] is nil, this means that the
+ I-th entry is unused. */
Lisp_Object hash;
/* Vector used to chain entries. If entry I is free, next[I] is the
@@ -1823,22 +1851,22 @@ SXHASH_REDUCE (EMACS_UINT x)
struct Lisp_Misc_Any /* Supertype of all Misc types. */
{
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_??? */
- unsigned gcmarkbit : 1;
+ bool_bf gcmarkbit : 1;
unsigned spacer : 15;
};
struct Lisp_Marker
{
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Marker */
- unsigned gcmarkbit : 1;
+ bool_bf gcmarkbit : 1;
unsigned spacer : 13;
/* This flag is temporarily used in the functions
decode/encode_coding_object to record that the marker position
must be adjusted after the conversion. */
- unsigned int need_adjustment : 1;
- /* 1 means normal insertion at the marker's position
+ bool_bf need_adjustment : 1;
+ /* True means normal insertion at the marker's position
leaves the marker after the inserted text. */
- unsigned int insertion_type : 1;
+ bool_bf insertion_type : 1;
/* This is the buffer that the marker points into, or 0 if it points nowhere.
Note: a chain of markers can contain markers pointing into different
buffers (the chain is per buffer_text rather than per buffer, so it's
@@ -1884,7 +1912,7 @@ struct Lisp_Overlay
*/
{
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Overlay */
- unsigned gcmarkbit : 1;
+ bool_bf gcmarkbit : 1;
unsigned spacer : 15;
struct Lisp_Overlay *next;
Lisp_Object start;
@@ -1962,7 +1990,7 @@ typedef void (*voidfuncptr) (void);
struct Lisp_Save_Value
{
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */
- unsigned gcmarkbit : 1;
+ bool_bf gcmarkbit : 1;
unsigned spacer : 32 - (16 + 1 + SAVE_TYPE_BITS);
/* V->data may hold up to SAVE_VALUE_SLOTS entries. The type of
@@ -2038,7 +2066,7 @@ XSAVE_OBJECT (Lisp_Object obj, int n)
struct Lisp_Free
{
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Free */
- unsigned gcmarkbit : 1;
+ bool_bf gcmarkbit : 1;
unsigned spacer : 15;
union Lisp_Misc *chain;
};
@@ -2107,8 +2135,8 @@ struct Lisp_Intfwd
/* Boolean forwarding pointer to an int variable.
This is like Lisp_Intfwd except that the ostensible
- "value" of the symbol is t if the int variable is nonzero,
- nil if it is zero. */
+ "value" of the symbol is t if the bool variable is true,
+ nil if it is false. */
struct Lisp_Boolfwd
{
enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Bool */
@@ -2161,15 +2189,15 @@ struct Lisp_Buffer_Objfwd
struct Lisp_Buffer_Local_Value
{
- /* 1 means that merely setting the variable creates a local
+ /* True means that merely setting the variable creates a local
binding for the current buffer. */
- unsigned int local_if_set : 1;
- /* 1 means this variable can have frame-local bindings, otherwise, it is
+ bool_bf local_if_set : 1;
+ /* True means this variable can have frame-local bindings, otherwise, it is
can have buffer-local bindings. The two cannot be combined. */
- unsigned int frame_local : 1;
- /* 1 means that the binding now loaded was found.
+ bool_bf frame_local : 1;
+ /* True means that the binding now loaded was found.
Presumably equivalent to (defcell!=valcell). */
- unsigned int found : 1;
+ bool_bf found : 1;
/* If non-NULL, a forwarding to the C var where it should also be set. */
union Lisp_Fwd *fwd; /* Should never be (Buffer|Kboard)_Objfwd. */
/* The buffer or frame for which the loaded binding was found. */
@@ -2364,7 +2392,7 @@ INLINE bool
PSEUDOVECTORP (Lisp_Object a, int code)
{
if (! VECTORLIKEP (a))
- return 0;
+ return false;
else
{
/* Converting to struct vectorlike_header * avoids aliasing issues. */
@@ -2511,11 +2539,13 @@ CHECK_WINDOW (Lisp_Object x)
{
CHECK_TYPE (WINDOWP (x), Qwindowp, x);
}
+#ifdef subprocesses
INLINE void
CHECK_PROCESS (Lisp_Object x)
{
CHECK_TYPE (PROCESSP (x), Qprocessp, x);
}
+#endif
INLINE void
CHECK_NATNUM (Lisp_Object x)
{
@@ -2532,18 +2562,22 @@ CHECK_NATNUM (Lisp_Object x)
? MOST_NEGATIVE_FIXNUM \
: (lo)), \
make_number (min (hi, MOST_POSITIVE_FIXNUM))); \
- } while (0)
+ } while (false)
#define CHECK_TYPE_RANGED_INTEGER(type, x) \
do { \
if (TYPE_SIGNED (type)) \
CHECK_RANGED_INTEGER (x, TYPE_MINIMUM (type), TYPE_MAXIMUM (type)); \
else \
CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \
- } while (0)
+ } while (false)
-#define CHECK_NUMBER_COERCE_MARKER(x) \
- do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \
- else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0)
+#define CHECK_NUMBER_COERCE_MARKER(x) \
+ do { \
+ if (MARKERP ((x))) \
+ XSETFASTINT (x, marker_position (x)); \
+ else \
+ CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); \
+ } while (false)
INLINE double
XFLOATINT (Lisp_Object n)
@@ -2557,9 +2591,13 @@ CHECK_NUMBER_OR_FLOAT (Lisp_Object x)
CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x);
}
-#define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \
- do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \
- else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0)
+#define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \
+ do { \
+ if (MARKERP (x)) \
+ XSETFASTINT (x, marker_position (x)); \
+ else \
+ CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); \
+ } while (false)
/* Since we can't assign directly to the CAR or CDR fields of a cons
cell, use these when checking that those fields contain numbers. */
@@ -2616,16 +2654,11 @@ 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
@@ -2692,34 +2725,34 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
do { \
static struct Lisp_Objfwd o_fwd; \
defvar_lisp (&o_fwd, lname, &globals.f_ ## vname); \
- } while (0)
+ } while (false)
#define DEFVAR_LISP_NOPRO(lname, vname, doc) \
do { \
static struct Lisp_Objfwd o_fwd; \
defvar_lisp_nopro (&o_fwd, lname, &globals.f_ ## vname); \
- } while (0)
+ } while (false)
#define DEFVAR_BOOL(lname, vname, doc) \
do { \
static struct Lisp_Boolfwd b_fwd; \
defvar_bool (&b_fwd, lname, &globals.f_ ## vname); \
- } while (0)
+ } while (false)
#define DEFVAR_INT(lname, vname, doc) \
do { \
static struct Lisp_Intfwd i_fwd; \
defvar_int (&i_fwd, lname, &globals.f_ ## vname); \
- } while (0)
+ } while (false)
#define DEFVAR_BUFFER_DEFAULTS(lname, vname, doc) \
do { \
static struct Lisp_Objfwd o_fwd; \
defvar_lisp_nopro (&o_fwd, lname, &BVAR (&buffer_defaults, vname)); \
- } while (0)
+ } while (false)
#define DEFVAR_KBOARD(lname, vname, doc) \
do { \
static struct Lisp_Kboard_Objfwd ko_fwd; \
defvar_kboard (&ko_fwd, lname, offsetof (KBOARD, vname ## _)); \
- } while (0)
+ } while (false)
/* Save and restore the instruction and environment pointers,
without affecting the signal mask. */
@@ -2803,7 +2836,7 @@ union specbinding
} let;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
- unsigned debug_on_exit : 1;
+ bool_bf debug_on_exit : 1;
Lisp_Object function;
Lisp_Object *args;
ptrdiff_t nargs;
@@ -2860,7 +2893,7 @@ struct handler
/* Most global vars are reset to their value via the specpdl mechanism,
but a few others are handled by storing their value here. */
-#if 1 /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but they're defined later. */
+#if true /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but defined later. */
struct gcpro *gcpro;
#endif
sys_jmp_buf jmp;
@@ -2908,7 +2941,7 @@ extern char *stack_bottom;
Unless that is impossible, of course.
But it is very desirable to avoid creating loops where QUIT is impossible.
- Exception: if you set immediate_quit to nonzero,
+ Exception: if you set immediate_quit to true,
then the handler that responds to the C-g does the quit itself.
This is a good thing to do around a loop that has no side effects
and (in particular) cannot call arbitrary Lisp code.
@@ -2926,10 +2959,10 @@ extern void process_quit_flag (void);
process_quit_flag (); \
else if (pending_signals) \
process_pending_signals (); \
- } while (0)
+ } while (false)
-/* Nonzero if ought to quit now. */
+/* True if ought to quit now. */
#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
@@ -3010,6 +3043,7 @@ struct gcpro
#define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \
((void) gcpro6, (void) gcpro5, (void) gcpro4, (void) gcpro3, (void) gcpro2, \
(void) gcpro1)
+#define GCPRO7(a, b, c, d, e, f, g) (GCPRO6 (a, b, c, d, e, f), (void) gcpro7)
#define UNGCPRO ((void) 0)
#else /* GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS */
@@ -3055,6 +3089,16 @@ struct gcpro
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 UNGCPRO (gcprolist = gcpro1.next)
#else
@@ -3111,10 +3155,22 @@ extern int gcpro_level;
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; }
+
#define UNGCPRO \
- ((--gcpro_level != gcpro1.level) \
- ? (emacs_abort (), 0) \
- : ((gcprolist = gcpro1.next), 0))
+ (--gcpro_level != gcpro1.level \
+ ? emacs_abort () \
+ : (void) (gcprolist = gcpro1.next))
#endif /* DEBUG_GCPRO */
#endif /* GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS */
@@ -3122,14 +3178,14 @@ extern int gcpro_level;
/* Evaluate expr, UNGCPRO, and then return the value of expr. */
#define RETURN_UNGCPRO(expr) \
-do \
+ do \
{ \
Lisp_Object ret_ungc_val; \
ret_ungc_val = (expr); \
UNGCPRO; \
return ret_ungc_val; \
} \
-while (0)
+ while (false)
/* Call staticpro (&var) to protect static variable `var'. */
@@ -3470,6 +3526,7 @@ extern Lisp_Object del_range_2 (ptrdiff_t, ptrdiff_t,
extern void modify_text (ptrdiff_t, ptrdiff_t);
extern void prepare_to_modify_buffer (ptrdiff_t, ptrdiff_t, ptrdiff_t *);
extern void prepare_to_modify_buffer_1 (ptrdiff_t, ptrdiff_t, ptrdiff_t *);
+extern void invalidate_buffer_caches (struct buffer *, ptrdiff_t, ptrdiff_t);
extern void signal_after_change (ptrdiff_t, ptrdiff_t, ptrdiff_t);
extern void adjust_after_insert (ptrdiff_t, ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t);
@@ -3513,7 +3570,7 @@ extern void pop_message_unwind (void);
extern Lisp_Object restore_message_unwind (Lisp_Object);
extern void restore_message (void);
extern Lisp_Object current_message (void);
-extern void clear_message (int, int);
+extern void clear_message (bool, bool);
extern void message (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
extern void message1 (const char *);
extern void message1_nolog (const char *);
@@ -3526,7 +3583,6 @@ extern void update_echo_area (void);
extern void truncate_echo_area (ptrdiff_t);
extern void redisplay (void);
extern void redisplay_preserve_echo_area (int);
-extern void prepare_menu_bars (void);
void set_frame_cursor_types (struct frame *, Lisp_Object);
extern void syms_of_xdisp (void);
@@ -3589,7 +3645,8 @@ list4i (EMACS_INT x, EMACS_INT y, EMACS_INT w, EMACS_INT h)
make_number (w), make_number (h));
}
-extern void bool_vector_fill (Lisp_Object, Lisp_Object);
+extern Lisp_Object make_uninit_bool_vector (EMACS_INT);
+extern Lisp_Object bool_vector_fill (Lisp_Object, Lisp_Object);
extern _Noreturn void string_overflow (void);
extern Lisp_Object make_string (const char *, ptrdiff_t);
extern Lisp_Object make_formatted_string (char *, const char *, ...)
@@ -3698,9 +3755,9 @@ 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
@@ -3768,7 +3825,7 @@ LOADHIST_ATTACH (Lisp_Object x)
Vcurrent_load_list = Fcons (x, Vcurrent_load_list);
}
extern int openp (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object *, Lisp_Object);
+ Lisp_Object *, Lisp_Object, bool);
extern Lisp_Object string_to_number (char const *, int, bool);
extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object),
Lisp_Object);
@@ -3894,7 +3951,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);
@@ -3977,6 +4034,7 @@ extern void syms_of_minibuf (void);
/* Defined in callint.c. */
extern Lisp_Object Qminus, Qplus;
+extern Lisp_Object Qprogn;
extern Lisp_Object Qwhen;
extern Lisp_Object Qmouse_leave_buffer_hook;
extern void syms_of_callint (void);
@@ -4032,10 +4090,11 @@ 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 || defined WINDOWSNT
+#if HAVE_NS || HAVE_NTGUI
extern Lisp_Object get_frame_param (struct frame *, Lisp_Object);
#endif
extern void frames_discard_buffer (Lisp_Object);
@@ -4047,7 +4106,7 @@ extern int initial_argc;
#if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
extern bool display_arg;
#endif
-extern Lisp_Object decode_env_path (const char *, const char *);
+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);
@@ -4087,7 +4146,6 @@ extern bool running_asynch_code;
/* Defined in process.c. */
extern Lisp_Object QCtype, Qlocal;
-extern Lisp_Object Qprocessp;
extern void kill_buffer_processes (Lisp_Object);
extern bool wait_reading_process_output (intmax_t, int, int, bool,
Lisp_Object,
@@ -4146,9 +4204,8 @@ extern void syms_of_macros (void);
extern Lisp_Object Qapply;
extern Lisp_Object Qinhibit_read_only;
extern void truncate_undo_list (struct buffer *);
-extern void record_marker_adjustment (Lisp_Object, ptrdiff_t);
extern void record_insert (ptrdiff_t, ptrdiff_t);
-extern void record_delete (ptrdiff_t, Lisp_Object);
+extern void record_delete (ptrdiff_t, Lisp_Object, bool);
extern void record_first_change (void);
extern void record_change (ptrdiff_t, ptrdiff_t);
extern void record_property_change (ptrdiff_t, ptrdiff_t,
@@ -4185,8 +4242,6 @@ 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);
@@ -4336,16 +4391,18 @@ extern bool initialized;
/* 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 *);
@@ -4376,16 +4433,16 @@ 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_count = SPECPDL_INDEX (); bool sa_must_free = 0
+ ptrdiff_t sa_count = SPECPDL_INDEX (); bool sa_must_free = false
/* SAFE_ALLOCA allocates a simple buffer. */
#define SAFE_ALLOCA(size) ((size) < MAX_ALLOCA \
? alloca (size) \
- : (sa_must_free = 1, record_xmalloc (size)))
+ : (sa_must_free = true, record_xmalloc (size)))
/* SAFE_NALLOCA sets BUF to a newly allocated array of MULTIPLIER *
NITEMS items, each of the same type as *BUF. MULTIPLIER must
@@ -4398,20 +4455,20 @@ extern void *record_xmalloc (size_t);
else \
{ \
(buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \
- sa_must_free = 1; \
+ sa_must_free = true; \
record_unwind_protect_ptr (xfree, buf); \
} \
- } while (0)
+ } while (false)
/* SAFE_FREE frees xmalloced memory and enables GC as needed. */
#define SAFE_FREE() \
do { \
if (sa_must_free) { \
- sa_must_free = 0; \
+ sa_must_free = false; \
unbind_to (sa_count, Qnil); \
} \
- } while (0)
+ } while (false)
/* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects. */
@@ -4419,25 +4476,40 @@ extern void *record_xmalloc (size_t);
#define SAFE_ALLOCA_LISP(buf, nelt) \
do { \
if ((nelt) < MAX_ALLOCA / word_size) \
- buf = alloca ((nelt) * word_size); \
+ (buf) = alloca ((nelt) * word_size); \
else if ((nelt) < min (PTRDIFF_MAX, SIZE_MAX) / word_size) \
{ \
Lisp_Object arg_; \
- buf = xmalloc ((nelt) * word_size); \
+ (buf) = xmalloc ((nelt) * word_size); \
arg_ = make_save_memory (buf, nelt); \
- sa_must_free = 1; \
+ sa_must_free = true; \
record_unwind_protect (free_save_value, arg_); \
} \
else \
memory_full (SIZE_MAX); \
- } while (0)
+ } while (false)
+
+/* 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'. */
+#define FOR_EACH_TAIL(hare, list, tortoise, n) \
+ for ((tortoise) = (hare) = (list), (n) = true; \
+ CONSP (hare); \
+ (hare = XCDR (hare), (n) = !(n), \
+ ((n) \
+ ? (EQ (hare, tortoise) \
+ ? xsignal1 (Qcircular_list, list) \
+ : (void) 0) \
+ /* Move tortoise before the next iteration, in case */ \
+ /* the next iteration does an Fsetcdr. */ \
+ : (void) ((tortoise) = XCDR (tortoise)))))
/* Do a `for' loop over alist values. */
#define FOR_EACH_ALIST_VALUE(head_var, list_var, value_var) \
- for (list_var = head_var; \
- (CONSP (list_var) && (value_var = XCDR (XCAR (list_var)), 1)); \
- list_var = XCDR (list_var))
+ for ((list_var) = (head_var); \
+ (CONSP (list_var) && ((value_var) = XCDR (XCAR (list_var)), true)); \
+ (list_var) = XCDR (list_var))
/* Check whether it's time for GC, and run it if so. */
@@ -4473,14 +4545,14 @@ functionp (Lisp_Object object)
if (SUBRP (object))
return XSUBR (object)->max_args != UNEVALLED;
else if (COMPILEDP (object))
- return 1;
+ return true;
else if (CONSP (object))
{
Lisp_Object car = XCAR (object);
return EQ (car, Qlambda) || EQ (car, Qclosure);
}
else
- return 0;
+ return false;
}
INLINE_HEADER_END