/* 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>
#include <limits.h>
#include <intprops.h>
+#include <verify.h>
INLINE_HEADER_BEGIN
-#ifndef LISP_INLINE
-# define LISP_INLINE INLINE
+
+/* 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. */
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 && !defined WIDE_EMACS_INT
+typedef int EMACS_INT;
+typedef unsigned int EMACS_UINT;
+# define EMACS_INT_MAX INT_MAX
+# define pI ""
+# elif INTPTR_MAX <= LONG_MAX && !defined WIDE_EMACS_INT
+typedef long int EMACS_INT;
+typedef unsigned long EMACS_UINT;
+# define EMACS_INT_MAX LONG_MAX
+# define pI "l"
+# 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 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
{
/* 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 */
+
\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
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
/* 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))
ARGS should be parenthesized. Implement the function by calling
lisp_h_NAME ARGS. */
#define LISP_MACRO_DEFUN(name, type, argdecls, args) \
- LISP_INLINE type (name) argdecls { return lisp_h_##name args; }
+ INLINE type (name) argdecls { return lisp_h_##name args; }
/* like LISP_MACRO_DEFUN, except NAME returns void. */
#define LISP_MACRO_DEFUN_VOID(name, argdecls, args) \
- LISP_INLINE void (name) argdecls { lisp_h_##name args; }
+ INLINE void (name) argdecls { lisp_h_##name args; }
/* Define the fundamental Lisp data structures. */
#define INTMASK (EMACS_INT_MAX >> (INTTYPEBITS - 1))
#define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
-/* Idea stolen from GDB. MSVC doesn't support enums in bitfields,
- and xlc complains vociferously about them. */
-#if defined _MSC_VER || defined __IBMC__
+/* Idea stolen from GDB. Pedantic GCC complains about enum bitfields,
+ 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
/* Cons. XCONS (object) points to a struct Lisp_Cons. */
Lisp_Cons = 6,
- Lisp_Float = 7,
+ Lisp_Float = 7
};
/* This is the set of data types that share a common structure.
Lisp_Fwd_Bool, /* Fwd to a C boolean var. */
Lisp_Fwd_Obj, /* Fwd to a C Lisp_Object variable. */
Lisp_Fwd_Buffer_Obj, /* Fwd to a Lisp_Object field of buffers. */
- Lisp_Fwd_Kboard_Obj, /* Fwd to a Lisp_Object field of kboards. */
+ Lisp_Fwd_Kboard_Obj /* Fwd to a Lisp_Object field of kboards. */
};
/* If you want to define a new Lisp data type, here are some
displayed to users. These are Lisp_Save_Value, a Lisp_Misc
subtype; and PVEC_OTHER, a kind of vectorlike object. The former
is suitable for temporarily stashing away pointers and integers in
- a Lisp object (see the existing uses of make_save_value and
- XSAVE_VALUE). The latter is useful for vector-like Lisp objects
+ a Lisp object. The latter is useful for vector-like Lisp objects
that need to be used as part of other objects, but which are never
shown to users or Lisp code (search for PVEC_OTHER in xterm.c for
an example).
#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
/* 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. */
/* Make a Lisp integer representing the value of the low order
bits of N. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
make_number (EMACS_INT n)
{
return XIL (USE_LSB_TAG ? n << INTTYPEBITS : n & INTMASK);
}
/* Extract A's value as a signed integer. */
-LISP_INLINE EMACS_INT
+INLINE EMACS_INT
XINT (Lisp_Object a)
{
EMACS_INT i = XLI (a);
/* Like XINT (A), but may be faster. A must be nonnegative.
If ! USE_LSB_TAG, this takes advantage of the fact that Lisp
integers have zero-bits in their tags. */
-LISP_INLINE EMACS_INT
+INLINE EMACS_INT
XFASTINT (Lisp_Object a)
{
EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a);
}
/* Extract A's type. */
-LISP_INLINE enum Lisp_Type
+INLINE enum Lisp_Type
XTYPE (Lisp_Object a)
{
EMACS_UINT i = XLI (a);
}
/* Extract A's pointer value, assuming A's type is TYPE. */
-LISP_INLINE void *
+INLINE void *
XUNTAG (Lisp_Object a, int type)
{
if (USE_LSB_TAG)
#endif /* ! USE_LSB_TAG */
/* Extract A's value as an unsigned integer. */
-LISP_INLINE EMACS_UINT
+INLINE EMACS_UINT
XUINT (Lisp_Object a)
{
EMACS_UINT i = XLI (a);
LISP_MACRO_DEFUN (XHASH, EMACS_INT, (Lisp_Object a), (a))
/* Like make_number (N), but may be faster. N must be in nonnegative range. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
make_natnum (EMACS_INT n)
{
eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM);
/* 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. */
#define FIXNUM_OVERFLOW_P(i) \
(! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= MOST_POSITIVE_FIXNUM))
-LISP_INLINE ptrdiff_t
+INLINE ptrdiff_t
clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper)
{
return num < lower ? lower : num <= upper ? num : upper;
/* Defined in this file. */
union Lisp_Fwd;
-LISP_INLINE bool BOOL_VECTOR_P (Lisp_Object);
-LISP_INLINE bool BUFFER_OBJFWDP (union Lisp_Fwd *);
-LISP_INLINE bool BUFFERP (Lisp_Object);
-LISP_INLINE bool CHAR_TABLE_P (Lisp_Object);
-LISP_INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t);
-LISP_INLINE bool (CONSP) (Lisp_Object);
-LISP_INLINE bool (FLOATP) (Lisp_Object);
-LISP_INLINE bool functionp (Lisp_Object);
-LISP_INLINE bool (INTEGERP) (Lisp_Object);
-LISP_INLINE bool (MARKERP) (Lisp_Object);
-LISP_INLINE bool (MISCP) (Lisp_Object);
-LISP_INLINE bool (NILP) (Lisp_Object);
-LISP_INLINE bool OVERLAYP (Lisp_Object);
-LISP_INLINE bool PROCESSP (Lisp_Object);
-LISP_INLINE bool PSEUDOVECTORP (Lisp_Object, int);
-LISP_INLINE bool SAVE_VALUEP (Lisp_Object);
-LISP_INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
+INLINE bool BOOL_VECTOR_P (Lisp_Object);
+INLINE bool BUFFER_OBJFWDP (union Lisp_Fwd *);
+INLINE bool BUFFERP (Lisp_Object);
+INLINE bool CHAR_TABLE_P (Lisp_Object);
+INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t);
+INLINE bool (CONSP) (Lisp_Object);
+INLINE bool (FLOATP) (Lisp_Object);
+INLINE bool functionp (Lisp_Object);
+INLINE bool (INTEGERP) (Lisp_Object);
+INLINE bool (MARKERP) (Lisp_Object);
+INLINE bool (MISCP) (Lisp_Object);
+INLINE bool (NILP) (Lisp_Object);
+INLINE bool OVERLAYP (Lisp_Object);
+INLINE bool PROCESSP (Lisp_Object);
+INLINE bool PSEUDOVECTORP (Lisp_Object, int);
+INLINE bool SAVE_VALUEP (Lisp_Object);
+INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
Lisp_Object);
-LISP_INLINE bool STRINGP (Lisp_Object);
-LISP_INLINE bool SUB_CHAR_TABLE_P (Lisp_Object);
-LISP_INLINE bool SUBRP (Lisp_Object);
-LISP_INLINE bool (SYMBOLP) (Lisp_Object);
-LISP_INLINE bool (VECTORLIKEP) (Lisp_Object);
-LISP_INLINE bool WINDOWP (Lisp_Object);
-LISP_INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object);
+INLINE bool STRINGP (Lisp_Object);
+INLINE bool SUB_CHAR_TABLE_P (Lisp_Object);
+INLINE bool SUBRP (Lisp_Object);
+INLINE bool (SYMBOLP) (Lisp_Object);
+INLINE bool (VECTORLIKEP) (Lisp_Object);
+INLINE bool WINDOWP (Lisp_Object);
+INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object);
/* Defined in chartab.c. */
extern Lisp_Object char_table_ref (Lisp_Object, int);
/* 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;
extern Lisp_Object Ffboundp (Lisp_Object);
extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
LISP_MACRO_DEFUN (XCONS, struct Lisp_Cons *, (Lisp_Object a), (a))
-LISP_INLINE struct Lisp_Vector *
+INLINE struct Lisp_Vector *
XVECTOR (Lisp_Object a)
{
eassert (VECTORLIKEP (a));
return XUNTAG (a, Lisp_Vectorlike);
}
-LISP_INLINE struct Lisp_String *
+INLINE struct Lisp_String *
XSTRING (Lisp_Object a)
{
eassert (STRINGP (a));
LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a))
-LISP_INLINE struct Lisp_Float *
+INLINE struct Lisp_Float *
XFLOAT (Lisp_Object a)
{
eassert (FLOATP (a));
/* Pseudovector types. */
-LISP_INLINE struct Lisp_Process *
+INLINE struct Lisp_Process *
XPROCESS (Lisp_Object a)
{
eassert (PROCESSP (a));
return XUNTAG (a, Lisp_Vectorlike);
}
-LISP_INLINE struct window *
+INLINE struct window *
XWINDOW (Lisp_Object a)
{
eassert (WINDOWP (a));
return XUNTAG (a, Lisp_Vectorlike);
}
-LISP_INLINE struct terminal *
+INLINE struct terminal *
XTERMINAL (Lisp_Object a)
{
return XUNTAG (a, Lisp_Vectorlike);
}
-LISP_INLINE struct Lisp_Subr *
+INLINE struct Lisp_Subr *
XSUBR (Lisp_Object a)
{
eassert (SUBRP (a));
return XUNTAG (a, Lisp_Vectorlike);
}
-LISP_INLINE struct buffer *
+INLINE struct buffer *
XBUFFER (Lisp_Object a)
{
eassert (BUFFERP (a));
return XUNTAG (a, Lisp_Vectorlike);
}
-LISP_INLINE struct Lisp_Char_Table *
+INLINE struct Lisp_Char_Table *
XCHAR_TABLE (Lisp_Object a)
{
eassert (CHAR_TABLE_P (a));
return XUNTAG (a, Lisp_Vectorlike);
}
-LISP_INLINE struct Lisp_Sub_Char_Table *
+INLINE struct Lisp_Sub_Char_Table *
XSUB_CHAR_TABLE (Lisp_Object a)
{
eassert (SUB_CHAR_TABLE_P (a));
return XUNTAG (a, Lisp_Vectorlike);
}
-LISP_INLINE struct Lisp_Bool_Vector *
+INLINE struct Lisp_Bool_Vector *
XBOOL_VECTOR (Lisp_Object a)
{
eassert (BOOL_VECTOR_P (a));
/* Construct a Lisp_Object from a value or address. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
make_lisp_ptr (void *ptr, enum Lisp_Type type)
{
EMACS_UINT utype = type;
return a;
}
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
make_lisp_proc (struct Lisp_Process *p)
{
return make_lisp_ptr (p, Lisp_Vectorlike);
#define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String))
#define XSETSYMBOL(a, b) ((a) = make_lisp_ptr (b, Lisp_Symbol))
#define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float))
-
-/* Misc types. */
-
#define XSETMISC(a, b) ((a) = make_lisp_ptr (b, Lisp_Misc))
-#define XSETMARKER(a, b) (XSETMISC (a, b), XMISCTYPE (a) = Lisp_Misc_Marker)
/* Pseudovector types. */
fields are not accessible. (What if we want to switch to
a copying collector someday? Cached cons cell field addresses may be
invalidated at arbitrary points.) */
-LISP_INLINE Lisp_Object *
+INLINE Lisp_Object *
xcar_addr (Lisp_Object c)
{
return &XCONS (c)->car;
}
-LISP_INLINE Lisp_Object *
+INLINE Lisp_Object *
xcdr_addr (Lisp_Object c)
{
return &XCONS (c)->u.cdr;
Note that both arguments may refer to the same object, so 'n'
should not be read after 'c' is first modified. */
-LISP_INLINE void
+INLINE void
XSETCAR (Lisp_Object c, Lisp_Object n)
{
*xcar_addr (c) = n;
}
-LISP_INLINE void
+INLINE void
XSETCDR (Lisp_Object c, Lisp_Object n)
{
*xcdr_addr (c) = n;
}
/* Take the car or cdr of something whose type is not known. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
CAR (Lisp_Object c)
{
return (CONSP (c) ? XCAR (c)
: NILP (c) ? Qnil
: wrong_type_argument (Qlistp, c));
}
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
CDR (Lisp_Object c)
{
return (CONSP (c) ? XCDR (c)
}
/* Take the car or cdr of something whose type is not known. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
CAR_SAFE (Lisp_Object c)
{
return CONSP (c) ? XCAR (c) : Qnil;
}
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
CDR_SAFE (Lisp_Object c)
{
return CONSP (c) ? XCDR (c) : Qnil;
};
/* True if STR is a multibyte string. */
-LISP_INLINE bool
+INLINE bool
STRING_MULTIBYTE (Lisp_Object str)
{
return 0 <= XSTRING (str)->size_byte;
((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. */
-LISP_INLINE unsigned char *
+INLINE unsigned char *
SDATA (Lisp_Object string)
{
return XSTRING (string)->data;
}
-LISP_INLINE char *
+INLINE char *
SSDATA (Lisp_Object string)
{
/* Avoid "differ in sign" warnings. */
return (char *) SDATA (string);
}
-LISP_INLINE unsigned char
+INLINE unsigned char
SREF (Lisp_Object string, ptrdiff_t index)
{
return SDATA (string)[index];
}
-LISP_INLINE void
+INLINE void
SSET (Lisp_Object string, ptrdiff_t index, unsigned char new)
{
SDATA (string)[index] = new;
}
-LISP_INLINE ptrdiff_t
+INLINE ptrdiff_t
SCHARS (Lisp_Object string)
{
return XSTRING (string)->size;
#ifdef GC_CHECK_STRING_BYTES
extern ptrdiff_t string_bytes (struct Lisp_String *);
#endif
-LISP_INLINE ptrdiff_t
+INLINE ptrdiff_t
STRING_BYTES (struct Lisp_String *s)
{
#ifdef GC_CHECK_STRING_BYTES
#endif
}
-LISP_INLINE ptrdiff_t
+INLINE ptrdiff_t
SBYTES (Lisp_Object string)
{
return STRING_BYTES (XSTRING (string));
}
-LISP_INLINE void
+INLINE void
STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize)
{
XSTRING (string)->size = newsize;
}
-LISP_INLINE void
+INLINE void
STRING_COPYIN (Lisp_Object string, ptrdiff_t index, char const *new,
ptrdiff_t count)
{
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
{
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
{
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. */
/* Conveniences for dealing with Lisp arrays. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
AREF (Lisp_Object array, ptrdiff_t idx)
{
return XVECTOR (array)->contents[idx];
}
-LISP_INLINE Lisp_Object *
+INLINE Lisp_Object *
aref_addr (Lisp_Object array, ptrdiff_t idx)
{
return & XVECTOR (array)->contents[idx];
}
-LISP_INLINE ptrdiff_t
+INLINE ptrdiff_t
ASIZE (Lisp_Object array)
{
return XVECTOR (array)->header.size;
}
-LISP_INLINE void
+INLINE void
ASET (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
{
eassert (0 <= idx && idx < ASIZE (array));
XVECTOR (array)->contents[idx] = val;
}
-LISP_INLINE void
+INLINE void
gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
{
/* Like ASET, but also can be used in the garbage collector:
/* 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
Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER];
};
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx)
{
struct Lisp_Char_Table *tbl = NULL;
/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII
characters. Do not check validity of CT. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
CHAR_TABLE_REF (Lisp_Object ct, int idx)
{
return (ASCII_CHAR_P (idx)
/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and
8-bit European characters. Do not check validity of CT. */
-LISP_INLINE void
+INLINE void
CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val)
{
if (ASCII_CHAR_P (idx) && SUB_CHAR_TABLE_P (XCHAR_TABLE (ct)->ascii))
/* Return the number of "extra" slots in the char table CT. */
-LISP_INLINE int
+INLINE int
CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct)
{
return ((ct->header.size & PSEUDOVECTOR_SIZE_MASK)
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;
/* The symbol's name, as a Lisp string. */
Lisp_Object name;
LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (struct Lisp_Symbol *sym), (sym))
-LISP_INLINE struct Lisp_Symbol *
+INLINE struct Lisp_Symbol *
SYMBOL_ALIAS (struct Lisp_Symbol *sym)
{
eassert (sym->redirect == SYMBOL_VARALIAS);
return sym->val.alias;
}
-LISP_INLINE struct Lisp_Buffer_Local_Value *
+INLINE struct Lisp_Buffer_Local_Value *
SYMBOL_BLV (struct Lisp_Symbol *sym)
{
eassert (sym->redirect == SYMBOL_LOCALIZED);
return sym->val.blv;
}
-LISP_INLINE union Lisp_Fwd *
+INLINE union Lisp_Fwd *
SYMBOL_FWD (struct Lisp_Symbol *sym)
{
eassert (sym->redirect == SYMBOL_FORWARDED);
LISP_MACRO_DEFUN_VOID (SET_SYMBOL_VAL,
(struct Lisp_Symbol *sym, Lisp_Object v), (sym, v))
-LISP_INLINE void
+INLINE void
SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v)
{
eassert (sym->redirect == SYMBOL_VARALIAS);
sym->val.alias = v;
}
-LISP_INLINE void
+INLINE void
SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v)
{
eassert (sym->redirect == SYMBOL_LOCALIZED);
sym->val.blv = v;
}
-LISP_INLINE void
+INLINE void
SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v)
{
eassert (sym->redirect == SYMBOL_FORWARDED);
sym->val.fwd = v;
}
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
SYMBOL_NAME (Lisp_Object sym)
{
return XSYMBOL (sym)->name;
/* Value is true if SYM is an interned symbol. */
-LISP_INLINE bool
+INLINE bool
SYMBOL_INTERNED_P (Lisp_Object sym)
{
return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED;
/* Value is true if SYM is interned in initial_obarray. */
-LISP_INLINE bool
+INLINE bool
SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym)
{
return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
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
/***********************************************************************
};
-LISP_INLINE struct Lisp_Hash_Table *
+INLINE struct Lisp_Hash_Table *
XHASH_TABLE (Lisp_Object a)
{
return XUNTAG (a, Lisp_Vectorlike);
#define XSET_HASH_TABLE(VAR, PTR) \
(XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE))
-LISP_INLINE bool
+INLINE bool
HASH_TABLE_P (Lisp_Object a)
{
return PSEUDOVECTORP (a, PVEC_HASH_TABLE);
}
/* Value is the key part of entry IDX in hash table H. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
HASH_KEY (struct Lisp_Hash_Table *h, ptrdiff_t idx)
{
return AREF (h->key_and_value, 2 * idx);
}
/* Value is the value part of entry IDX in hash table H. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
HASH_VALUE (struct Lisp_Hash_Table *h, ptrdiff_t idx)
{
return AREF (h->key_and_value, 2 * idx + 1);
/* Value is the index of the next entry following the one at IDX
in hash table H. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx)
{
return AREF (h->next, idx);
}
/* Value is the hash code computed for entry IDX in hash table H. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
HASH_HASH (struct Lisp_Hash_Table *h, ptrdiff_t idx)
{
return AREF (h->hash, idx);
/* Value is the index of the element in hash table H that is the
start of the collision list at index IDX in the index vector of H. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx)
{
return AREF (h->index, idx);
}
/* Value is the size of hash table H. */
-LISP_INLINE ptrdiff_t
+INLINE ptrdiff_t
HASH_TABLE_SIZE (struct Lisp_Hash_Table *h)
{
return ASIZE (h->next);
/* Combine two integers X and Y for hashing. The result might not fit
into a Lisp integer. */
-LISP_INLINE EMACS_UINT
+INLINE EMACS_UINT
sxhash_combine (EMACS_UINT x, EMACS_UINT y)
{
return (x << 4) + (x >> (BITS_PER_EMACS_INT - 4)) + y;
/* Hash X, returning a value that fits into a fixnum. */
-LISP_INLINE EMACS_UINT
+INLINE EMACS_UINT
SXHASH_REDUCE (EMACS_UINT x)
{
return (x ^ x >> (BITS_PER_EMACS_INT - FIXNUM_BITS)) & INTMASK;
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;
/* Special object used to hold a different values for later use.
This is mostly used to package C integers and pointers to call
- record_unwind_protect. A typical task is to pass just one C object
- pointer to the unwind function. You should pack an object pointer with
- make_save_pointer and then get it back with XSAVE_POINTER, e.g.:
+ record_unwind_protect when two or more values need to be saved.
+ For example:
...
struct my_data *md = get_my_data ();
- record_unwind_protect (my_unwind, make_save_pointer (md));
+ ptrdiff_t mi = get_my_integer ();
+ record_unwind_protect (my_unwind, make_save_ptr_int (md, mi));
...
Lisp_Object my_unwind (Lisp_Object arg)
{
struct my_data *md = XSAVE_POINTER (arg, 0);
- ...
- }
-
- If you need to pass something else you can use make_save_value,
- which allows you to pack up to SAVE_VALUE_SLOTS integers, pointers,
- function pointers or Lisp_Objects and conveniently get them back
- with XSAVE_INTEGER, XSAVE_POINTER, XSAVE_FUNCPOINTER, and
- XSAVE_OBJECT macros:
-
- ...
- struct my_data *md = get_my_data ();
- Lisp_Object my_object = get_my_object ();
- record_unwind_protect
- (my_unwind, make_save_value (SAVE_TYPE_PTR_OBJ, md, my_object));
- ...
-
- Lisp_Object my_unwind (Lisp_Object arg)
- {
- struct my_data *md = XSAVE_POINTER (arg, 0);
- Lisp_Object my_object = XSAVE_OBJECT (arg, 1);
+ ptrdiff_t mi = XSAVE_INTEGER (arg, 1);
...
}
If ENABLE_CHECKING is in effect, XSAVE_xxx macros do type checking of the
saved objects and raise eassert if type of the saved object doesn't match
the type which is extracted. In the example above, XSAVE_INTEGER (arg, 2)
- or XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and
- Lisp_Object was saved in slot 1 of ARG. */
+ and XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and
+ slot 0 is a pointer. */
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);
- /* DATA[N] may hold up to SAVE_VALUE_SLOTS entries. The type of
- V's Ith entry is given by save_type (V, I). E.g., if save_type
- (V, 3) == SAVE_INTEGER, V->data[3].integer is in use.
+ /* 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
+ V->save_type == SAVE_TYPE_PTR_OBJ, V->data[0] is a pointer,
+ V->data[1] is an integer, and V's other data entries are unused.
- If SAVE_TYPE == SAVE_TYPE_MEMORY, DATA[0].pointer is the address of
- a memory area containing DATA[1].integer potential Lisp_Objects. */
+ If V->save_type == SAVE_TYPE_MEMORY, V->data[0].pointer is the address of
+ a memory area containing V->data[1].integer potential Lisp_Objects. */
ENUM_BF (Lisp_Save_Type) save_type : SAVE_TYPE_BITS;
union {
void *pointer;
};
/* Return the type of V's Nth saved value. */
-LISP_INLINE int
+INLINE int
save_type (struct Lisp_Save_Value *v, int n)
{
eassert (0 <= n && n < SAVE_VALUE_SLOTS);
/* Get and set the Nth saved pointer. */
-LISP_INLINE void *
+INLINE void *
XSAVE_POINTER (Lisp_Object obj, int n)
{
eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
return XSAVE_VALUE (obj)->data[n].pointer;
}
-LISP_INLINE void
+INLINE void
set_save_pointer (Lisp_Object obj, int n, void *val)
{
eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_POINTER);
XSAVE_VALUE (obj)->data[n].pointer = val;
}
-LISP_INLINE voidfuncptr
+INLINE voidfuncptr
XSAVE_FUNCPOINTER (Lisp_Object obj, int n)
{
eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_FUNCPOINTER);
/* Likewise for the saved integer. */
-LISP_INLINE ptrdiff_t
+INLINE ptrdiff_t
XSAVE_INTEGER (Lisp_Object obj, int n)
{
eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
return XSAVE_VALUE (obj)->data[n].integer;
}
-LISP_INLINE void
+INLINE void
set_save_integer (Lisp_Object obj, int n, ptrdiff_t val)
{
eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_INTEGER);
/* Extract Nth saved object. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
XSAVE_OBJECT (Lisp_Object obj, int n)
{
eassert (save_type (XSAVE_VALUE (obj), n) == SAVE_OBJECT);
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;
};
struct Lisp_Save_Value u_save_value;
};
-LISP_INLINE union Lisp_Misc *
+INLINE union Lisp_Misc *
XMISC (Lisp_Object a)
{
return XUNTAG (a, Lisp_Misc);
}
-LISP_INLINE struct Lisp_Misc_Any *
+INLINE struct Lisp_Misc_Any *
XMISCANY (Lisp_Object a)
{
eassert (MISCP (a));
return & XMISC (a)->u_any;
}
-LISP_INLINE enum Lisp_Misc_Type
+INLINE enum Lisp_Misc_Type
XMISCTYPE (Lisp_Object a)
{
return XMISCANY (a)->type;
}
-LISP_INLINE struct Lisp_Marker *
+INLINE struct Lisp_Marker *
XMARKER (Lisp_Object a)
{
eassert (MARKERP (a));
return & XMISC (a)->u_marker;
}
-LISP_INLINE struct Lisp_Overlay *
+INLINE struct Lisp_Overlay *
XOVERLAY (Lisp_Object a)
{
eassert (OVERLAYP (a));
return & XMISC (a)->u_overlay;
}
-LISP_INLINE struct Lisp_Save_Value *
+INLINE struct Lisp_Save_Value *
XSAVE_VALUE (Lisp_Object a)
{
eassert (SAVE_VALUEP (a));
/* 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. */
struct Lisp_Kboard_Objfwd u_kboard_objfwd;
};
-LISP_INLINE enum Lisp_Fwd_Type
+INLINE enum Lisp_Fwd_Type
XFWDTYPE (union Lisp_Fwd *a)
{
return a->u_intfwd.type;
}
-LISP_INLINE struct Lisp_Buffer_Objfwd *
+INLINE struct Lisp_Buffer_Objfwd *
XBUFFER_OBJFWD (union Lisp_Fwd *a)
{
eassert (BUFFER_OBJFWDP (a));
} u;
};
-LISP_INLINE double
+INLINE double
XFLOAT_DATA (Lisp_Object f)
{
return XFLOAT (f)->u.data;
CHARACTERBITS = 22
};
\f
-/* Structure to hold mouse highlight data. This is here because other
- header files need it for defining struct x_output etc. */
-typedef struct {
- /* These variables describe the range of text currently shown in its
- mouse-face, together with the window they apply to. As long as
- the mouse stays within this range, we need not redraw anything on
- its account. Rows and columns are glyph matrix positions in
- MOUSE_FACE_WINDOW. */
- int mouse_face_beg_row, mouse_face_beg_col;
- int mouse_face_beg_x, mouse_face_beg_y;
- int mouse_face_end_row, mouse_face_end_col;
- int mouse_face_end_x, mouse_face_end_y;
- Lisp_Object mouse_face_window;
- int mouse_face_face_id;
- Lisp_Object mouse_face_overlay;
-
- /* FRAME and X, Y position of mouse when last checked for
- highlighting. X and Y can be negative or out of range for the frame. */
- struct frame *mouse_face_mouse_frame;
- int mouse_face_mouse_x, mouse_face_mouse_y;
-
- /* Nonzero if part of the text currently shown in
- its mouse-face is beyond the window end. */
- unsigned mouse_face_past_end : 1;
-
- /* Nonzero means defer mouse-motion highlighting. */
- unsigned mouse_face_defer : 1;
-
- /* Nonzero means that the mouse highlight should not be shown. */
- unsigned mouse_face_hidden : 1;
-} Mouse_HLInfo;
-\f
/* Data type checking. */
LISP_MACRO_DEFUN (NILP, bool, (Lisp_Object x), (x))
-LISP_INLINE bool
+INLINE bool
NUMBERP (Lisp_Object x)
{
return INTEGERP (x) || FLOATP (x);
}
-LISP_INLINE bool
+INLINE bool
NATNUMP (Lisp_Object x)
{
return INTEGERP (x) && 0 <= XINT (x);
}
-LISP_INLINE bool
+INLINE bool
RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intmax_t hi)
{
return INTEGERP (x) && lo <= XINT (x) && XINT (x) <= hi;
LISP_MACRO_DEFUN (VECTORLIKEP, bool, (Lisp_Object x), (x))
LISP_MACRO_DEFUN (MARKERP, bool, (Lisp_Object x), (x))
-LISP_INLINE bool
+INLINE bool
STRINGP (Lisp_Object x)
{
return XTYPE (x) == Lisp_String;
}
-LISP_INLINE bool
+INLINE bool
VECTORP (Lisp_Object x)
{
return VECTORLIKEP (x) && ! (ASIZE (x) & PSEUDOVECTOR_FLAG);
}
-LISP_INLINE bool
+INLINE bool
OVERLAYP (Lisp_Object x)
{
return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay;
}
-LISP_INLINE bool
+INLINE bool
SAVE_VALUEP (Lisp_Object x)
{
return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value;
}
-LISP_INLINE bool
+INLINE bool
AUTOLOADP (Lisp_Object x)
{
return CONSP (x) && EQ (Qautoload, XCAR (x));
}
-LISP_INLINE bool
+INLINE bool
BUFFER_OBJFWDP (union Lisp_Fwd *a)
{
return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj;
}
-LISP_INLINE bool
+INLINE bool
PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, int code)
{
return ((a->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK))
}
/* True if A is a pseudovector whose code is CODE. */
-LISP_INLINE bool
+INLINE bool
PSEUDOVECTORP (Lisp_Object a, int code)
{
if (! VECTORLIKEP (a))
- return 0;
+ return false;
else
{
/* Converting to struct vectorlike_header * avoids aliasing issues. */
/* Test for specific pseudovector types. */
-LISP_INLINE bool
+INLINE bool
WINDOW_CONFIGURATIONP (Lisp_Object a)
{
return PSEUDOVECTORP (a, PVEC_WINDOW_CONFIGURATION);
}
-LISP_INLINE bool
+INLINE bool
PROCESSP (Lisp_Object a)
{
return PSEUDOVECTORP (a, PVEC_PROCESS);
}
-LISP_INLINE bool
+INLINE bool
WINDOWP (Lisp_Object a)
{
return PSEUDOVECTORP (a, PVEC_WINDOW);
}
-LISP_INLINE bool
+INLINE bool
TERMINALP (Lisp_Object a)
{
return PSEUDOVECTORP (a, PVEC_TERMINAL);
}
-LISP_INLINE bool
+INLINE bool
SUBRP (Lisp_Object a)
{
return PSEUDOVECTORP (a, PVEC_SUBR);
}
-LISP_INLINE bool
+INLINE bool
COMPILEDP (Lisp_Object a)
{
return PSEUDOVECTORP (a, PVEC_COMPILED);
}
-LISP_INLINE bool
+INLINE bool
BUFFERP (Lisp_Object a)
{
return PSEUDOVECTORP (a, PVEC_BUFFER);
}
-LISP_INLINE bool
+INLINE bool
CHAR_TABLE_P (Lisp_Object a)
{
return PSEUDOVECTORP (a, PVEC_CHAR_TABLE);
}
-LISP_INLINE bool
+INLINE bool
SUB_CHAR_TABLE_P (Lisp_Object a)
{
return PSEUDOVECTORP (a, PVEC_SUB_CHAR_TABLE);
}
-LISP_INLINE bool
+INLINE bool
BOOL_VECTOR_P (Lisp_Object a)
{
return PSEUDOVECTORP (a, PVEC_BOOL_VECTOR);
}
-LISP_INLINE bool
+INLINE bool
FRAMEP (Lisp_Object a)
{
return PSEUDOVECTORP (a, PVEC_FRAME);
}
/* Test for image (image . spec) */
-LISP_INLINE bool
+INLINE bool
IMAGEP (Lisp_Object x)
{
return CONSP (x) && EQ (XCAR (x), Qimage);
}
/* Array types. */
-LISP_INLINE bool
+INLINE bool
ARRAYP (Lisp_Object x)
{
return VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x);
}
\f
-LISP_INLINE void
+INLINE void
CHECK_LIST (Lisp_Object x)
{
CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x);
LISP_MACRO_DEFUN_VOID (CHECK_SYMBOL, (Lisp_Object x), (x))
LISP_MACRO_DEFUN_VOID (CHECK_NUMBER, (Lisp_Object x), (x))
-LISP_INLINE void
+INLINE void
CHECK_STRING (Lisp_Object x)
{
CHECK_TYPE (STRINGP (x), Qstringp, x);
}
-LISP_INLINE void
+INLINE void
CHECK_STRING_CAR (Lisp_Object x)
{
CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x));
}
-LISP_INLINE void
+INLINE void
CHECK_CONS (Lisp_Object x)
{
CHECK_TYPE (CONSP (x), Qconsp, x);
}
-LISP_INLINE void
+INLINE void
CHECK_VECTOR (Lisp_Object x)
{
CHECK_TYPE (VECTORP (x), Qvectorp, x);
}
-LISP_INLINE void
+INLINE void
+CHECK_BOOL_VECTOR (Lisp_Object x)
+{
+ CHECK_TYPE (BOOL_VECTOR_P (x), Qbool_vector_p, x);
+}
+INLINE void
CHECK_VECTOR_OR_STRING (Lisp_Object x)
{
CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x);
}
-LISP_INLINE void
+INLINE void
CHECK_ARRAY (Lisp_Object x, Lisp_Object Qxxxp)
{
CHECK_TYPE (ARRAYP (x), Qxxxp, x);
}
-LISP_INLINE void
+INLINE void
CHECK_BUFFER (Lisp_Object x)
{
CHECK_TYPE (BUFFERP (x), Qbufferp, x);
}
-LISP_INLINE void
+INLINE void
CHECK_WINDOW (Lisp_Object x)
{
CHECK_TYPE (WINDOWP (x), Qwindowp, x);
}
-LISP_INLINE void
+INLINE void
CHECK_PROCESS (Lisp_Object x)
{
CHECK_TYPE (PROCESSP (x), Qprocessp, x);
}
-LISP_INLINE void
+INLINE void
CHECK_NATNUM (Lisp_Object x)
{
CHECK_TYPE (NATNUMP (x), Qwholenump, 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)
-LISP_INLINE double
+INLINE double
XFLOATINT (Lisp_Object n)
{
return extract_float (n);
}
-LISP_INLINE void
+INLINE void
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. */
-LISP_INLINE void
+INLINE void
CHECK_NUMBER_CAR (Lisp_Object x)
{
Lisp_Object tmp = XCAR (x);
XSETCAR (x, tmp);
}
-LISP_INLINE void
+INLINE void
CHECK_NUMBER_CDR (Lisp_Object x)
{
Lisp_Object tmp = XCDR (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 }, \
- { .a ## maxargs = fnname }, \
+ { DEFUN_FUNCTION_INIT (fnname, maxargs) }, \
minargs, maxargs, lname, intspec, 0}; \
Lisp_Object fnname
#endif
Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
/* True if OBJ is a Lisp function. */
-LISP_INLINE bool
+INLINE bool
FUNCTIONP (Lisp_Object obj)
{
return functionp (obj);
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. */
- 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. */
they are bound by a function application or a let form, stores the
code to be executed for unwind-protect forms.
- If func is non-zero, undoing this binding applies func to old_value;
- This implements record_unwind_protect.
-
- Otherwise, the element is a variable binding.
-
- If the symbol field is a symbol, it is an ordinary variable binding.
-
- Otherwise, it should be a structure (SYMBOL WHERE . CURRENT-BUFFER),
- which means having bound a local value while CURRENT-BUFFER was active.
- If WHERE is nil this means we saw the default value when binding SYMBOL.
- WHERE being a buffer or frame means we saw a buffer-local or frame-local
- value. Other values of WHERE mean an internal error.
-
NOTE: The specbinding union is defined here, because SPECPDL_INDEX is
used all over the place, needs to be fast, and needs to know the size of
union specbinding. But only eval.c should access it. */
-typedef Lisp_Object (*specbinding_func) (Lisp_Object);
-
enum specbind_tag {
- SPECPDL_UNWIND, /* An unwind_protect function. */
+ SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */
+ SPECPDL_UNWIND_PTR, /* Likewise, on void *. */
+ SPECPDL_UNWIND_INT, /* Likewise, on int. */
+ SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */
SPECPDL_BACKTRACE, /* An element of the backtrace. */
SPECPDL_LET, /* A plain and simple dynamic let-binding. */
/* Tags greater than SPECPDL_LET must be "subkinds" of LET. */
ENUM_BF (specbind_tag) kind : CHAR_BIT;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
+ void (*func) (Lisp_Object);
Lisp_Object arg;
- specbinding_func func;
} unwind;
+ struct {
+ ENUM_BF (specbind_tag) kind : CHAR_BIT;
+ void (*func) (void *);
+ void *arg;
+ } unwind_ptr;
+ struct {
+ ENUM_BF (specbind_tag) kind : CHAR_BIT;
+ void (*func) (int);
+ int arg;
+ } unwind_int;
+ struct {
+ ENUM_BF (specbind_tag) kind : CHAR_BIT;
+ void (*func) (void);
+ } unwind_void;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
/* `where' is not used in the case of SPECPDL_LET. */
} 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;
extern union specbinding *specpdl_ptr;
extern ptrdiff_t specpdl_size;
-LISP_INLINE ptrdiff_t
+INLINE ptrdiff_t
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.
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.
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'. */
/* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */
-LISP_INLINE void
+INLINE void
vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object *args, ptrdiff_t count)
{
eassert (0 <= offset && 0 <= count && offset + count <= ASIZE (v));
/* Functions to modify hash tables. */
-LISP_INLINE void
+INLINE void
set_hash_key_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
{
gc_aset (h->key_and_value, 2 * idx, val);
}
-LISP_INLINE void
+INLINE void
set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
{
gc_aset (h->key_and_value, 2 * idx + 1, val);
/* Use these functions to set Lisp_Object
or pointer slots of struct Lisp_Symbol. */
-LISP_INLINE void
+INLINE void
set_symbol_function (Lisp_Object sym, Lisp_Object function)
{
XSYMBOL (sym)->function = function;
}
-LISP_INLINE void
+INLINE void
set_symbol_plist (Lisp_Object sym, Lisp_Object plist)
{
XSYMBOL (sym)->plist = plist;
}
-LISP_INLINE void
+INLINE void
set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next)
{
XSYMBOL (sym)->next = next;
/* Buffer-local (also frame-local) variable access functions. */
-LISP_INLINE int
+INLINE int
blv_found (struct Lisp_Buffer_Local_Value *blv)
{
eassert (blv->found == !EQ (blv->defcell, blv->valcell));
/* Set overlay's property list. */
-LISP_INLINE void
+INLINE void
set_overlay_plist (Lisp_Object overlay, Lisp_Object plist)
{
XOVERLAY (overlay)->plist = plist;
/* Get text properties of S. */
-LISP_INLINE INTERVAL
+INLINE INTERVAL
string_intervals (Lisp_Object s)
{
return XSTRING (s)->intervals;
/* Set text properties of S to I. */
-LISP_INLINE void
+INLINE void
set_string_intervals (Lisp_Object s, INTERVAL i)
{
XSTRING (s)->intervals = i;
/* Set a Lisp slot in TABLE to VAL. Most code should use this instead
of setting slots directly. */
-LISP_INLINE void
+INLINE void
set_char_table_defalt (Lisp_Object table, Lisp_Object val)
{
XCHAR_TABLE (table)->defalt = val;
}
-LISP_INLINE void
+INLINE void
set_char_table_purpose (Lisp_Object table, Lisp_Object val)
{
XCHAR_TABLE (table)->purpose = val;
/* Set different slots in (sub)character tables. */
-LISP_INLINE void
+INLINE void
set_char_table_extras (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
{
eassert (0 <= idx && idx < CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (table)));
XCHAR_TABLE (table)->extras[idx] = val;
}
-LISP_INLINE void
+INLINE void
set_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
{
eassert (0 <= idx && idx < (1 << CHARTAB_SIZE_BITS_0));
XCHAR_TABLE (table)->contents[idx] = val;
}
-LISP_INLINE void
+INLINE void
set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
{
XSUB_CHAR_TABLE (table)->contents[idx] = val;
/* Defined in data.c. */
extern Lisp_Object indirect_function (Lisp_Object);
extern Lisp_Object find_symbol_value (Lisp_Object);
+enum Arith_Comparison {
+ ARITH_EQUAL,
+ ARITH_NOTEQUAL,
+ ARITH_LESS,
+ ARITH_GRTR,
+ ARITH_LESS_OR_EQUAL,
+ ARITH_GRTR_OR_EQUAL
+};
+extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2,
+ enum Arith_Comparison comparison);
/* Convert the integer I to an Emacs representation, either the integer
itself, or a cons of two or three integers, or if all else fails a float.
extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t);
+extern Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object do_yes_or_no_p (Lisp_Object);
extern Lisp_Object concat2 (Lisp_Object, Lisp_Object);
extern Lisp_Object concat3 (Lisp_Object, Lisp_Object, Lisp_Object);
extern void del_range_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool);
extern Lisp_Object del_range_2 (ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t, bool);
-extern void modify_region_1 (ptrdiff_t, ptrdiff_t, bool);
+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);
&& (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__))
_Noreturn void __executable_start (void);
#endif
-extern Lisp_Object selected_frame;
extern Lisp_Object Vwindow_system;
extern Lisp_Object sit_for (Lisp_Object, bool, int);
extern void init_display (void);
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;
-extern struct frame *last_glyphless_glyph_frame;
-extern int last_glyphless_glyph_face_id;
-extern int last_glyphless_glyph_merged_face_id;
-extern int noninteractive_need_newline;
+extern bool noninteractive_need_newline;
extern Lisp_Object echo_area_buffer[2];
extern void add_to_log (const char *, Lisp_Object, Lisp_Object);
extern void check_message_stack (void);
extern void setup_echo_area_for_printing (int);
extern bool push_message (void);
-extern Lisp_Object pop_message_unwind (Lisp_Object);
+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 *);
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);
/* Build a frequently used 2/3/4-integer lists. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
list2i (EMACS_INT x, EMACS_INT y)
{
return list2 (make_number (x), make_number (y));
}
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
list3i (EMACS_INT x, EMACS_INT y, EMACS_INT w)
{
return list3 (make_number (x), make_number (y), make_number (w));
}
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
list4i (EMACS_INT x, EMACS_INT y, EMACS_INT w, EMACS_INT h)
{
return list4 (make_number (x), make_number (y),
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 *, ...)
/* Make unibyte string from C string when the length isn't known. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
build_unibyte_string (const char *str)
{
return make_unibyte_string (str, strlen (str));
}
extern Lisp_Object make_multibyte_string (const char *, ptrdiff_t, ptrdiff_t);
-extern Lisp_Object make_event_array (int, Lisp_Object *);
+extern Lisp_Object make_event_array (ptrdiff_t, Lisp_Object *);
extern Lisp_Object make_uninit_string (EMACS_INT);
extern Lisp_Object make_uninit_multibyte_string (EMACS_INT, EMACS_INT);
extern Lisp_Object make_string_from_bytes (const char *, ptrdiff_t, ptrdiff_t);
/* Make a string allocated in pure space, use STR as string data. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
build_pure_c_string (const char *str)
{
return make_pure_c_string (str, strlen (str));
/* Make a string from the data at STR, treating it as multibyte if the
data warrants. */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
build_string (const char *str)
{
return make_string (str, strlen (str));
ASET (v, 1, Ffunction_can_gc ());
ASET (v, 2, obj1); */
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
make_uninit_vector (ptrdiff_t size)
{
Lisp_Object v;
extern Lisp_Object make_float (double);
extern void display_malloc_warning (void);
extern ptrdiff_t inhibit_garbage_collection (void);
-extern Lisp_Object make_save_value (enum Lisp_Save_Type, ...);
-extern Lisp_Object make_save_pointer (void *);
+extern Lisp_Object make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t);
+extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object);
+extern Lisp_Object make_save_ptr (void *);
+extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t);
+extern Lisp_Object make_save_ptr_ptr (void *, void *);
+extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *,
+ Lisp_Object);
+extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t);
+extern void free_save_value (Lisp_Object);
extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
extern void free_marker (Lisp_Object);
extern void free_cons (struct Lisp_Cons *);
#ifdef GC_CHECK_CONS_LIST
extern void check_cons_list (void);
#else
-LISP_INLINE void (check_cons_list) (void) { lisp_h_check_cons_list (); }
+INLINE void (check_cons_list) (void) { lisp_h_check_cons_list (); }
#endif
#ifdef REL_ALLOC
extern Lisp_Object intern_1 (const char *, ptrdiff_t);
extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
-LISP_INLINE void
+INLINE void
LOADHIST_ATTACH (Lisp_Object x)
{
if (initialized)
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 init_lread (void);
extern void syms_of_lread (void);
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
intern (const char *str)
{
return intern_1 (str, strlen (str));
}
-LISP_INLINE Lisp_Object
+INLINE Lisp_Object
intern_c_string (const char *str)
{
return intern_c_string_1 (str, strlen (str));
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:
(Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
extern void specbind (Lisp_Object, Lisp_Object);
-extern void record_unwind_protect (Lisp_Object (*) (Lisp_Object), Lisp_Object);
+extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object);
+extern void record_unwind_protect_ptr (void (*) (void *), void *);
+extern void record_unwind_protect_int (void (*) (int), int);
+extern void record_unwind_protect_void (void (*) (void));
+extern void record_unwind_protect_nothing (void);
+extern void clear_unwind_protect (ptrdiff_t);
+extern void set_unwind_protect (ptrdiff_t, void (*) (Lisp_Object), Lisp_Object);
+extern void set_unwind_protect_ptr (ptrdiff_t, void (*) (void *), void *);
extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
extern _Noreturn void verror (const char *, va_list)
ATTRIBUTE_FORMAT_PRINTF (1, 0);
-extern Lisp_Object un_autoload (Lisp_Object);
+extern void un_autoload (Lisp_Object);
extern Lisp_Object call_debugger (Lisp_Object arg);
extern void init_eval_once (void);
extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
extern void init_eval (void);
extern void syms_of_eval (void);
+extern void unwind_body (Lisp_Object);
extern void record_in_backtrace (Lisp_Object function,
Lisp_Object *args, ptrdiff_t nargs);
extern void mark_specpdl (void);
extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object);
extern Lisp_Object save_excursion_save (void);
extern Lisp_Object save_restriction_save (void);
-extern Lisp_Object save_excursion_restore (Lisp_Object);
-extern Lisp_Object save_restriction_restore (Lisp_Object);
+extern void save_excursion_restore (Lisp_Object);
+extern void save_restriction_restore (Lisp_Object);
extern _Noreturn void time_overflow (void);
extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
extern void report_overlay_modification (Lisp_Object, Lisp_Object, bool,
Lisp_Object, Lisp_Object, Lisp_Object);
extern bool overlay_touches_p (ptrdiff_t);
-extern Lisp_Object Vbuffer_alist;
-extern Lisp_Object set_buffer_if_live (Lisp_Object);
extern Lisp_Object other_buffer_safely (Lisp_Object);
-extern Lisp_Object Qpriority, Qwindow, Qbefore_string, Qafter_string;
extern Lisp_Object get_truename_buffer (Lisp_Object);
extern void init_buffer_once (void);
extern void init_buffer (void);
extern Lisp_Object Qinsert_file_contents;
extern Lisp_Object Qfile_name_history;
extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object);
+extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object, int);
EXFUN (Fread_file_name, 6); /* Not a normal DEFUN. */
-extern Lisp_Object close_file_unwind (Lisp_Object);
-extern Lisp_Object restore_point_unwind (Lisp_Object);
+extern void close_file_unwind (int);
+extern void fclose_unwind (void *);
+extern void restore_point_unwind (Lisp_Object);
+extern _Noreturn void report_file_errno (const char *, Lisp_Object, int);
extern _Noreturn void report_file_error (const char *, Lisp_Object);
extern bool internal_delete_file (Lisp_Object);
extern Lisp_Object emacs_readlinkat (int, const char *);
extern 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);
ptrdiff_t, ptrdiff_t, Lisp_Object);
extern ptrdiff_t find_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t *, ptrdiff_t *, bool);
-extern EMACS_INT scan_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
- EMACS_INT, bool);
+extern ptrdiff_t scan_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, bool);
extern ptrdiff_t find_newline_no_quit (ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t *);
extern ptrdiff_t find_before_next_newline (ptrdiff_t, ptrdiff_t,
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);
void synchronize_system_messages_locale (void);
void synchronize_system_time_locale (void);
#else
-LISP_INLINE void fixup_locale (void) {}
-LISP_INLINE void synchronize_system_messages_locale (void) {}
-LISP_INLINE void synchronize_system_time_locale (void) {}
+INLINE void fixup_locale (void) {}
+INLINE void synchronize_system_messages_locale (void) {}
+INLINE void synchronize_system_time_locale (void) {}
#endif
extern void shut_down_emacs (int, Lisp_Object);
extern void syms_of_process (void);
extern void setup_process_coding_systems (Lisp_Object);
+/* Defined in callproc.c. */
#ifndef DOS_NT
_Noreturn
#endif
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 reset_sys_modes (struct tty_display_info *);
extern void init_all_sys_modes (void);
extern void reset_all_sys_modes (void);
-extern void flush_pending_output (int) ATTRIBUTE_CONST;
extern void child_setup_tty (int);
extern void setup_pty (int);
extern int set_window_size (int, int, int);
extern void emacs_backtrace (int);
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_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);
extern void lock_file (Lisp_Object);
extern void xml_cleanup_parser (void);
#endif
+#ifdef HAVE_ZLIB
+/* Defined in decompress.c. */
+extern void syms_of_decompress (void);
+#endif
+
#ifdef HAVE_DBUS
/* Defined in dbusbind.c. */
void syms_of_dbusbind (void);
extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t);
extern char *xstrdup (const char *);
+extern char *xlispstrdup (Lisp_Object);
+extern void dupstring (char **, char const *);
extern void xputenv (const char *);
extern char *egetenv (const char *);
+/* Copy Lisp string to temporary (allocated on stack) C string. */
+
+#define xlispstrdupa(string) \
+ memcpy (alloca (SBYTES (string) + 1), \
+ SSDATA (string), SBYTES (string) + 1)
+
/* Set up the name of the machine we're running on. */
extern void init_system_name (void);
enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 };
-extern Lisp_Object safe_alloca_unwind (Lisp_Object);
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
else \
{ \
(buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \
- sa_must_free = 1; \
- record_unwind_protect (safe_alloca_unwind, \
- make_save_pointer (buf)); \
+ 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); \
- arg_ = make_save_value (SAVE_TYPE_MEMORY, buf, nelt); \
- sa_must_free = 1; \
- record_unwind_protect (safe_alloca_unwind, arg_); \
+ (buf) = xmalloc ((nelt) * word_size); \
+ arg_ = make_save_memory (buf, nelt); \
+ 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)), true)); \
+ (list_var) = XCDR (list_var))
/* Check whether it's time for GC, and run it if so. */
-LISP_INLINE void
+INLINE void
maybe_gc (void)
{
if ((consing_since_gc > gc_cons_threshold
Fgarbage_collect ();
}
-LISP_INLINE bool
+INLINE bool
functionp (Lisp_Object object)
{
if (SYMBOLP (object) && !NILP (Ffboundp (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
HCoop / bpt / emacs.git / blobdiff