diff options
Diffstat (limited to 'src/lisp.h')
| -rw-r--r-- | src/lisp.h | 1259 |
1 files changed, 600 insertions, 659 deletions
diff --git a/src/lisp.h b/src/lisp.h index b410ee45aed..e7747563085 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -21,10 +21,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #ifndef EMACS_LISP_H #define EMACS_LISP_H +#include <alloca.h> #include <setjmp.h> #include <stdalign.h> #include <stdarg.h> #include <stddef.h> +#include <string.h> #include <float.h> #include <inttypes.h> #include <limits.h> @@ -68,6 +70,7 @@ DEFINE_GDB_SYMBOL_BEGIN (int, GCTYPEBITS) DEFINE_GDB_SYMBOL_END (GCTYPEBITS) /* EMACS_INT - signed integer wide enough to hold an Emacs value + EMACS_INT_WIDTH - width in bits of EMACS_INT EMACS_INT_MAX - maximum value of EMACS_INT; can be used in #if pI - printf length modifier for EMACS_INT EMACS_UINT - unsigned variant of EMACS_INT */ @@ -77,18 +80,25 @@ DEFINE_GDB_SYMBOL_END (GCTYPEBITS) # elif INTPTR_MAX <= INT_MAX && !defined WIDE_EMACS_INT typedef int EMACS_INT; typedef unsigned int EMACS_UINT; +enum { EMACS_INT_WIDTH = INT_WIDTH }; # 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; +enum { EMACS_INT_WIDTH = LONG_WIDTH }; # 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; +enum { EMACS_INT_WIDTH = LLONG_WIDTH }; # define EMACS_INT_MAX LLONG_MAX -# define pI "ll" +# ifdef __MINGW32__ +# define pI "I64" +# else +# define pI "ll" +# endif # else # error "INTPTR_MAX too large" # endif @@ -103,11 +113,12 @@ enum { BOOL_VECTOR_BITS_PER_CHAR = /* An unsigned integer type representing a fixed-length bit sequence, suitable for bool vector words, GC mark bits, etc. Normally it is size_t - for speed, but it is unsigned char on weird platforms. */ + for speed, but on weird platforms it is unsigned char and not all + its bits are used. */ #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) }; +enum { BITS_PER_BITS_WORD = SIZE_WIDTH }; #else typedef unsigned char bits_word; # define BITS_WORD_MAX ((1u << BOOL_VECTOR_BITS_PER_CHAR) - 1) @@ -115,15 +126,6 @@ enum { BITS_PER_BITS_WORD = BOOL_VECTOR_BITS_PER_CHAR }; #endif verify (BITS_WORD_MAX >> (BITS_PER_BITS_WORD - 1) == 1); -/* Number of bits in some machine integer types. */ -enum - { - BITS_PER_CHAR = CHAR_BIT, - BITS_PER_SHORT = CHAR_BIT * sizeof (short), - BITS_PER_LONG = CHAR_BIT * sizeof (long int), - BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT) - }; - /* printmax_t and uprintmax_t are types for printing large integers. These are the widest integers that are supported for printing. pMd etc. are conversions for printing them. @@ -228,7 +230,7 @@ enum Lisp_Bits #define GCALIGNMENT 8 /* Number of bits in a Lisp_Object value, not counting the tag. */ - VALBITS = BITS_PER_EMACS_INT - GCTYPEBITS, + VALBITS = EMACS_INT_WIDTH - GCTYPEBITS, /* Number of bits in a Lisp fixnum tag. */ INTTYPEBITS = GCTYPEBITS - 1, @@ -256,6 +258,11 @@ DEFINE_GDB_SYMBOL_BEGIN (bool, USE_LSB_TAG) #define USE_LSB_TAG (VAL_MAX / 2 < INTPTR_MAX) DEFINE_GDB_SYMBOL_END (USE_LSB_TAG) +/* Mask for the value (as opposed to the type bits) of a Lisp object. */ +DEFINE_GDB_SYMBOL_BEGIN (EMACS_INT, VALMASK) +# define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX) +DEFINE_GDB_SYMBOL_END (VALMASK) + #if !USE_LSB_TAG && !defined WIDE_EMACS_INT # error "USE_LSB_TAG not supported on this platform; please report this." \ "Try 'configure --with-wide-int' to work around the problem." @@ -290,9 +297,8 @@ error !; used elsewhere. FIXME: Remove the lisp_h_OP macros, and define just the inline OP - functions, once most developers have access to GCC 4.8 or later and - can use "gcc -Og" to debug. Maybe in the year 2016. See - Bug#11935. + functions, once "gcc -Og" (new to GCC 4.8) works well enough for + Emacs developers. Maybe in the year 2020. See Bug#11935. Commentary for these macros can be found near their corresponding functions, below. */ @@ -308,7 +314,7 @@ error !; #define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x) #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) #define lisp_h_CHECK_TYPE(ok, predicate, x) \ - ((ok) ? (void) 0 : (void) wrong_type_argument (predicate, x)) + ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) #define lisp_h_CONSP(x) (XTYPE (x) == Lisp_Cons) #define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) #define lisp_h_FLOATP(x) (XTYPE (x) == Lisp_Float) @@ -318,7 +324,8 @@ error !; #define lisp_h_NILP(x) EQ (x, Qnil) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) -#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant) +#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->trapped_write == SYMBOL_NOWRITE) +#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->trapped_write) #define lisp_h_SYMBOL_VAL(sym) \ (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value) #define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) @@ -341,7 +348,9 @@ error !; (struct Lisp_Symbol *) ((intptr_t) XLI (a) - Lisp_Symbol \ + (char *) lispsym)) # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK)) -# define lisp_h_XUNTAG(a, type) ((void *) (intptr_t) (XLI (a) - (type))) +# define lisp_h_XUNTAG(a, type) \ + __builtin_assume_aligned ((void *) (intptr_t) (XLI (a) - (type)), \ + GCALIGNMENT) #endif /* When compiling via gcc -O0, define the key operations as macros, as @@ -371,6 +380,7 @@ error !; # define NILP(x) lisp_h_NILP (x) # define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v) # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) +# define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym) # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) # define SYMBOLP(x) lisp_h_SYMBOLP (x) # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) @@ -547,68 +557,87 @@ typedef EMACS_INT Lisp_Object; #define LISP_INITIALLY(i) (i) enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false }; #endif /* CHECK_LISP_OBJECT_TYPE */ - -#define LISP_INITIALLY_ZERO LISP_INITIALLY (0) /* Forward declarations. */ /* Defined in this file. */ -union Lisp_Fwd; -INLINE bool BOOL_VECTOR_P (Lisp_Object); -INLINE bool BUFFER_OBJFWDP (union Lisp_Fwd *); -INLINE bool BUFFERP (Lisp_Object); -INLINE bool CHAR_TABLE_P (Lisp_Object); -INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object, ptrdiff_t); -INLINE bool (CONSP) (Lisp_Object); -INLINE bool (FLOATP) (Lisp_Object); -INLINE bool functionp (Lisp_Object); -INLINE bool (INTEGERP) (Lisp_Object); -INLINE bool (MARKERP) (Lisp_Object); -INLINE bool (MISCP) (Lisp_Object); -INLINE bool (NILP) (Lisp_Object); -INLINE bool OVERLAYP (Lisp_Object); -INLINE bool PROCESSP (Lisp_Object); -INLINE bool PSEUDOVECTORP (Lisp_Object, int); -INLINE bool SAVE_VALUEP (Lisp_Object); -INLINE bool FINALIZERP (Lisp_Object); - -#ifdef HAVE_MODULES -INLINE bool USER_PTRP (Lisp_Object); -INLINE struct Lisp_User_Ptr *(XUSER_PTR) (Lisp_Object); -#endif - INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, Lisp_Object); -INLINE bool STRINGP (Lisp_Object); -INLINE bool SUB_CHAR_TABLE_P (Lisp_Object); -INLINE bool SUBRP (Lisp_Object); -INLINE bool (SYMBOLP) (Lisp_Object); -INLINE bool (VECTORLIKEP) (Lisp_Object); -INLINE bool WINDOWP (Lisp_Object); -INLINE bool TERMINALP (Lisp_Object); -INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object); -INLINE struct Lisp_Finalizer *XFINALIZER (Lisp_Object); -INLINE struct Lisp_Symbol *(XSYMBOL) (Lisp_Object); -INLINE void *(XUNTAG) (Lisp_Object, int); /* Defined in chartab.c. */ extern Lisp_Object char_table_ref (Lisp_Object, int); extern void char_table_set (Lisp_Object, int, Lisp_Object); /* Defined in data.c. */ -extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); -extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object); +extern _Noreturn void wrong_type_argument (Lisp_Object, Lisp_Object); + +#ifdef CANNOT_DUMP +enum { might_dump = false }; +#elif defined DOUG_LEA_MALLOC /* Defined in emacs.c. */ extern bool might_dump; +#endif /* True means Emacs has already been initialized. Used during startup to detect startup of dumped Emacs. */ extern bool initialized; +extern bool generating_ldefs_boot; + /* Defined in floatfns.c. */ extern double extract_float (Lisp_Object); +/* Low-level conversion and type checking. */ + +/* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa. + At the machine level, these operations are no-ops. */ + +INLINE EMACS_INT +(XLI) (Lisp_Object o) +{ + return lisp_h_XLI (o); +} + +INLINE Lisp_Object +(XIL) (EMACS_INT i) +{ + return lisp_h_XIL (i); +} + +/* Extract A's type. */ + +INLINE enum Lisp_Type +(XTYPE) (Lisp_Object a) +{ +#if USE_LSB_TAG + return lisp_h_XTYPE (a); +#else + EMACS_UINT i = XLI (a); + return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS; +#endif +} + +INLINE void +(CHECK_TYPE) (int ok, Lisp_Object predicate, Lisp_Object x) +{ + lisp_h_CHECK_TYPE (ok, predicate, x); +} + +/* Extract A's pointer value, assuming A's type is TYPE. */ + +INLINE void * +(XUNTAG) (Lisp_Object a, int type) +{ +#if USE_LSB_TAG + return lisp_h_XUNTAG (a, type); +#else + intptr_t i = USE_LSB_TAG ? XLI (a) - type : XLI (a) & VALMASK; + return (void *) i; +#endif +} + + /* Interned state of a symbol. */ enum symbol_interned @@ -626,6 +655,13 @@ enum symbol_redirect SYMBOL_FORWARDED = 3 }; +enum symbol_trapped_write +{ + SYMBOL_UNTRAPPED_WRITE = 0, + SYMBOL_NOWRITE = 1, + SYMBOL_TRAPPED_WRITE = 2 +}; + struct Lisp_Symbol { bool_bf gcmarkbit : 1; @@ -637,10 +673,10 @@ struct Lisp_Symbol 3 : it's a forwarding variable, the value is in `forward'. */ ENUM_BF (symbol_redirect) redirect : 3; - /* Non-zero means symbol is constant, i.e. changing its value - should signal an error. If the value is 3, then the var - can be changed, but only by `defconst'. */ - unsigned constant : 2; + /* 0 : normal case, just set the value + 1 : constant, cannot set, e.g. nil, t, :keywords. + 2 : trap the write, call watcher functions. */ + ENUM_BF (symbol_trapped_write) trapped_write : 2; /* Interned state of the symbol. This is an enumerator from enum symbol_interned. */ @@ -719,12 +755,20 @@ struct Lisp_Symbol except the former expands to an integer constant expression. */ #define XLI_BUILTIN_LISPSYM(iname) TAG_SYMOFFSET ((iname) * sizeof *lispsym) +/* LISPSYM_INITIALLY (Qfoo) is equivalent to Qfoo except it is + designed for use as an initializer, even for a constant initializer. */ +#define LISPSYM_INITIALLY(name) LISP_INITIALLY (XLI_BUILTIN_LISPSYM (i##name)) + /* Declare extern constants for Lisp symbols. These can be helpful when using a debugger like GDB, on older platforms where the debug format does not represent C macros. */ #define DEFINE_LISP_SYMBOL(name) \ DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) \ - DEFINE_GDB_SYMBOL_END (LISP_INITIALLY (XLI_BUILTIN_LISPSYM (i##name))) + DEFINE_GDB_SYMBOL_END (LISPSYM_INITIALLY (name)) + +/* The index of the C-defined Lisp symbol SYM. + This can be used in a static initializer. */ +#define SYMBOL_INDEX(sym) i##sym /* By default, define macros for Qt, etc., as this leads to a bit better performance in the core Emacs interpreter. A plugin can @@ -736,19 +780,74 @@ struct Lisp_Symbol #include "globals.h" -/* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa. - At the machine level, these operations are no-ops. */ +/* Header of vector-like objects. This documents the layout constraints on + vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents + compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR + 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: + - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit. + - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain + vector (0) or a pseudovector (1). + - If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number + of slots) of the vector. + - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into three fields: + - a) pseudovector subtype held in PVEC_TYPE_MASK field; + - b) number of Lisp_Objects slots at the beginning of the object + held in PSEUDOVECTOR_SIZE_MASK field. These objects are always + traced by the GC; + - c) size of the rest fields held in PSEUDOVECTOR_REST_MASK and + measured in word_size units. Rest fields may also include + Lisp_Objects, but these objects usually needs some special treatment + during GC. + There are some exceptions. For PVEC_FREE, b) is always zero. For + PVEC_BOOL_VECTOR and PVEC_SUBR, both b) and c) are always zero. + Current layout limits the pseudovectors to 63 PVEC_xxx subtypes, + 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */ + ptrdiff_t size; + }; -INLINE EMACS_INT -(XLI) (Lisp_Object o) +INLINE bool +(SYMBOLP) (Lisp_Object x) { - return lisp_h_XLI (o); + return lisp_h_SYMBOLP (x); +} + +INLINE struct Lisp_Symbol * +(XSYMBOL) (Lisp_Object a) +{ +#if USE_LSB_TAG + return lisp_h_XSYMBOL (a); +#else + eassert (SYMBOLP (a)); + intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol); + void *p = (char *) lispsym + i; + return p; +#endif } INLINE Lisp_Object -(XIL) (EMACS_INT i) +make_lisp_symbol (struct Lisp_Symbol *sym) { - return lisp_h_XIL (i); + Lisp_Object a = XIL (TAG_SYMOFFSET ((char *) sym - (char *) lispsym)); + eassert (XSYMBOL (a) == sym); + return a; +} + +INLINE Lisp_Object +builtin_lisp_symbol (int index) +{ + return make_lisp_symbol (lispsym + index); +} + +INLINE void +(CHECK_SYMBOL) (Lisp_Object x) +{ + lisp_h_CHECK_SYMBOL (x); } /* In the size word of a vector, this bit means the vector has been marked. */ @@ -782,6 +881,9 @@ enum pvec_type PVEC_OTHER, PVEC_XWIDGET, PVEC_XWIDGET_VIEW, + PVEC_THREAD, + PVEC_MUTEX, + PVEC_CONDVAR, /* These should be last, check internal_equal to see why. */ PVEC_COMPILED, @@ -816,11 +918,6 @@ enum More_Lisp_Bits XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ -/* Mask for the value (as opposed to the type bits) of a Lisp object. */ -DEFINE_GDB_SYMBOL_BEGIN (EMACS_INT, VALMASK) -# define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX) -DEFINE_GDB_SYMBOL_END (VALMASK) - /* Largest and smallest representable fixnum values. These are the C values. They are macros for use in static initializers. */ #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) @@ -848,24 +945,6 @@ INLINE EMACS_INT return n; } -INLINE struct Lisp_Symbol * -(XSYMBOL) (Lisp_Object a) -{ - return lisp_h_XSYMBOL (a); -} - -INLINE enum Lisp_Type -(XTYPE) (Lisp_Object a) -{ - return lisp_h_XTYPE (a); -} - -INLINE void * -(XUNTAG) (Lisp_Object a, int type) -{ - return lisp_h_XUNTAG (a, type); -} - #else /* ! USE_LSB_TAG */ /* Although compiled only if ! USE_LSB_TAG, the following functions @@ -917,32 +996,6 @@ XFASTINT (Lisp_Object a) return n; } -/* Extract A's type. */ -INLINE enum Lisp_Type -XTYPE (Lisp_Object a) -{ - EMACS_UINT i = XLI (a); - return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS; -} - -/* Extract A's value as a symbol. */ -INLINE struct Lisp_Symbol * -XSYMBOL (Lisp_Object a) -{ - eassert (SYMBOLP (a)); - intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol); - void *p = (char *) lispsym + i; - return p; -} - -/* Extract A's pointer value, assuming A's type is TYPE. */ -INLINE void * -XUNTAG (Lisp_Object a, int type) -{ - intptr_t i = USE_LSB_TAG ? XLI (a) - type : XLI (a) & VALMASK; - return (void *) i; -} - #endif /* ! USE_LSB_TAG */ /* Extract A's value as an unsigned integer. */ @@ -993,98 +1046,6 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) return num < lower ? lower : num <= upper ? num : upper; } - -/* Extract a value or address from a Lisp_Object. */ - -INLINE struct Lisp_Cons * -(XCONS) (Lisp_Object a) -{ - return lisp_h_XCONS (a); -} - -INLINE struct Lisp_Vector * -XVECTOR (Lisp_Object a) -{ - eassert (VECTORLIKEP (a)); - return XUNTAG (a, Lisp_Vectorlike); -} - -INLINE struct Lisp_String * -XSTRING (Lisp_Object a) -{ - eassert (STRINGP (a)); - return XUNTAG (a, Lisp_String); -} - -/* The index of the C-defined Lisp symbol SYM. - This can be used in a static initializer. */ -#define SYMBOL_INDEX(sym) i##sym - -INLINE struct Lisp_Float * -XFLOAT (Lisp_Object a) -{ - eassert (FLOATP (a)); - return XUNTAG (a, Lisp_Float); -} - -/* Pseudovector types. */ - -INLINE struct Lisp_Process * -XPROCESS (Lisp_Object a) -{ - eassert (PROCESSP (a)); - return XUNTAG (a, Lisp_Vectorlike); -} - -INLINE struct window * -XWINDOW (Lisp_Object a) -{ - eassert (WINDOWP (a)); - return XUNTAG (a, Lisp_Vectorlike); -} - -INLINE struct terminal * -XTERMINAL (Lisp_Object a) -{ - eassert (TERMINALP (a)); - return XUNTAG (a, Lisp_Vectorlike); -} - -INLINE struct Lisp_Subr * -XSUBR (Lisp_Object a) -{ - eassert (SUBRP (a)); - return XUNTAG (a, Lisp_Vectorlike); -} - -INLINE struct buffer * -XBUFFER (Lisp_Object a) -{ - eassert (BUFFERP (a)); - return XUNTAG (a, Lisp_Vectorlike); -} - -INLINE struct Lisp_Char_Table * -XCHAR_TABLE (Lisp_Object a) -{ - eassert (CHAR_TABLE_P (a)); - return XUNTAG (a, Lisp_Vectorlike); -} - -INLINE struct Lisp_Sub_Char_Table * -XSUB_CHAR_TABLE (Lisp_Object a) -{ - eassert (SUB_CHAR_TABLE_P (a)); - return XUNTAG (a, Lisp_Vectorlike); -} - -INLINE struct Lisp_Bool_Vector * -XBOOL_VECTOR (Lisp_Object a) -{ - eassert (BOOL_VECTOR_P (a)); - return XUNTAG (a, Lisp_Vectorlike); -} - /* Construct a Lisp_Object from a value or address. */ INLINE Lisp_Object @@ -1095,18 +1056,10 @@ make_lisp_ptr (void *ptr, enum Lisp_Type type) return a; } -INLINE Lisp_Object -make_lisp_symbol (struct Lisp_Symbol *sym) -{ - Lisp_Object a = XIL (TAG_SYMOFFSET ((char *) sym - (char *) lispsym)); - eassert (XSYMBOL (a) == sym); - return a; -} - -INLINE Lisp_Object -builtin_lisp_symbol (int index) +INLINE bool +(INTEGERP) (Lisp_Object x) { - return make_lisp_symbol (lispsym + index); + return lisp_h_INTEGERP (x); } #define XSETINT(a, b) ((a) = make_number (b)) @@ -1151,6 +1104,9 @@ builtin_lisp_symbol (int index) #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE)) #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) +#define XSETTHREAD(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_THREAD)) +#define XSETMUTEX(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_MUTEX)) +#define XSETCONDVAR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CONDVAR)) /* Efficiently convert a pointer to a Lisp object and back. The pointer is represented as a Lisp integer, so the garbage collector @@ -1171,14 +1127,6 @@ make_pointer_integer (void *p) return a; } -/* Type checking. */ - -INLINE void -(CHECK_TYPE) (int ok, Lisp_Object predicate, Lisp_Object x) -{ - lisp_h_CHECK_TYPE (ok, predicate, x); -} - /* See the macros in intervals.h. */ typedef struct interval *INTERVAL; @@ -1198,6 +1146,30 @@ struct GCALIGNED Lisp_Cons } u; }; +INLINE bool +(NILP) (Lisp_Object x) +{ + return lisp_h_NILP (x); +} + +INLINE bool +(CONSP) (Lisp_Object x) +{ + return lisp_h_CONSP (x); +} + +INLINE void +CHECK_CONS (Lisp_Object x) +{ + CHECK_TYPE (CONSP (x), Qconsp, x); +} + +INLINE struct Lisp_Cons * +(XCONS) (Lisp_Object a) +{ + return lisp_h_XCONS (a); +} + /* Take the car or cdr of something known to be a cons cell. */ /* The _addr functions shouldn't be used outside of the minimal set of code that has to know what a cons cell looks like. Other code not @@ -1249,16 +1221,20 @@ XSETCDR (Lisp_Object c, Lisp_Object n) INLINE Lisp_Object CAR (Lisp_Object c) { - return (CONSP (c) ? XCAR (c) - : NILP (c) ? Qnil - : wrong_type_argument (Qlistp, c)); + if (CONSP (c)) + return XCAR (c); + if (!NILP (c)) + wrong_type_argument (Qlistp, c); + return Qnil; } INLINE Lisp_Object CDR (Lisp_Object c) { - return (CONSP (c) ? XCDR (c) - : NILP (c) ? Qnil - : wrong_type_argument (Qlistp, c)); + if (CONSP (c)) + return XCDR (c); + if (!NILP (c)) + wrong_type_argument (Qlistp, c); + return Qnil; } /* Take the car or cdr of something whose type is not known. */ @@ -1283,6 +1259,25 @@ struct GCALIGNED Lisp_String unsigned char *data; }; +INLINE bool +STRINGP (Lisp_Object x) +{ + return XTYPE (x) == Lisp_String; +} + +INLINE void +CHECK_STRING (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (x), Qstringp, x); +} + +INLINE struct Lisp_String * +XSTRING (Lisp_Object a) +{ + eassert (STRINGP (a)); + return XUNTAG (a, Lisp_String); +} + /* True if STR is a multibyte string. */ INLINE bool STRING_MULTIBYTE (Lisp_Object str) @@ -1378,37 +1373,6 @@ STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize) XSTRING (string)->size = newsize; } -/* Header of vector-like objects. This documents the layout constraints on - vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents - compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR - 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: - - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit. - - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain - vector (0) or a pseudovector (1). - - If PSEUDOVECTOR_FLAG is 0, the rest holds the size (number - of slots) of the vector. - - If PSEUDOVECTOR_FLAG is 1, the rest is subdivided into three fields: - - a) pseudovector subtype held in PVEC_TYPE_MASK field; - - b) number of Lisp_Objects slots at the beginning of the object - held in PSEUDOVECTOR_SIZE_MASK field. These objects are always - traced by the GC; - - c) size of the rest fields held in PSEUDOVECTOR_REST_MASK and - measured in word_size units. Rest fields may also include - Lisp_Objects, but these objects usually needs some special treatment - during GC. - There are some exceptions. For PVEC_FREE, b) is always zero. For - PVEC_BOOL_VECTOR and PVEC_SUBR, both b) and c) are always zero. - Current layout limits the pseudovectors to 63 PVEC_xxx subtypes, - 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */ - ptrdiff_t size; - }; - /* A regular vector is just a header plus an array of Lisp_Objects. */ struct Lisp_Vector @@ -1417,12 +1381,61 @@ struct Lisp_Vector Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER]; }; -/* C11 prohibits alignof (struct Lisp_Vector), so compute it manually. */ -enum - { - ALIGNOF_STRUCT_LISP_VECTOR - = alignof (union { struct vectorlike_header a; Lisp_Object b; }) - }; +INLINE bool +(VECTORLIKEP) (Lisp_Object x) +{ + return lisp_h_VECTORLIKEP (x); +} + +INLINE struct Lisp_Vector * +XVECTOR (Lisp_Object a) +{ + eassert (VECTORLIKEP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + +INLINE ptrdiff_t +ASIZE (Lisp_Object array) +{ + ptrdiff_t size = XVECTOR (array)->header.size; + eassume (0 <= size); + return size; +} + +INLINE bool +VECTORP (Lisp_Object x) +{ + return VECTORLIKEP (x) && ! (ASIZE (x) & PSEUDOVECTOR_FLAG); +} + +INLINE void +CHECK_VECTOR (Lisp_Object x) +{ + CHECK_TYPE (VECTORP (x), Qvectorp, x); +} + +/* A pseudovector is like a vector, but has other non-Lisp components. */ + +INLINE bool +PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, int code) +{ + return ((a->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) + == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))); +} + +/* True if A is a pseudovector whose code is CODE. */ +INLINE bool +PSEUDOVECTORP (Lisp_Object a, int code) +{ + if (! VECTORLIKEP (a)) + return false; + else + { + /* Converting to struct vectorlike_header * avoids aliasing issues. */ + struct vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike); + return PSEUDOVECTOR_TYPEP (h, code); + } +} /* A boolvector is a kind of vectorlike, with contents like a string. */ @@ -1440,6 +1453,51 @@ struct Lisp_Bool_Vector bits_word data[FLEXIBLE_ARRAY_MEMBER]; }; +/* Some handy constants for calculating sizes + and offsets, mostly of vectorlike objects. */ + +enum + { + header_size = offsetof (struct Lisp_Vector, contents), + bool_header_size = offsetof (struct Lisp_Bool_Vector, data), + word_size = sizeof (Lisp_Object) + }; + +/* 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; +} + +INLINE bool +BOOL_VECTOR_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_BOOL_VECTOR); +} + +INLINE void +CHECK_BOOL_VECTOR (Lisp_Object x) +{ + CHECK_TYPE (BOOL_VECTOR_P (x), Qbool_vector_p, x); +} + +INLINE struct Lisp_Bool_Vector * +XBOOL_VECTOR (Lisp_Object a) +{ + eassert (BOOL_VECTOR_P (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + INLINE EMACS_INT bool_vector_size (Lisp_Object a) { @@ -1460,22 +1518,6 @@ 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 @@ -1508,16 +1550,6 @@ bool_vector_set (Lisp_Object a, EMACS_INT i, bool b) *addr &= ~ (1 << (i % BOOL_VECTOR_BITS_PER_CHAR)); } -/* Some handy constants for calculating sizes - and offsets, mostly of vectorlike objects. */ - -enum - { - header_size = offsetof (struct Lisp_Vector, contents), - bool_header_size = offsetof (struct Lisp_Bool_Vector, data), - word_size = sizeof (Lisp_Object) - }; - /* Conveniences for dealing with Lisp arrays. */ INLINE Lisp_Object @@ -1533,14 +1565,6 @@ aref_addr (Lisp_Object array, ptrdiff_t idx) } INLINE ptrdiff_t -ASIZE (Lisp_Object array) -{ - ptrdiff_t size = XVECTOR (array)->header.size; - eassume (0 <= size); - return size; -} - -INLINE ptrdiff_t gc_asize (Lisp_Object array) { /* Like ASIZE, but also can be used in the garbage collector. */ @@ -1657,6 +1681,19 @@ struct Lisp_Char_Table Lisp_Object extras[FLEXIBLE_ARRAY_MEMBER]; }; +INLINE bool +CHAR_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_CHAR_TABLE); +} + +INLINE struct Lisp_Char_Table * +XCHAR_TABLE (Lisp_Object a) +{ + eassert (CHAR_TABLE_P (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + struct Lisp_Sub_Char_Table { /* HEADER.SIZE is the vector's size field, which also holds the @@ -1678,6 +1715,19 @@ struct Lisp_Sub_Char_Table Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER]; }; +INLINE bool +SUB_CHAR_TABLE_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_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); +} + INLINE Lisp_Object CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t idx) { @@ -1740,9 +1790,22 @@ struct Lisp_Subr short min_args, max_args; const char *symbol_name; const char *intspec; - const char *doc; + EMACS_INT doc; }; +INLINE bool +SUBRP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_SUBR); +} + +INLINE struct Lisp_Subr * +XSUBR (Lisp_Object a) +{ + eassert (SUBRP (a)); + return XUNTAG (a, Lisp_Vectorlike); +} + enum char_table_specials { /* This is the number of slots that every char table must have. This @@ -1769,6 +1832,8 @@ verify (offsetof (struct Lisp_Sub_Char_Table, contents) == (offsetof (struct Lisp_Vector, contents) + SUB_CHAR_TABLE_OFFSET * sizeof (Lisp_Object))); +#include "thread.h" + /*********************************************************************** Symbols ***********************************************************************/ @@ -1784,19 +1849,19 @@ INLINE Lisp_Object INLINE struct Lisp_Symbol * SYMBOL_ALIAS (struct Lisp_Symbol *sym) { - eassert (sym->redirect == SYMBOL_VARALIAS); + eassume (sym->redirect == SYMBOL_VARALIAS && sym->val.alias); return sym->val.alias; } INLINE struct Lisp_Buffer_Local_Value * SYMBOL_BLV (struct Lisp_Symbol *sym) { - eassert (sym->redirect == SYMBOL_LOCALIZED); + eassume (sym->redirect == SYMBOL_LOCALIZED && sym->val.blv); return sym->val.blv; } INLINE union Lisp_Fwd * SYMBOL_FWD (struct Lisp_Symbol *sym) { - eassert (sym->redirect == SYMBOL_FORWARDED); + eassume (sym->redirect == SYMBOL_FORWARDED && sym->val.fwd); return sym->val.fwd; } @@ -1809,19 +1874,19 @@ INLINE void INLINE void SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v) { - eassert (sym->redirect == SYMBOL_VARALIAS); + eassume (sym->redirect == SYMBOL_VARALIAS && v); sym->val.alias = v; } INLINE void SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v) { - eassert (sym->redirect == SYMBOL_LOCALIZED); + eassume (sym->redirect == SYMBOL_LOCALIZED && v); sym->val.blv = v; } INLINE void SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v) { - eassert (sym->redirect == SYMBOL_FORWARDED); + eassume (sym->redirect == SYMBOL_FORWARDED && v); sym->val.fwd = v; } @@ -1847,9 +1912,20 @@ SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym) return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY; } -/* Value is non-zero if symbol is considered a constant, i.e. its - value cannot be changed (there is an exception for keyword symbols, - whose value can be set to the keyword symbol itself). */ +/* Value is non-zero if symbol cannot be changed through a simple set, + i.e. it's a constant (e.g. nil, t, :keywords), or it has some + watching functions. */ + +INLINE int +(SYMBOL_TRAPPED_WRITE_P) (Lisp_Object sym) +{ + return lisp_h_SYMBOL_TRAPPED_WRITE_P (sym); +} + +/* Value is non-zero if symbol cannot be changed at all, i.e. it's a + constant (e.g. nil, t, :keywords). Code that actually wants to + write to SYM, should also check whether there are any watching + functions. */ INLINE int (SYMBOL_CONSTANT_P) (Lisp_Object sym) @@ -2022,7 +2098,7 @@ static double const DEFAULT_REHASH_SIZE = 1.5; INLINE EMACS_UINT sxhash_combine (EMACS_UINT x, EMACS_UINT y) { - return (x << 4) + (x >> (BITS_PER_EMACS_INT - 4)) + y; + return (x << 4) + (x >> (EMACS_INT_WIDTH - 4)) + y; } /* Hash X, returning a value that fits into a fixnum. */ @@ -2030,7 +2106,7 @@ sxhash_combine (EMACS_UINT x, EMACS_UINT y) INLINE EMACS_UINT SXHASH_REDUCE (EMACS_UINT x) { - return (x ^ x >> (BITS_PER_EMACS_INT - FIXNUM_BITS)) & INTMASK; + return (x ^ x >> (EMACS_INT_WIDTH - FIXNUM_BITS)) & INTMASK; } /* These structures are used for various misc types. */ @@ -2042,6 +2118,25 @@ struct Lisp_Misc_Any /* Supertype of all Misc types. */ unsigned spacer : 15; }; +INLINE bool +(MISCP) (Lisp_Object x) +{ + return lisp_h_MISCP (x); +} + +INLINE struct Lisp_Misc_Any * +XMISCANY (Lisp_Object a) +{ + eassert (MISCP (a)); + return XUNTAG (a, Lisp_Misc); +} + +INLINE enum Lisp_Misc_Type +XMISCTYPE (Lisp_Object a) +{ + return XMISCANY (a)->type; +} + struct Lisp_Marker { ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_Marker */ @@ -2107,18 +2202,8 @@ struct Lisp_Overlay Lisp_Object plist; }; -/* Types of data which may be saved in a Lisp_Save_Value. */ - -enum - { - SAVE_UNUSED, - SAVE_INTEGER, - SAVE_FUNCPOINTER, - SAVE_POINTER, - SAVE_OBJECT - }; - -/* Number of bits needed to store one of the above values. */ +/* Number of bits needed to store one of the values + SAVE_UNUSED..SAVE_OBJECT. */ enum { SAVE_SLOT_BITS = 3 }; /* Number of slots in a save value where save_type is nonzero. */ @@ -2128,8 +2213,15 @@ enum { SAVE_VALUE_SLOTS = 4 }; enum { SAVE_TYPE_BITS = SAVE_VALUE_SLOTS * SAVE_SLOT_BITS + 1 }; +/* Types of data which may be saved in a Lisp_Save_Value. */ + enum Lisp_Save_Type { + SAVE_UNUSED, + SAVE_INTEGER, + SAVE_FUNCPOINTER, + SAVE_POINTER, + SAVE_OBJECT, SAVE_TYPE_INT_INT = SAVE_INTEGER + (SAVE_INTEGER << SAVE_SLOT_BITS), SAVE_TYPE_INT_INT_INT = (SAVE_INTEGER + (SAVE_TYPE_INT_INT << SAVE_SLOT_BITS)), @@ -2147,6 +2239,12 @@ enum Lisp_Save_Type SAVE_TYPE_MEMORY = SAVE_TYPE_PTR_INT + (1 << (SAVE_TYPE_BITS - 1)) }; +/* SAVE_SLOT_BITS must be large enough to represent these values. */ +verify (((SAVE_UNUSED | SAVE_INTEGER | SAVE_FUNCPOINTER + | SAVE_POINTER | SAVE_OBJECT) + >> SAVE_SLOT_BITS) + == 0); + /* Special object used to hold a different values for later use. This is mostly used to package C integers and pointers to call @@ -2196,6 +2294,19 @@ struct Lisp_Save_Value } data[SAVE_VALUE_SLOTS]; }; +INLINE bool +SAVE_VALUEP (Lisp_Object x) +{ + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; +} + +INLINE struct Lisp_Save_Value * +XSAVE_VALUE (Lisp_Object a) +{ + eassert (SAVE_VALUEP (a)); + return XUNTAG (a, Lisp_Misc); +} + /* Return the type of V's Nth saved value. */ INLINE int save_type (struct Lisp_Save_Value *v, int n) @@ -2276,6 +2387,19 @@ struct Lisp_Finalizer Lisp_Object function; }; +INLINE bool +FINALIZERP (Lisp_Object x) +{ + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Finalizer; +} + +INLINE struct Lisp_Finalizer * +XFINALIZER (Lisp_Object a) +{ + eassert (FINALIZERP (a)); + return XUNTAG (a, Lisp_Misc); +} + /* A miscellaneous object, when it's on the free list. */ struct Lisp_Free { @@ -2307,53 +2431,44 @@ XMISC (Lisp_Object a) return XUNTAG (a, Lisp_Misc); } -INLINE struct Lisp_Misc_Any * -XMISCANY (Lisp_Object a) -{ - eassert (MISCP (a)); - return & XMISC (a)->u_any; -} - -INLINE enum Lisp_Misc_Type -XMISCTYPE (Lisp_Object a) +INLINE bool +(MARKERP) (Lisp_Object x) { - return XMISCANY (a)->type; + return lisp_h_MARKERP (x); } INLINE struct Lisp_Marker * XMARKER (Lisp_Object a) { eassert (MARKERP (a)); - return & XMISC (a)->u_marker; + return XUNTAG (a, Lisp_Misc); } -INLINE struct Lisp_Overlay * -XOVERLAY (Lisp_Object a) +INLINE bool +OVERLAYP (Lisp_Object x) { - eassert (OVERLAYP (a)); - return & XMISC (a)->u_overlay; + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay; } -INLINE struct Lisp_Save_Value * -XSAVE_VALUE (Lisp_Object a) +INLINE struct Lisp_Overlay * +XOVERLAY (Lisp_Object a) { - eassert (SAVE_VALUEP (a)); - return & XMISC (a)->u_save_value; + eassert (OVERLAYP (a)); + return XUNTAG (a, Lisp_Misc); } -INLINE struct Lisp_Finalizer * -XFINALIZER (Lisp_Object a) +#ifdef HAVE_MODULES +INLINE bool +USER_PTRP (Lisp_Object x) { - eassert (FINALIZERP (a)); - return & XMISC (a)->u_finalizer; + return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_User_Ptr; } -#ifdef HAVE_MODULES INLINE struct Lisp_User_Ptr * XUSER_PTR (Lisp_Object a) { eassert (USER_PTRP (a)); - return & XMISC (a)->u_user_ptr; + return XUNTAG (a, Lisp_Misc); } #endif @@ -2399,7 +2514,7 @@ struct Lisp_Buffer_Objfwd }; /* struct Lisp_Buffer_Local_Value is used in a symbol value cell when - the symbol has buffer-local or frame-local bindings. (Exception: + the symbol has buffer-local bindings. (Exception: some buffer-local variables are built-in, with their values stored in the buffer structure itself. They are handled differently, using struct Lisp_Buffer_Objfwd.) @@ -2427,9 +2542,6 @@ struct Lisp_Buffer_Local_Value /* True means that merely setting the variable creates a local binding for the current buffer. */ 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. */ - bool_bf frame_local : 1; /* True means that the binding now loaded was found. Presumably equivalent to (defcell!=valcell). */ bool_bf found : 1; @@ -2471,6 +2583,12 @@ XFWDTYPE (union Lisp_Fwd *a) return a->u_intfwd.type; } +INLINE bool +BUFFER_OBJFWDP (union Lisp_Fwd *a) +{ + return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj; +} + INLINE struct Lisp_Buffer_Objfwd * XBUFFER_OBJFWD (union Lisp_Fwd *a) { @@ -2488,6 +2606,19 @@ struct Lisp_Float } u; }; +INLINE bool +(FLOATP) (Lisp_Object x) +{ + return lisp_h_FLOATP (x); +} + +INLINE struct Lisp_Float * +XFLOAT (Lisp_Object a) +{ + eassert (FLOATP (a)); + return XUNTAG (a, Lisp_Float); +} + INLINE double XFLOAT_DATA (Lisp_Object f) { @@ -2551,12 +2682,6 @@ enum char_bits /* Data type checking. */ INLINE bool -(NILP) (Lisp_Object x) -{ - return lisp_h_NILP (x); -} - -INLINE bool NUMBERP (Lisp_Object x) { return INTEGERP (x) || FLOATP (x); @@ -2579,109 +2704,11 @@ RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intmax_t hi) && XINT (x) <= TYPE_MAXIMUM (type)) INLINE bool -(CONSP) (Lisp_Object x) -{ - return lisp_h_CONSP (x); -} -INLINE bool -(FLOATP) (Lisp_Object x) -{ - return lisp_h_FLOATP (x); -} -INLINE bool -(MISCP) (Lisp_Object x) -{ - return lisp_h_MISCP (x); -} -INLINE bool -(SYMBOLP) (Lisp_Object x) -{ - return lisp_h_SYMBOLP (x); -} -INLINE bool -(INTEGERP) (Lisp_Object x) -{ - return lisp_h_INTEGERP (x); -} -INLINE bool -(VECTORLIKEP) (Lisp_Object x) -{ - return lisp_h_VECTORLIKEP (x); -} -INLINE bool -(MARKERP) (Lisp_Object x) -{ - return lisp_h_MARKERP (x); -} - -INLINE bool -STRINGP (Lisp_Object x) -{ - return XTYPE (x) == Lisp_String; -} -INLINE bool -VECTORP (Lisp_Object x) -{ - return VECTORLIKEP (x) && ! (ASIZE (x) & PSEUDOVECTOR_FLAG); -} -INLINE bool -OVERLAYP (Lisp_Object x) -{ - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay; -} -INLINE bool -SAVE_VALUEP (Lisp_Object x) -{ - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value; -} - -INLINE bool -FINALIZERP (Lisp_Object x) -{ - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Finalizer; -} - -#ifdef HAVE_MODULES -INLINE bool -USER_PTRP (Lisp_Object x) -{ - return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_User_Ptr; -} -#endif - -INLINE bool AUTOLOADP (Lisp_Object x) { return CONSP (x) && EQ (Qautoload, XCAR (x)); } -INLINE bool -BUFFER_OBJFWDP (union Lisp_Fwd *a) -{ - return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj; -} - -INLINE bool -PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, int code) -{ - return ((a->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) - == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))); -} - -/* True if A is a pseudovector whose code is CODE. */ -INLINE bool -PSEUDOVECTORP (Lisp_Object a, int code) -{ - if (! VECTORLIKEP (a)) - return false; - else - { - /* Converting to struct vectorlike_header * avoids aliasing issues. */ - struct vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike); - return PSEUDOVECTOR_TYPEP (h, code); - } -} - /* Test for specific pseudovector types. */ @@ -2692,60 +2719,12 @@ WINDOW_CONFIGURATIONP (Lisp_Object a) } INLINE bool -PROCESSP (Lisp_Object a) -{ - return PSEUDOVECTORP (a, PVEC_PROCESS); -} - -INLINE bool -WINDOWP (Lisp_Object a) -{ - return PSEUDOVECTORP (a, PVEC_WINDOW); -} - -INLINE bool -TERMINALP (Lisp_Object a) -{ - return PSEUDOVECTORP (a, PVEC_TERMINAL); -} - -INLINE bool -SUBRP (Lisp_Object a) -{ - return PSEUDOVECTORP (a, PVEC_SUBR); -} - -INLINE bool COMPILEDP (Lisp_Object a) { return PSEUDOVECTORP (a, PVEC_COMPILED); } INLINE bool -BUFFERP (Lisp_Object a) -{ - return PSEUDOVECTORP (a, PVEC_BUFFER); -} - -INLINE bool -CHAR_TABLE_P (Lisp_Object a) -{ - return PSEUDOVECTORP (a, PVEC_CHAR_TABLE); -} - -INLINE bool -SUB_CHAR_TABLE_P (Lisp_Object a) -{ - return PSEUDOVECTORP (a, PVEC_SUB_CHAR_TABLE); -} - -INLINE bool -BOOL_VECTOR_P (Lisp_Object a) -{ - return PSEUDOVECTORP (a, PVEC_BOOL_VECTOR); -} - -INLINE bool FRAMEP (Lisp_Object a) { return PSEUDOVECTORP (a, PVEC_FRAME); @@ -2778,42 +2757,16 @@ INLINE void } INLINE void -(CHECK_SYMBOL) (Lisp_Object x) -{ - lisp_h_CHECK_SYMBOL (x); -} - -INLINE void (CHECK_NUMBER) (Lisp_Object x) { lisp_h_CHECK_NUMBER (x); } INLINE void -CHECK_STRING (Lisp_Object x) -{ - CHECK_TYPE (STRINGP (x), Qstringp, x); -} -INLINE void CHECK_STRING_CAR (Lisp_Object x) { CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)); } -INLINE void -CHECK_CONS (Lisp_Object x) -{ - CHECK_TYPE (CONSP (x), Qconsp, x); -} -INLINE void -CHECK_VECTOR (Lisp_Object x) -{ - CHECK_TYPE (VECTORP (x), Qvectorp, x); -} -INLINE void -CHECK_BOOL_VECTOR (Lisp_Object x) -{ - CHECK_TYPE (BOOL_VECTOR_P (x), Qbool_vector_p, x); -} /* This is a bit special because we always need size afterwards. */ INLINE ptrdiff_t CHECK_VECTOR_OR_STRING (Lisp_Object x) @@ -2830,23 +2783,6 @@ CHECK_ARRAY (Lisp_Object x, Lisp_Object predicate) CHECK_TYPE (ARRAYP (x), predicate, x); } INLINE void -CHECK_BUFFER (Lisp_Object x) -{ - CHECK_TYPE (BUFFERP (x), Qbufferp, x); -} -INLINE void -CHECK_WINDOW (Lisp_Object x) -{ - CHECK_TYPE (WINDOWP (x), Qwindowp, x); -} -#ifdef subprocesses -INLINE void -CHECK_PROCESS (Lisp_Object x) -{ - CHECK_TYPE (PROCESSP (x), Qprocessp, x); -} -#endif -INLINE void CHECK_NATNUM (Lisp_Object x) { CHECK_TYPE (NATNUMP (x), Qwholenump, x); @@ -2962,13 +2898,6 @@ CHECK_NUMBER_CDR (Lisp_Object x) Lisp_Object fnname #endif -/* True if OBJ is a Lisp function. */ -INLINE bool -FUNCTIONP (Lisp_Object obj) -{ - return functionp (obj); -} - /* defsubr (Sname); is how we define the symbol for function `name' at start-up time. */ extern void defsubr (struct Lisp_Subr *); @@ -3032,12 +2961,6 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int); defvar_int (&i_fwd, lname, &globals.f_ ## vname); \ } 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 (false) - #define DEFVAR_KBOARD(lname, vname, doc) \ do { \ static struct Lisp_Kboard_Objfwd ko_fwd; \ @@ -3123,6 +3046,9 @@ union specbinding ENUM_BF (specbind_tag) kind : CHAR_BIT; /* `where' is not used in the case of SPECPDL_LET. */ Lisp_Object symbol, old_value, where; + /* Normally this is unused; but it is set to the symbol's + current value when a thread is swapped out. */ + Lisp_Object saved_value; } let; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; @@ -3133,9 +3059,10 @@ union specbinding } bt; }; -extern union specbinding *specpdl; -extern union specbinding *specpdl_ptr; -extern ptrdiff_t specpdl_size; +/* These 3 are defined as macros in thread.h. */ +/* extern union specbinding *specpdl; */ +/* extern union specbinding *specpdl_ptr; */ +/* extern ptrdiff_t specpdl_size; */ INLINE ptrdiff_t SPECPDL_INDEX (void) @@ -3186,19 +3113,14 @@ struct handler /* Most global vars are reset to their value via the specpdl mechanism, but a few others are handled by storing their value here. */ sys_jmp_buf jmp; - EMACS_INT lisp_eval_depth; + EMACS_INT f_lisp_eval_depth; ptrdiff_t pdlcount; int poll_suppress_count; int interrupt_input_blocked; - struct byte_stack *byte_stack; }; extern Lisp_Object memory_signal_data; -/* An address near the bottom of the stack. - Tells GC how to save a copy of the stack. */ -extern char *stack_bottom; - /* Check quit-flag and quit if it is non-nil. Typing C-g does not directly cause a quit; it only sets Vquit_flag. So the program needs to do QUIT at times when it is safe to quit. @@ -3287,7 +3209,13 @@ set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next) XSYMBOL (sym)->next = next; } -/* Buffer-local (also frame-local) variable access functions. */ +INLINE void +make_symbol_constant (Lisp_Object sym) +{ + XSYMBOL (sym)->trapped_write = SYMBOL_NOWRITE; +} + +/* Buffer-local variable access functions. */ INLINE int blv_found (struct Lisp_Buffer_Local_Value *blv) @@ -3357,6 +3285,9 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) } /* Defined in data.c. */ +extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object); +extern void notify_variable_watchers (Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object); extern Lisp_Object indirect_function (Lisp_Object); extern Lisp_Object find_symbol_value (Lisp_Object); enum Arith_Comparison { @@ -3395,7 +3326,17 @@ extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object); extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); -extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool); +enum Set_Internal_Bind { + SET_INTERNAL_SET, + SET_INTERNAL_BIND, + SET_INTERNAL_UNBIND, + SET_INTERNAL_THREAD_SWITCH +}; +extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, + enum Set_Internal_Bind); +extern void set_default_internal (Lisp_Object, Lisp_Object, + enum Set_Internal_Bind bindflag); + extern void syms_of_data (void); extern void swap_in_global_binding (struct Lisp_Symbol *); @@ -3439,7 +3380,7 @@ ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, EMACS_UINT); void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object); -extern struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal; +extern struct hash_table_test const hashtest_eq, hashtest_eql, hashtest_equal; extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t *, ptrdiff_t *); extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t, @@ -3503,7 +3444,7 @@ extern void insert_from_string_before_markers (Lisp_Object, ptrdiff_t, ptrdiff_t, bool); extern void del_range (ptrdiff_t, ptrdiff_t); extern Lisp_Object del_range_1 (ptrdiff_t, ptrdiff_t, bool, bool); -extern void del_range_byte (ptrdiff_t, ptrdiff_t, bool); +extern void del_range_byte (ptrdiff_t, ptrdiff_t); 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); @@ -3516,6 +3457,8 @@ extern void adjust_after_insert (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t); extern void adjust_markers_for_delete (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t); +extern void adjust_markers_bytepos (ptrdiff_t, ptrdiff_t, + ptrdiff_t, ptrdiff_t, int); extern void replace_range (ptrdiff_t, ptrdiff_t, Lisp_Object, bool, bool, bool, bool); extern void replace_range_2 (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, const char *, ptrdiff_t, ptrdiff_t, bool); @@ -3584,16 +3527,12 @@ extern void mark_object (Lisp_Object); #if defined REL_ALLOC && !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC extern void refill_memory_reserve (void); #endif -#ifdef DOUG_LEA_MALLOC extern void alloc_unexec_pre (void); extern void alloc_unexec_post (void); -#else -INLINE void alloc_unexec_pre (void) {} -INLINE void alloc_unexec_post (void) {} -#endif +extern void mark_stack (char *, char *); +extern void flush_stack_call_func (void (*func) (void *arg), void *arg); extern const char *pending_malloc_warning; extern Lisp_Object zero_vector; -extern Lisp_Object *stack_base; extern EMACS_INT consing_since_gc; extern EMACS_INT gc_relative_threshold; extern EMACS_INT memory_full_cons_threshold; @@ -3728,7 +3667,6 @@ extern struct Lisp_Vector *allocate_pseudovector (int, int, int, VECSIZE (type), tag)) extern bool gc_in_progress; -extern bool abort_on_gc; extern Lisp_Object make_float (double); extern void display_malloc_warning (void); extern ptrdiff_t inhibit_garbage_collection (void); @@ -3756,6 +3694,15 @@ extern void check_cons_list (void); INLINE void (check_cons_list) (void) { lisp_h_check_cons_list (); } #endif +/* Defined in gmalloc.c. */ +#if !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC && !defined SYSTEM_MALLOC +extern size_t __malloc_extra_blocks; +#endif +#if !HAVE_DECL_ALIGNED_ALLOC +extern void *aligned_alloc (size_t, size_t) ATTRIBUTE_MALLOC_SIZE ((2)); +#endif +extern void malloc_enable_thread (void); + #ifdef REL_ALLOC /* Defined in ralloc.c. */ extern void *r_alloc (void **, size_t) ATTRIBUTE_ALLOC_SIZE ((2)); @@ -3847,7 +3794,6 @@ extern Lisp_Object Vautoload_queue; extern Lisp_Object Vrun_hooks; extern Lisp_Object Vsignaling_function; extern Lisp_Object inhibit_lisp_code; -extern struct handler *handlerlist; /* To run a normal hook, use the appropriate function from the list below. The calling convention: @@ -3861,13 +3807,20 @@ extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args, Lisp_Object (*funcall) (ptrdiff_t nargs, Lisp_Object *args)); -extern _Noreturn void xsignal (Lisp_Object, Lisp_Object); +extern Lisp_Object quit (void); +INLINE _Noreturn void +xsignal (Lisp_Object error_symbol, Lisp_Object data) +{ + Fsignal (error_symbol, data); +} extern _Noreturn void xsignal0 (Lisp_Object); extern _Noreturn void xsignal1 (Lisp_Object, Lisp_Object); extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object); extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern _Noreturn void signal_error (const char *, Lisp_Object); +extern bool FUNCTIONP (Lisp_Object); +extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector); extern Lisp_Object eval_sub (Lisp_Object form); extern Lisp_Object apply1 (Lisp_Object, Lisp_Object); extern Lisp_Object call0 (Lisp_Object); @@ -3898,9 +3851,13 @@ 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 void rebind_for_thread_switch (void); +extern void unbind_for_thread_switch (struct thread_state *); 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 vformat_string (const char *, va_list) + ATTRIBUTE_FORMAT_PRINTF (1, 0); extern void un_autoload (Lisp_Object); extern Lisp_Object call_debugger (Lisp_Object arg); extern void *near_C_stack_top (void); @@ -3910,9 +3867,9 @@ extern Lisp_Object safe_call1 (Lisp_Object, 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 prog_ignore (Lisp_Object); extern ptrdiff_t record_in_backtrace (Lisp_Object, Lisp_Object *, ptrdiff_t); -extern void mark_specpdl (void); +extern void mark_specpdl (union specbinding *first, union specbinding *ptr); extern void get_backtrace (Lisp_Object array); Lisp_Object backtrace_top_function (void); extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); @@ -3923,10 +3880,12 @@ extern bool let_shadows_global_binding_p (Lisp_Object symbol); extern Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p); /* Defined in emacs-module.c. */ -extern void module_init (void); extern void syms_of_module (void); #endif +/* Defined in thread.c. */ +extern void mark_threads (void); + /* Defined in editfns.c. */ extern void insert1 (Lisp_Object); extern Lisp_Object save_excursion_save (void); @@ -4119,6 +4078,7 @@ INLINE void fixup_locale (void) {} INLINE void synchronize_system_messages_locale (void) {} INLINE void synchronize_system_time_locale (void) {} #endif +extern char *emacs_strerror (int); extern void shut_down_emacs (int, Lisp_Object); /* True means don't do interactive redisplay and don't change tty modes. */ @@ -4127,12 +4087,14 @@ extern bool noninteractive; /* True means remove site-lisp directories from load-path. */ extern bool no_site_lisp; -/* Pipe used to send exit notification to the daemon parent at - startup. On Windows, we use a kernel event instead. */ +/* True means put details like time stamps into builds. */ +extern bool build_details; + #ifndef WINDOWSNT -extern int daemon_pipe[2]; -#define IS_DAEMON (daemon_pipe[1] != 0) -#define DAEMON_RUNNING (daemon_pipe[1] >= 0) +/* 0 not a daemon, 1 new-style (foreground), 2 old-style (background). */ +extern int daemon_type; +#define IS_DAEMON (daemon_type != 0) +#define DAEMON_RUNNING (daemon_type >= 0) #else /* WINDOWSNT */ extern void *w32_daemon_event; #define IS_DAEMON (w32_daemon_event != NULL) @@ -4148,12 +4110,13 @@ extern bool inhibit_window_system; extern bool running_asynch_code; /* Defined in process.c. */ +struct Lisp_Process; extern void kill_buffer_processes (Lisp_Object); extern int wait_reading_process_output (intmax_t, int, int, bool, Lisp_Object, struct Lisp_Process *, int); /* Max value for the first argument of wait_reading_process_output. */ -#if __GNUC__ == 3 || (__GNUC__ == 4 && __GNUC_MINOR__ <= 5) -/* Work around a bug in GCC 3.4.2, known to be fixed in GCC 4.6.3. +#if GNUC_PREREQ (3, 0, 0) && ! GNUC_PREREQ (4, 6, 0) +/* Work around a bug in GCC 3.4.2, known to be fixed in GCC 4.6.0. The bug merely causes a bogus warning, but the warning is annoying. */ # define WAIT_READING_MAX min (TYPE_MAXIMUM (time_t), INTMAX_MAX) #else @@ -4168,15 +4131,17 @@ extern void delete_keyboard_wait_descriptor (int); extern void add_gpm_wait_descriptor (int); extern void delete_gpm_wait_descriptor (int); #endif -extern void init_process_emacs (void); +extern void init_process_emacs (int); extern void syms_of_process (void); extern void setup_process_coding_systems (Lisp_Object); /* Defined in callproc.c. */ #ifndef DOS_NT - _Noreturn +# define CHILD_SETUP_TYPE _Noreturn void +#else +# define CHILD_SETUP_TYPE int #endif -extern int child_setup (int, int, int, char **, bool, Lisp_Object); +extern CHILD_SETUP_TYPE child_setup (int, int, int, char **, bool, Lisp_Object); extern void init_callproc_1 (void); extern void init_callproc (void); extern void set_initial_environment (void); @@ -4202,10 +4167,9 @@ extern int read_bytecode_char (bool); /* Defined in bytecode.c. */ extern void syms_of_bytecode (void); -extern struct byte_stack *byte_stack_list; -extern void relocate_byte_stack (void); extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, ptrdiff_t, Lisp_Object *); +extern Lisp_Object get_byte_code_arity (Lisp_Object); /* Defined in macros.c. */ extern void init_macros (void); @@ -4234,13 +4198,15 @@ extern void syms_of_xmenu (void); /* Defined in termchar.h. */ struct tty_display_info; -/* Defined in termhooks.h. */ -struct terminal; - /* Defined in sysdep.c. */ -#ifndef HAVE_GET_CURRENT_DIR_NAME -extern char *get_current_dir_name (void); +#ifdef HAVE_PERSONALITY_ADDR_NO_RANDOMIZE +extern bool disable_address_randomization (void); +#else +INLINE bool disable_address_randomization (void) { return false; } #endif +extern int emacs_exec_file (char const *, char *const *, char *const *); +extern void init_standard_fds (void); +extern char *emacs_get_current_dir_name (void); extern void stuff_char (char c); extern void init_foreground_group (void); extern void sys_subshell (void); @@ -4495,12 +4461,14 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); } \ } while (false) -/* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects. */ +/* Set BUF to point to an allocated array of NELT Lisp_Objects, + immediately followed by EXTRA spare bytes. */ -#define SAFE_ALLOCA_LISP(buf, nelt) \ +#define SAFE_ALLOCA_LISP_EXTRA(buf, nelt, extra) \ do { \ ptrdiff_t alloca_nbytes; \ if (INT_MULTIPLY_WRAPV (nelt, word_size, &alloca_nbytes) \ + || INT_ADD_WRAPV (alloca_nbytes, extra, &alloca_nbytes) \ || SIZE_MAX < alloca_nbytes) \ memory_full (SIZE_MAX); \ else if (alloca_nbytes <= sa_avail) \ @@ -4515,6 +4483,10 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); } \ } while (false) +/* Set BUF to point to an allocated array of NELT Lisp_Objects. */ + +#define SAFE_ALLOCA_LISP(buf, nelt) SAFE_ALLOCA_LISP_EXTRA (buf, nelt, 0) + /* If USE_STACK_LISP_OBJECTS, define macros that and functions that allocate block-scoped conses and strings. These objects are not @@ -4526,8 +4498,7 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); Build with CPPFLAGS='-DUSE_STACK_LISP_OBJECTS=0' to disable it. */ #if (!defined USE_STACK_LISP_OBJECTS \ - && defined __GNUC__ && !defined __clang__ \ - && !(4 < __GNUC__ + (3 < __GNUC_MINOR__ + (2 <= __GNUC_PATCHLEVEL__)))) + && defined __GNUC__ && !defined __clang__ && ! GNUC_PREREQ (4, 3, 2)) /* Work around GCC bugs 36584 and 35271, which were fixed in GCC 4.3.2. */ # define USE_STACK_LISP_OBJECTS false #endif @@ -4600,27 +4571,29 @@ enum STACK_CONS (d, Qnil)))) \ : list4 (a, b, c, d)) -/* Check whether stack-allocated strings are ASCII-only. */ +/* Declare NAME as an auto Lisp string if possible, a GC-based one if not. + Take its unibyte value from the null-terminated string STR, + an expression that should not have side effects. + STR's value is not necessarily copied. The resulting Lisp string + should not be modified or made visible to user code. */ -#if defined (ENABLE_CHECKING) && USE_STACK_LISP_OBJECTS -extern const char *verify_ascii (const char *); -#else -# define verify_ascii(str) (str) -#endif +#define AUTO_STRING(name, str) \ + AUTO_STRING_WITH_LEN (name, str, strlen (str)) /* Declare NAME as an auto Lisp string if possible, a GC-based one if not. - Take its value from STR. STR is not necessarily copied and should - contain only ASCII characters. The resulting Lisp string should - not be modified or made visible to user code. */ + Take its unibyte value from the null-terminated string STR with length LEN. + STR may have side effects and may contain null bytes. + STR's value is not necessarily copied. The resulting Lisp string + should not be modified or made visible to user code. */ -#define AUTO_STRING(name, str) \ +#define AUTO_STRING_WITH_LEN(name, str, len) \ Lisp_Object name = \ (USE_STACK_STRING \ ? (make_lisp_ptr \ ((&(union Aligned_String) \ - {{strlen (str), -1, 0, (unsigned char *) verify_ascii (str)}}.s), \ - Lisp_String)) \ - : build_string (verify_ascii (str))) + {{len, -1, 0, (unsigned char *) (str)}}.s), \ + Lisp_String)) \ + : make_unibyte_string (str, len)) /* Loop over all tails of a list, checking for cycles. FIXME: Make tortoise and n internal declarations. @@ -4656,38 +4629,6 @@ maybe_gc (void) Fgarbage_collect (); } -INLINE bool -functionp (Lisp_Object object) -{ - if (SYMBOLP (object) && !NILP (Ffboundp (object))) - { - object = Findirect_function (object, Qt); - - if (CONSP (object) && EQ (XCAR (object), Qautoload)) - { - /* Autoloaded symbols are functions, except if they load - macros or keymaps. */ - int i; - for (i = 0; i < 4 && CONSP (object); i++) - object = XCDR (object); - - return ! (CONSP (object) && !NILP (XCAR (object))); - } - } - - if (SUBRP (object)) - return XSUBR (object)->max_args != UNEVALLED; - else if (COMPILEDP (object)) - return true; - else if (CONSP (object)) - { - Lisp_Object car = XCAR (object); - return EQ (car, Qlambda) || EQ (car, Qclosure); - } - else - return false; -} - INLINE_HEADER_END #endif /* EMACS_LISP_H */ |