X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e08813d023325dc02574ab9437441551f67d1487..0fa30f3361e5876a7d0734e891f7386675775c8e:/src/lisp.h diff --git a/src/lisp.h b/src/lisp.h index a9a2c259b5..1e68b152df 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1,7 +1,6 @@ /* Fundamental definitions for GNU Emacs Lisp interpreter. -Copyright (C) 1985-1987, 1993-1995, 1997-2013 Free Software Foundation, -Inc. +Copyright (C) 1985-1987, 1993-1995, 1997-2013 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -24,16 +23,34 @@ along with GNU Emacs. If not, see . */ #include #include #include -#include #include #include #include #include #include +#include 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 @@ -52,7 +69,7 @@ typedef unsigned long long int EMACS_UINT; # define pI "ll" # elif INT_MAX < LONG_MAX typedef long int EMACS_INT; -typedef unsigned long int EMACS_UINT; +typedef unsigned long EMACS_UINT; # define EMACS_INT_MAX LONG_MAX # define pI "l" # else @@ -63,6 +80,27 @@ typedef unsigned int EMACS_UINT; # 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 words in a Lisp bool vector. 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 { @@ -107,37 +145,50 @@ typedef EMACS_UINT uprintmax_t; /* 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 's 'assert (COND)' and '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)) - /* Use the configure flag --enable-check-lisp-object-type to make Lisp_Object use a struct type instead of the default int. The flag @@ -199,20 +250,20 @@ enum Lisp_Bits 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. */ + So, default USE_LSB_TAG to true only on hosts where it might be useful. */ # if VAL_MAX < UINTPTR_MAX -# define USE_LSB_TAG 1 +# 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 = 1 }; -# define USE_LSB_TAG 1 +enum enum_USE_LSB_TAG { USE_LSB_TAG = true }; +# define USE_LSB_TAG true #else -enum enum_USE_LSB_TAG { USE_LSB_TAG = 0 }; -# define USE_LSB_TAG 0 +enum enum_USE_LSB_TAG { USE_LSB_TAG = false }; +# define USE_LSB_TAG false #endif #ifndef alignas @@ -304,7 +355,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)) @@ -368,8 +419,10 @@ enum enum_USE_LSB_TAG { USE_LSB_TAG = 0 }; #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 @@ -496,14 +549,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. @@ -513,15 +566,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. */ -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 @@ -576,19 +629,16 @@ 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, - - /* 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 }; /* 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. */ @@ -685,7 +735,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. */ @@ -736,7 +786,7 @@ 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, 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; @@ -1034,17 +1084,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. */ @@ -1111,7 +1167,7 @@ STRING_COPYIN (Lisp_Object string, ptrdiff_t index, char const *new, 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 - . */ + Bug#8546. */ struct vectorlike_header { /* The only field contains various pieces of information: @@ -1136,7 +1192,7 @@ struct vectorlike_header 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 { @@ -1144,7 +1200,14 @@ struct Lisp_Vector Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER]; }; -/* A boolvector is a kind of vectorlike, with contents are like a string. */ +/* 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 like a string. */ struct Lisp_Bool_Vector { @@ -1153,10 +1216,81 @@ 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. */ @@ -1219,14 +1353,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 @@ -1407,7 +1541,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. @@ -1425,9 +1559,9 @@ 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; /* The symbol's name, as a Lisp string. */ Lisp_Object name; @@ -1525,7 +1659,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) /*********************************************************************** @@ -1703,22 +1837,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; - 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 @@ -1764,8 +1898,8 @@ struct Lisp_Overlay */ { 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; @@ -1842,8 +1976,8 @@ typedef void (*voidfuncptr) (void); 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 @@ -1918,8 +2052,8 @@ XSAVE_OBJECT (Lisp_Object obj, int n) 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; }; @@ -1987,8 +2121,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 */ @@ -2041,15 +2175,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. */ @@ -2244,7 +2378,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. */ @@ -2412,18 +2546,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) @@ -2437,9 +2575,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. */ @@ -2572,34 +2714,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. */ @@ -2628,11 +2770,9 @@ typedef jmp_buf sys_jmp_buf; - The specpdl stack: keeps track of active unwind-protect and dynamic-let-bindings. Allocated from the `specpdl' array, a manually managed stack. - - The catch stack: keeps track of active catch tags. - Allocated on the C stack. This is where the setmp data is kept. - - The handler stack: keeps track of active condition-case handlers. - Allocated on the C stack. Every entry there also uses an entry in - the catch stack. */ + - The handler stack: keeps track of active catch tags and condition-case + handlers. Allocated in a manually managed stack implemented by a + doubly-linked list allocated via xmalloc and never freed. */ /* Structure for recording Lisp call stack for backtrace purposes. */ @@ -2685,7 +2825,7 @@ union specbinding } 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; @@ -2702,46 +2842,16 @@ SPECPDL_INDEX (void) return specpdl_ptr - specpdl; } -/* Everything needed to describe an active condition case. - - Members are volatile if their values need to survive _longjmp when - a 'struct handler' is a local variable. */ -struct handler - { - /* The handler clauses and variable from the condition-case form. */ - /* For a handler set up in Lisp code, this is always a list. - For an internal handler set up by internal_condition_case*, - this can instead be the symbol t or `error'. - t: handle all conditions. - error: handle all conditions, and errors can run the debugger - or display a backtrace. */ - Lisp_Object handler; - - Lisp_Object volatile var; - - /* Fsignal stores here the condition-case clause that applies, - and Fcondition_case thus knows which clause to run. */ - Lisp_Object volatile chosen_clause; - - /* Used to effect the longjump out to the handler. */ - struct catchtag *tag; - - /* The next enclosing handler. */ - struct handler *next; - }; - -/* This structure helps implement the `catch' and `throw' control - structure. A struct catchtag contains all the information needed - to restore the state of the interpreter after a non-local jump. +/* This structure helps implement the `catch/throw' and `condition-case/signal' + control structures. A struct handler contains all the information needed to + restore the state of the interpreter after a non-local jump. - Handlers for error conditions (represented by `struct handler' - structures) just point to a catch tag to do the cleanup required - for their jumps. + handler structures are chained together in a doubly linked list; the `next' + member points to the next outer catchtag and the `nextfree' member points in + the other direction to the next inner element (which is typically the next + free element since we mostly use it on the deepest handler). - catchtag structures are chained together in the C calling stack; - the `next' member points to the next outer catchtag. - - A call like (throw TAG VAL) searches for a catchtag whose `tag' + A call like (throw TAG VAL) searches for a catchtag whose `tag_or_ch' member is TAG, and then unbinds to it. The `val' member is used to hold VAL while the stack is unwound; `val' is returned as the value of the catch form. @@ -2750,24 +2860,62 @@ struct handler state. Members are volatile if their values need to survive _longjmp when - a 'struct catchtag' is a local variable. */ -struct catchtag + a 'struct handler' is a local variable. */ + +enum handlertype { CATCHER, CONDITION_CASE }; + +struct handler { - Lisp_Object tag; - Lisp_Object volatile val; - struct catchtag *volatile next; -#if 1 /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but they're defined later. */ + enum handlertype type; + Lisp_Object tag_or_ch; + Lisp_Object val; + struct handler *next; + struct handler *nextfree; + + /* The bytecode interpreter can have several handlers active at the same + time, so when we longjmp to one of them, it needs to know which handler + this was and what was the corresponding internal state. This is stored + here, and when we longjmp we make sure that handlerlist points to the + proper handler. */ + Lisp_Object *bytecode_top; + int bytecode_dest; + + /* Most global vars are reset to their value via the specpdl mechanism, + but a few others are handled by storing their value here. */ +#if true /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but defined later. */ struct gcpro *gcpro; #endif sys_jmp_buf jmp; - struct handler *handlerlist; EMACS_INT lisp_eval_depth; - ptrdiff_t volatile pdlcount; + ptrdiff_t pdlcount; int poll_suppress_count; int interrupt_input_blocked; struct byte_stack *byte_stack; }; +/* Fill in the components of c, and put it on the list. */ +#define PUSH_HANDLER(c, tag_ch_val, handlertype) \ + if (handlerlist->nextfree) \ + (c) = handlerlist->nextfree; \ + else \ + { \ + (c) = xmalloc (sizeof (struct handler)); \ + (c)->nextfree = NULL; \ + handlerlist->nextfree = (c); \ + } \ + (c)->type = (handlertype); \ + (c)->tag_or_ch = (tag_ch_val); \ + (c)->val = Qnil; \ + (c)->next = handlerlist; \ + (c)->lisp_eval_depth = lisp_eval_depth; \ + (c)->pdlcount = SPECPDL_INDEX (); \ + (c)->poll_suppress_count = poll_suppress_count; \ + (c)->interrupt_input_blocked = interrupt_input_blocked;\ + (c)->gcpro = gcprolist; \ + (c)->byte_stack = byte_stack_list; \ + handlerlist = (c); + + extern Lisp_Object memory_signal_data; /* An address near the bottom of the stack. @@ -2782,7 +2930,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. @@ -2800,10 +2948,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)) @@ -2986,9 +3134,9 @@ extern int gcpro_level; gcprolist = &gcpro6; } #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 */ @@ -2996,14 +3144,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'. */ @@ -3344,6 +3492,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); @@ -3374,7 +3523,6 @@ 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 Qglyphless_char; extern Lisp_Object QCdata, QCfile; extern Lisp_Object QCmap; extern Lisp_Object Qrisky_local_variable; @@ -3388,7 +3536,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 *); @@ -3401,7 +3549,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); @@ -3464,6 +3611,8 @@ list4i (EMACS_INT x, EMACS_INT y, EMACS_INT w, EMACS_INT h) 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 *, ...) @@ -3670,10 +3819,8 @@ extern Lisp_Object Qand_rest; extern Lisp_Object Vautoload_queue; extern Lisp_Object Vsignaling_function; extern Lisp_Object inhibit_lisp_code; -#if BYTE_MARK_STACK -extern struct catchtag *catchlist; extern struct handler *handlerlist; -#endif + /* To run a normal hook, use the appropriate function from the list below. The calling convention: @@ -3815,7 +3962,6 @@ 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; -extern bool check_existing (const char *); /* Defined in search.c. */ extern void shrink_regexp_cache (void); @@ -3892,6 +4038,7 @@ extern bool detect_input_pending_run_timers (bool); 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); @@ -3908,10 +4055,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); @@ -3923,7 +4071,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); @@ -4078,9 +4226,9 @@ extern _Noreturn void emacs_abort (void) NO_INLINE; 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); @@ -4255,13 +4403,13 @@ enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 }; extern void *record_xmalloc (size_t); #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 @@ -4274,20 +4422,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. */ @@ -4295,25 +4443,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. */ @@ -4349,53 +4512,16 @@ 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 -uint16_t -swap16 (uint16_t val) -{ - return (val << 8) | (val & 0xFF); -} - -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 */