/* 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.
#include <setjmp.h>
#include <stdalign.h>
#include <stdarg.h>
-#include <stdbool.h>
#include <stddef.h>
#include <float.h>
#include <inttypes.h>
INLINE_HEADER_BEGIN
+/* Define a TYPE constant ID as an externally visible name. Use like this:
+
+ DEFINE_GDB_SYMBOL_BEGIN (TYPE, ID)
+ #define ID something
+ DEFINE_GDB_SYMBOL_END (ID)
+
+ 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). */
+#if defined MAIN_PROGRAM
+# define DEFINE_GDB_SYMBOL_BEGIN(type, id) type const id EXTERNALLY_VISIBLE
+# define DEFINE_GDB_SYMBOL_END(id) = id;
+#else
+# define DEFINE_GDB_SYMBOL_BEGIN(type, id)
+# define DEFINE_GDB_SYMBOL_END(val)
+#endif
+
/* The ubiquitous max and min macros. */
#undef min
#undef max
#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
+# 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"
-# elif INT_MAX < LONG_MAX
-typedef long int EMACS_INT;
-typedef unsigned long int EMACS_UINT;
-# define EMACS_INT_MAX LONG_MAX
-# define pI "l"
# 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
+/* Number of bits to put in each character in the internal representation
+ of bool vectors. This should not vary across implementations. */
+enum { BOOL_VECTOR_BITS_PER_CHAR =
+#define BOOL_VECTOR_BITS_PER_CHAR 8
+ BOOL_VECTOR_BITS_PER_CHAR
+};
+
+/* An unsigned integer type representing a fixed-length bit sequence,
+ 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;
+# 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)
+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)
};
/* Extra internal type checking? */
-/* Define an Emacs version of 'assert (COND)', since some
- system-defined 'assert's are flaky. COND should be free of side
- effects; it may or may not be evaluated. */
+/* Define Emacs versions of <assert.h>'s 'assert (COND)' and <verify.h>'s
+ 'assume (COND)'. COND should be free of side effects, as it may or
+ may not be evaluated.
+
+ 'eassert (COND)' checks COND at runtime if ENABLE_CHECKING is
+ defined and suppress_checking is false, and does nothing otherwise.
+ Emacs dies if COND is checked and is false. The suppress_checking
+ variable is initialized to 0 in alloc.c. Set it to 1 using a
+ debugger to temporarily disable aborting on detected internal
+ inconsistencies or error conditions.
+
+ In some cases, a good compiler may be able to optimize away the
+ eassert macro even if ENABLE_CHECKING is true, e.g., if XSTRING (x)
+ uses eassert to test STRINGP (x), but a particular use of XSTRING
+ is invoked only after testing that STRINGP (x) is true, making the
+ test redundant.
+
+ eassume is like eassert except that it also causes the compiler to
+ assume that COND is true afterwards, regardless of whether runtime
+ checking is enabled. This can improve performance in some cases,
+ though it can degrade performance in others. It's often suboptimal
+ for COND to call external functions or access volatile storage. */
+
#ifndef ENABLE_CHECKING
-# define eassert(X) ((void) (0 && (X))) /* Check that X compiles. */
+# define eassert(cond) ((void) (false && (cond))) /* Check COND compiles. */
+# define eassume(cond) assume (cond)
#else /* ENABLE_CHECKING */
extern _Noreturn void die (const char *, const char *, int);
-/* The suppress_checking variable is initialized to 0 in alloc.c. Set
- it to 1 using a debugger to temporarily disable aborting on
- detected internal inconsistencies or error conditions.
-
- In some cases, a good compiler may be able to optimize away the
- eassert macro altogether, e.g., if XSTRING (x) uses eassert to test
- STRINGP (x), but a particular use of XSTRING is invoked only after
- testing that STRINGP (x) is true, making the test redundant. */
extern bool suppress_checking EXTERNALLY_VISIBLE;
# define eassert(cond) \
(suppress_checking || (cond) \
? (void) 0 \
: die (# cond, __FILE__, __LINE__))
+# define eassume(cond) \
+ (suppress_checking \
+ ? assume (cond) \
+ : (cond) \
+ ? (void) 0 \
+ : die (# cond, __FILE__, __LINE__))
#endif /* ENABLE_CHECKING */
-/* When checking is enabled, identical to eassert. When checking is
- * disabled, instruct the compiler (when the compiler has such
- * capability) to assume that cond is true and optimize
- * accordingly. */
-#define eassert_and_assume(cond) (eassert (cond), assume (cond))
-
\f
/* Use the configure flag --enable-check-lisp-object-type to make
Lisp_Object use a struct type instead of the default int. The flag
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
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
#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))
/* 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))
#define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
/* Idea stolen from GDB. Pedantic GCC complains about enum bitfields,
- MSVC doesn't support them, and xlc complains vociferously about them. */
-#if defined __STRICT_ANSI__ || defined _MSC_VER || defined __IBMC__
+ MSVC doesn't support them, and xlc and Oracle Studio c99 complain
+ vociferously about them. */
+#if (defined __STRICT_ANSI__ || defined _MSC_VER || defined __IBMC__ \
+ || (defined __SUNPRO_C && __STDC__))
#define ENUM_BF(TYPE) unsigned int
#else
#define ENUM_BF(TYPE) enum TYPE
#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.
/* In the size word of a vector, this bit means the vector has been marked. */
-static ptrdiff_t const ARRAY_MARK_FLAG
+DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, ARRAY_MARK_FLAG)
#define ARRAY_MARK_FLAG PTRDIFF_MIN
- = ARRAY_MARK_FLAG;
+DEFINE_GDB_SYMBOL_END (ARRAY_MARK_FLAG)
/* In the size word of a struct Lisp_Vector, this bit means it's really
some other vector-like object. */
-static ptrdiff_t const PSEUDOVECTOR_FLAG
+DEFINE_GDB_SYMBOL_BEGIN (ptrdiff_t, PSEUDOVECTOR_FLAG)
#define PSEUDOVECTOR_FLAG (PTRDIFF_MAX - PTRDIFF_MAX / 2)
- = PSEUDOVECTOR_FLAG;
+DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
/* In a pseudovector, the size field actually contains a word with one
PSEUDOVECTOR_FLAG bit set, and one of the following values extracted
PVEC_FONT /* Should be last because it's used for range checking. */
};
-/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
- which were stored in a Lisp_Object. */
-#ifndef DATA_SEG_BITS
-# define DATA_SEG_BITS 0
-#endif
-enum { gdb_DATA_SEG_BITS = DATA_SEG_BITS };
-#undef DATA_SEG_BITS
-
enum More_Lisp_Bits
{
- DATA_SEG_BITS = gdb_DATA_SEG_BITS,
-
/* For convenience, we also store the number of elements in these bits.
Note that this size is not necessarily the memory-footprint size, but
only the number of Lisp_Object fields (that need to be traced by GC).
/* Used to extract pseudovector subtype information. */
PSEUDOVECTOR_AREA_BITS = PSEUDOVECTOR_SIZE_BITS + PSEUDOVECTOR_REST_BITS,
- PVEC_TYPE_MASK = 0x3f << PSEUDOVECTOR_AREA_BITS,
-
- /* Number of bits to put in each character in the internal representation
- of bool vectors. This should not vary across implementations. */
- BOOL_VECTOR_BITS_PER_CHAR = 8
+ PVEC_TYPE_MASK = 0x3f << PSEUDOVECTOR_AREA_BITS
};
\f
/* These functions extract various sorts of values from a Lisp_Object.
- For example, if tem is a Lisp_Object whose type is Lisp_Cons,
- XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */
+ For example, if tem is a Lisp_Object whose type is Lisp_Cons,
+ XCONS (tem) is the struct Lisp_Cons * pointing to the memory for
+ that cons. */
-static EMACS_INT const VALMASK
+DEFINE_GDB_SYMBOL_BEGIN (EMACS_INT, VALMASK)
#define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX)
- = VALMASK;
+DEFINE_GDB_SYMBOL_END (VALMASK)
/* Largest and smallest representable fixnum values. These are the C
values. They are macros for use in static initializers. */
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. */
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.
/* 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. */
/* 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, Qvectorp;
+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;
/* Defined in emacs.c. */
extern bool initialized;
+extern bool might_dump;
/* Defined in eval.c. */
extern Lisp_Object Qautoload;
((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. */
and PSEUDOVECTORP cast their pointers to struct vectorlike_header *,
because when two such pointers potentially alias, a compiler won't
incorrectly reorder loads and stores to their size fields. See
- <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */
+ Bug#8546. */
struct vectorlike_header
{
/* The only field contains various pieces of information:
ptrdiff_t size;
};
-/* Regular vector is just a header plus array of Lisp_Objects... */
+/* A regular vector is just a header plus an array of Lisp_Objects. */
struct Lisp_Vector
{
struct vectorlike_header header;
- union {
- /* ...but sometimes there is also a pointer internally used in
- vector allocation code. Usually you don't want to touch this. */
- struct Lisp_Vector *next;
+ Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER];
+ };
- /* We can't use FLEXIBLE_ARRAY_MEMBER here. */
- Lisp_Object contents[1];
- } u;
+/* C11 prohibits alignof (struct Lisp_Vector), so compute it manually. */
+enum
+ {
+ ALIGNOF_STRUCT_LISP_VECTOR
+ = alignof (union { struct vectorlike_header a; Lisp_Object b; })
};
-/* A boolvector is a kind of vectorlike, with contents are like a string. */
+/* A boolvector is a kind of vectorlike, with contents like a string. */
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. */
- unsigned char data[FLEXIBLE_ARRAY_MEMBER];
+ /* 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];
};
+INLINE EMACS_INT
+bool_vector_size (Lisp_Object a)
+{
+ EMACS_INT size = XBOOL_VECTOR (a)->size;
+ eassume (0 <= size);
+ return size;
+}
+
+INLINE bits_word *
+bool_vector_data (Lisp_Object a)
+{
+ return XBOOL_VECTOR (a)->data;
+}
+
+INLINE unsigned char *
+bool_vector_uchar_data (Lisp_Object a)
+{
+ return (unsigned char *) bool_vector_data (a);
+}
+
+/* The number of data words and bytes in a bool vector with SIZE bits. */
+
+INLINE EMACS_INT
+bool_vector_words (EMACS_INT size)
+{
+ eassume (0 <= size && size <= EMACS_INT_MAX - (BITS_PER_BITS_WORD - 1));
+ 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
+bool_vector_bitref (Lisp_Object a, EMACS_INT i)
+{
+ eassume (0 <= i && i < bool_vector_size (a));
+ return !! (bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR]
+ & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR)));
+}
+
+INLINE Lisp_Object
+bool_vector_ref (Lisp_Object a, EMACS_INT i)
+{
+ return bool_vector_bitref (a, i) ? Qt : Qnil;
+}
+
+/* Set A's Ith bit to B. */
+
+INLINE void
+bool_vector_set (Lisp_Object a, EMACS_INT i, bool b)
+{
+ unsigned char *addr;
+
+ eassume (0 <= i && i < bool_vector_size (a));
+ addr = &bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR];
+
+ if (b)
+ *addr |= 1 << (i % BOOL_VECTOR_BITS_PER_CHAR);
+ else
+ *addr &= ~ (1 << (i % BOOL_VECTOR_BITS_PER_CHAR));
+}
+
/* Some handy constants for calculating sizes
and offsets, mostly of vectorlike objects. */
enum
{
- header_size = offsetof (struct Lisp_Vector, u.contents),
+ header_size = offsetof (struct Lisp_Vector, contents),
bool_header_size = offsetof (struct Lisp_Bool_Vector, data),
word_size = sizeof (Lisp_Object)
};
INLINE Lisp_Object
AREF (Lisp_Object array, ptrdiff_t idx)
{
- return XVECTOR (array)->u.contents[idx];
+ return XVECTOR (array)->contents[idx];
}
INLINE Lisp_Object *
aref_addr (Lisp_Object array, ptrdiff_t idx)
{
- return & XVECTOR (array)->u.contents[idx];
+ return & XVECTOR (array)->contents[idx];
}
INLINE ptrdiff_t
ASET (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
{
eassert (0 <= idx && idx < ASIZE (array));
- XVECTOR (array)->u.contents[idx] = val;
+ XVECTOR (array)->contents[idx] = val;
}
INLINE void
/* Like ASET, but also can be used in the garbage collector:
sweep_weak_table calls set_hash_key etc. while the table is marked. */
eassert (0 <= idx && idx < (ASIZE (array) & ~ARRAY_MARK_FLAG));
- XVECTOR (array)->u.contents[idx] = val;
+ XVECTOR (array)->contents[idx] = val;
}
/* If a struct is made to look like a vector, this macro returns the length
/* 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
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.
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;
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)
\f
/***********************************************************************
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
struct Lisp_Misc_Any /* Supertype of all Misc types. */
{
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_??? */
- unsigned gcmarkbit : 1;
- int spacer : 15;
+ bool_bf gcmarkbit : 1;
+ unsigned spacer : 15;
};
struct Lisp_Marker
{
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Marker */
- unsigned gcmarkbit : 1;
- int spacer : 13;
+ 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
*/
{
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Overlay */
- unsigned gcmarkbit : 1;
- int spacer : 15;
+ bool_bf gcmarkbit : 1;
+ unsigned spacer : 15;
struct Lisp_Overlay *next;
Lisp_Object start;
Lisp_Object end;
struct Lisp_Save_Value
{
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Save_Value */
- unsigned gcmarkbit : 1;
- int spacer : 32 - (16 + 1 + SAVE_TYPE_BITS);
+ 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
V's data entries are determined by V->save_type. E.g., if
struct Lisp_Free
{
ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Free */
- unsigned gcmarkbit : 1;
- int spacer : 15;
+ bool_bf gcmarkbit : 1;
+ unsigned spacer : 15;
union Lisp_Misc *chain;
};
/* 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 */
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. */
PSEUDOVECTORP (Lisp_Object a, int code)
{
if (! VECTORLIKEP (a))
- return 0;
+ return false;
else
{
/* Converting to struct vectorlike_header * avoids aliasing issues. */
{
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)
{
? 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)
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. */
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
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)
\f
/* Save and restore the instruction and environment pointers,
without affecting the signal mask. */
} let;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
- bool debug_on_exit : 1;
+ bool_bf debug_on_exit : 1;
Lisp_Object function;
Lisp_Object *args;
ptrdiff_t nargs;
/* 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;
/* Fill in the components of c, and put it on the list. */
#define PUSH_HANDLER(c, tag_ch_val, handlertype) \
- if (handlerlist && handlerlist->nextfree) \
+ if (handlerlist->nextfree) \
(c) = handlerlist->nextfree; \
else \
{ \
(c) = xmalloc (sizeof (struct handler)); \
(c)->nextfree = NULL; \
- if (handlerlist) \
- handlerlist->nextfree = (c); \
+ handlerlist->nextfree = (c); \
} \
(c)->type = (handlertype); \
(c)->tag_or_ch = (tag_ch_val); \
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.
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))
\f
#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 */
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
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 */
/* 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'. */
vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object *args, ptrdiff_t count)
{
eassert (0 <= offset && 0 <= count && offset + count <= ASIZE (v));
- memcpy (XVECTOR (v)->u.contents + offset, args, count * sizeof *args);
+ memcpy (XVECTOR (v)->contents + offset, args, count * sizeof *args);
}
/* Functions to modify hash tables. */
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);
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 *);
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);
make_number (w), make_number (h));
}
+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 *, ...)
#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
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);
extern void syms_of_fileio (void);
extern Lisp_Object make_temp_name (Lisp_Object, bool);
extern Lisp_Object Qdelete_file;
-extern bool check_existing (const char *);
/* Defined in search.c. */
extern void shrink_regexp_cache (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);
extern void safe_run_hooks (Lisp_Object);
extern void cmd_error_internal (Lisp_Object, const char *);
extern Lisp_Object command_loop_1 (void);
+extern Lisp_Object read_menu_command (void);
extern Lisp_Object recursive_edit_1 (void);
extern void record_auto_save (void);
extern void force_auto_save_soon (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);
#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);
/* 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,
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,
extern void sys_subshell (void);
extern void sys_suspend (void);
extern void discard_tty_input (void);
-extern void block_tty_out_signal (void);
-extern void unblock_tty_out_signal (void);
extern void init_sys_modes (struct tty_display_info *);
extern void reset_sys_modes (struct tty_display_info *);
extern void init_all_sys_modes (void);
extern int emacs_open (const char *, int, int);
extern int emacs_pipe (int[2]);
extern int emacs_close (int);
-extern ptrdiff_t emacs_read (int, char *, ptrdiff_t);
-extern ptrdiff_t emacs_write (int, const char *, ptrdiff_t);
-extern ptrdiff_t emacs_write_sig (int, char const *, ptrdiff_t);
+extern ptrdiff_t emacs_read (int, void *, ptrdiff_t);
+extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t);
+extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t);
extern void emacs_perror (char const *);
extern void unlock_all_files (void);
/* 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 *);
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
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. */
#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. */
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;
-}
-
-INLINE uint16_t
-swap16 (uint16_t val)
-{
- return (val << 8) | (val & 0xFF);
+ return false;
}
-INLINE uint32_t
-swap32 (uint32_t val)
-{
- uint32_t low = swap16 (val & 0xFFFF);
- uint32_t high = swap16 (val >> 16);
- return (low << 16) | high;
-}
-
-#ifdef UINT64_MAX
-INLINE uint64_t
-swap64 (uint64_t val)
-{
- uint64_t low = swap32 (val & 0xFFFFFFFF);
- uint64_t high = swap32 (val >> 32);
- return (low << 32) | high;
-}
-#endif
-
-#if ((SIZE_MAX >> 31) >> 1) & 1
-# define BITS_PER_SIZE_T 64
-#else
-# define BITS_PER_SIZE_T 32
-#endif
-
-/* Round x to the next multiple of y. Does not overflow. Evaluates
- arguments repeatedly. */
-#define ROUNDUP(x,y) ((y)*((x)/(y) + ((x)%(y)!=0)))
-
INLINE_HEADER_END
#endif /* EMACS_LISP_H */