/* Fundamental definitions for GNU Emacs Lisp interpreter.
-Copyright (C) 1985-1987, 1993-1995, 1997-2014 Free Software Foundation,
+Copyright (C) 1985-1987, 1993-1995, 1997-2015 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
definitions or enums visible to the debugger. It's used for symbols
that .gdbinit needs. */
+#define DECLARE_GDB_SYM(type, id) type const id EXTERNALLY_VISIBLE
#ifdef MAIN_PROGRAM
-# define DEFINE_GDB_SYMBOL_BEGIN(type, id) type const id EXTERNALLY_VISIBLE
+# define DEFINE_GDB_SYMBOL_BEGIN(type, id) DECLARE_GDB_SYM (type, id)
# define DEFINE_GDB_SYMBOL_END(id) = id;
#else
-# define DEFINE_GDB_SYMBOL_BEGIN(type, id)
-# define DEFINE_GDB_SYMBOL_END(val)
+# define DEFINE_GDB_SYMBOL_BEGIN(type, id) extern DECLARE_GDB_SYM (type, id)
+# define DEFINE_GDB_SYMBOL_END(val) ;
#endif
/* The ubiquitous max and min macros. */
USE_LSB_TAG not only requires the least 3 bits of pointers returned by
malloc to be 0 but also needs to be able to impose a mult-of-8 alignment
- on the few static Lisp_Objects used: all the defsubr as well
- as the two special buffers buffer_defaults and buffer_local_symbols. */
+ on the few static Lisp_Objects used: lispsym, all the defsubr, and
+ the two special buffers buffer_defaults and buffer_local_symbols. */
enum Lisp_Bits
{
/* The maximum value that can be stored in a EMACS_INT, assuming all
bits other than the type bits contribute to a nonnegative signed value.
- This can be used in #if, e.g., '#if VAL_MAX < UINTPTR_MAX' below. */
+ This can be used in #if, e.g., '#if USB_TAG' below expands to an
+ expression involving VAL_MAX. */
#define VAL_MAX (EMACS_INT_MAX >> (GCTYPEBITS - 1))
/* Whether the least-significant bits of an EMACS_INT contain the tag.
- On hosts where pointers-as-ints do not exceed VAL_MAX, USE_LSB_TAG is:
+ On hosts where pointers-as-ints do not exceed VAL_MAX / 2, 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, USE_LSB_TAG is true only on hosts where it might be useful. */
DEFINE_GDB_SYMBOL_BEGIN (bool, USE_LSB_TAG)
-#define USE_LSB_TAG (EMACS_INT_MAX >> GCTYPEBITS < INTPTR_MAX)
+#define USE_LSB_TAG (VAL_MAX / 2 < INTPTR_MAX)
DEFINE_GDB_SYMBOL_END (USE_LSB_TAG)
#if !USE_LSB_TAG && !defined WIDE_EMACS_INT
# endif
#endif
-#ifndef USE_STACK_LISP_OBJECTS
-# define USE_STACK_LISP_OBJECTS false
-#endif
-
-#if defined HAVE_STRUCT_ATTRIBUTE_ALIGNED && USE_STACK_LISP_OBJECTS
+#ifdef HAVE_STRUCT_ATTRIBUTE_ALIGNED
# define GCALIGNED __attribute__ ((aligned (GCALIGNMENT)))
#else
# define GCALIGNED /* empty */
#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)
-#define lisp_h_INTEGERP(x) ((XTYPE (x) & ~Lisp_Int1) == 0)
+#define lisp_h_INTEGERP(x) ((XTYPE (x) & (Lisp_Int0 | ~Lisp_Int1)) == Lisp_Int0)
#define lisp_h_MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
#define lisp_h_MISCP(x) (XTYPE (x) == Lisp_Misc)
#define lisp_h_NILP(x) EQ (x, Qnil)
#define lisp_h_XCONS(a) \
(eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons))
#define lisp_h_XHASH(a) XUINT (a)
-#define lisp_h_XPNTR(a) ((void *) (intptr_t) (XLI (a) & VALMASK))
-#define lisp_h_XSYMBOL(a) \
- (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol))
+#define lisp_h_XPNTR(a) \
+ (SYMBOLP (a) ? XSYMBOL (a) : (void *) ((intptr_t) (XLI (a) & VALMASK)))
#ifndef GC_CHECK_CONS_LIST
# define lisp_h_check_cons_list() ((void) 0)
#endif
#if USE_LSB_TAG
# define lisp_h_make_number(n) \
- XIL ((EMACS_INT) ((EMACS_UINT) (n) << INTTYPEBITS))
+ XIL ((EMACS_INT) (((EMACS_UINT) (n) << INTTYPEBITS) + Lisp_Int0))
# define lisp_h_XFASTINT(a) XINT (a)
# define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS)
+# define lisp_h_XSYMBOL(a) \
+ (eassert (SYMBOLP (a)), \
+ (struct Lisp_Symbol *) ((uintptr_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 *) (XLI (a) - (type)))
+# define lisp_h_XUNTAG(a, type) ((void *) (intptr_t) (XLI (a) - (type)))
#endif
/* When compiling via gcc -O0, define the key operations as macros, as
# define XCONS(a) lisp_h_XCONS (a)
# define XHASH(a) lisp_h_XHASH (a)
# define XPNTR(a) lisp_h_XPNTR (a)
-# define XSYMBOL(a) lisp_h_XSYMBOL (a)
# ifndef GC_CHECK_CONS_LIST
# define check_cons_list() lisp_h_check_cons_list ()
# endif
# define make_number(n) lisp_h_make_number (n)
# define XFASTINT(a) lisp_h_XFASTINT (a)
# define XINT(a) lisp_h_XINT (a)
+# define XSYMBOL(a) lisp_h_XSYMBOL (a)
# define XTYPE(a) lisp_h_XTYPE (a)
# define XUNTAG(a, type) lisp_h_XUNTAG (a, type)
# endif
enum Lisp_Type
{
- /* Integer. XINT (obj) is the integer value. */
- Lisp_Int0 = 0,
- Lisp_Int1 = USE_LSB_TAG ? 1 << INTTYPEBITS : 1,
-
/* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
- Lisp_Symbol = 2,
+ Lisp_Symbol = 0,
/* Miscellaneous. XMISC (object) points to a union Lisp_Misc,
whose first member indicates the subtype. */
- Lisp_Misc = 3,
+ Lisp_Misc = 1,
+
+ /* Integer. XINT (obj) is the integer value. */
+ Lisp_Int0 = 2,
+ Lisp_Int1 = USE_LSB_TAG ? 6 : 3,
/* String. XSTRING (object) points to a struct Lisp_String.
The length of the string, and its contents, are stored therein. */
- Lisp_String = USE_LSB_TAG ? 1 : 1 << INTTYPEBITS,
+ Lisp_String = 4,
/* Vector of Lisp objects, or something resembling it.
XVECTOR (object) points to a struct Lisp_Vector, which contains
Lisp_Vectorlike = 5,
/* Cons. XCONS (object) points to a struct Lisp_Cons. */
- Lisp_Cons = 6,
+ Lisp_Cons = USE_LSB_TAG ? 3 : 6,
Lisp_Float = 7
};
typedef struct { EMACS_INT i; } Lisp_Object;
-#define LISP_INITIALLY_ZERO {0}
+#define LISP_INITIALLY(i) {i}
#undef CHECK_LISP_OBJECT_TYPE
enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true };
/* If a struct type is not wanted, define Lisp_Object as just a number. */
typedef EMACS_INT Lisp_Object;
-#define LISP_INITIALLY_ZERO 0
+#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)
+\f
+/* 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 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 struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object);
+INLINE struct Lisp_Symbol *(XSYMBOL) (Lisp_Object);
+INLINE enum Lisp_Type (XTYPE) (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);
+
+/* Defined in emacs.c. */
+extern bool might_dump;
+/* True means Emacs has already been initialized.
+ Used during startup to detect startup of dumped Emacs. */
+extern bool initialized;
+
+/* Defined in floatfns.c. */
+extern double extract_float (Lisp_Object);
+
+\f
+/* Interned state of a symbol. */
+
+enum symbol_interned
+{
+ SYMBOL_UNINTERNED = 0,
+ SYMBOL_INTERNED = 1,
+ SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2
+};
+
+enum symbol_redirect
+{
+ SYMBOL_PLAINVAL = 4,
+ SYMBOL_VARALIAS = 1,
+ SYMBOL_LOCALIZED = 2,
+ SYMBOL_FORWARDED = 3
+};
+
+struct Lisp_Symbol
+{
+ bool_bf gcmarkbit : 1;
+
+ /* Indicates where the value can be found:
+ 0 : it's a plain var, the value is in the `value' field.
+ 1 : it's a varalias, the value is really in the `alias' symbol.
+ 2 : it's a localized var, the value is in the `blv' object.
+ 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;
+
+ /* Interned state of the symbol. This is an enumerator from
+ enum symbol_interned. */
+ unsigned interned : 2;
+
+ /* True means that this variable has been explicitly declared
+ special (with `defvar' etc), and shouldn't be lexically bound. */
+ bool_bf declared_special : 1;
+
+ /* True if pointed to from purespace and hence can't be GC'd. */
+ bool_bf pinned : 1;
+
+ /* The symbol's name, as a Lisp string. */
+ Lisp_Object name;
+
+ /* Value of the symbol or Qunbound if unbound. Which alternative of the
+ union is used depends on the `redirect' field above. */
+ union {
+ Lisp_Object value;
+ struct Lisp_Symbol *alias;
+ struct Lisp_Buffer_Local_Value *blv;
+ union Lisp_Fwd *fwd;
+ } val;
+
+ /* Function value of the symbol or Qnil if not fboundp. */
+ Lisp_Object function;
+
+ /* The symbol's property list. */
+ Lisp_Object plist;
+
+ /* Next symbol in obarray bucket, if the symbol is interned. */
+ struct Lisp_Symbol *next;
+};
+
+/* Declare a Lisp-callable function. The MAXARGS parameter has the same
+ meaning as in the DEFUN macro, and is used to construct a prototype. */
+/* We can use the same trick as in the DEFUN macro to generate the
+ appropriate prototype. */
+#define EXFUN(fnname, maxargs) \
+ extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs
+
+/* Note that the weird token-substitution semantics of ANSI C makes
+ this work for MANY and UNEVALLED. */
+#define DEFUN_ARGS_MANY (ptrdiff_t, Lisp_Object *)
+#define DEFUN_ARGS_UNEVALLED (Lisp_Object)
+#define DEFUN_ARGS_0 (void)
+#define DEFUN_ARGS_1 (Lisp_Object)
+#define DEFUN_ARGS_2 (Lisp_Object, Lisp_Object)
+#define DEFUN_ARGS_3 (Lisp_Object, Lisp_Object, Lisp_Object)
+#define DEFUN_ARGS_4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
+#define DEFUN_ARGS_5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
+ Lisp_Object)
+#define DEFUN_ARGS_6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
+ Lisp_Object, Lisp_Object)
+#define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
+ Lisp_Object, Lisp_Object, Lisp_Object)
+#define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
+ Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
+
+/* Yield an integer that contains TAG along with PTR. */
+#define TAG_PTR(tag, ptr) \
+ ((USE_LSB_TAG ? (tag) : (EMACS_UINT) (tag) << VALBITS) + (uintptr_t) (ptr))
+
+/* Yield an integer that contains a symbol tag along with OFFSET.
+ OFFSET should be the offset in bytes from 'lispsym' to the symbol. */
+#define TAG_SYMOFFSET(offset) \
+ TAG_PTR (Lisp_Symbol, \
+ ((uintptr_t) (offset) >> (USE_LSB_TAG ? 0 : GCTYPEBITS)))
+
+/* 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_BEGIN(name) \
+ DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name)
+#define DEFINE_LISP_SYMBOL_END(name) \
+ DEFINE_GDB_SYMBOL_END (LISP_INITIALLY (TAG_SYMOFFSET (i##name \
+ * sizeof *lispsym)))
+
+#include "globals.h"
+
/* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa.
At the machine level, these operations are no-ops. */
LISP_MACRO_DEFUN (XLI, EMACS_INT, (Lisp_Object o), (o))
LISP_MACRO_DEFUN (make_number, Lisp_Object, (EMACS_INT n), (n))
LISP_MACRO_DEFUN (XINT, EMACS_INT, (Lisp_Object a), (a))
LISP_MACRO_DEFUN (XFASTINT, EMACS_INT, (Lisp_Object a), (a))
+LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a))
LISP_MACRO_DEFUN (XTYPE, enum Lisp_Type, (Lisp_Object a), (a))
LISP_MACRO_DEFUN (XUNTAG, void *, (Lisp_Object a, int type), (a, type))
INLINE Lisp_Object
make_number (EMACS_INT n)
{
+ EMACS_INT int0 = Lisp_Int0;
if (USE_LSB_TAG)
{
EMACS_UINT u = n;
n = u << INTTYPEBITS;
+ n += int0;
}
else
- n &= INTMASK;
+ {
+ n &= INTMASK;
+ n += (int0 << VALBITS);
+ }
return XIL (n);
}
INLINE EMACS_INT
XFASTINT (Lisp_Object a)
{
- EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a);
+ EMACS_INT int0 = Lisp_Int0;
+ EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a) - (int0 << VALBITS);
eassert (0 <= n);
return n;
}
+/* Extract A's value as a symbol. */
+INLINE struct Lisp_Symbol *
+XSYMBOL (Lisp_Object a)
+{
+ uintptr_t i = (uintptr_t) XUNTAG (a, Lisp_Symbol);
+ if (! USE_LSB_TAG)
+ i <<= GCTYPEBITS;
+ void *p = (char *) lispsym + i;
+ return p;
+}
+
/* Extract A's type. */
INLINE enum Lisp_Type
XTYPE (Lisp_Object a)
INLINE void *
XUNTAG (Lisp_Object a, int type)
{
- if (USE_LSB_TAG)
- {
- intptr_t i = XLI (a) - type;
- return (void *) i;
- }
- return XPNTR (a);
+ intptr_t i = USE_LSB_TAG ? XLI (a) - type : XLI (a) & VALMASK;
+ return (void *) i;
}
#endif /* ! USE_LSB_TAG */
make_natnum (EMACS_INT n)
{
eassert (0 <= n && n <= MOST_POSITIVE_FIXNUM);
- return USE_LSB_TAG ? make_number (n) : XIL (n);
+ EMACS_INT int0 = Lisp_Int0;
+ return USE_LSB_TAG ? make_number (n) : XIL (n + (int0 << VALBITS));
}
/* Return true if X and Y are the same object. */
return num < lower ? lower : num <= upper ? num : upper;
}
\f
-/* 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 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 struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object);
-
-/* 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 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, Qt, Qvectorp;
-extern Lisp_Object Qbool_vector_p;
-extern Lisp_Object Qvector_or_char_table_p, Qwholenump;
-extern Lisp_Object Qwindow;
-extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
-extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object);
-
-/* Defined in emacs.c. */
-extern bool might_dump;
-/* True means Emacs has already been initialized.
- Used during startup to detect startup of dumped Emacs. */
-extern bool initialized;
-
-/* Defined in eval.c. */
-extern Lisp_Object Qautoload;
-
-/* Defined in floatfns.c. */
-extern double extract_float (Lisp_Object);
-
-/* Defined in process.c. */
-extern Lisp_Object Qprocessp;
-
-/* Defined in window.c. */
-extern Lisp_Object Qwindowp;
-
-/* Defined in xdisp.c. */
-extern Lisp_Object Qimage;
-\f
/* Extract a value or address from a Lisp_Object. */
return XUNTAG (a, Lisp_String);
}
-LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a))
+/* 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)
INLINE Lisp_Object
make_lisp_ptr (void *ptr, enum Lisp_Type type)
{
- EMACS_UINT utype = type;
- EMACS_UINT typebits = USE_LSB_TAG ? type : utype << VALBITS;
- Lisp_Object a = XIL (typebits | (uintptr_t) ptr);
+ Lisp_Object a = XIL (TAG_PTR (type, ptr));
eassert (XTYPE (a) == type && XUNTAG (a, type) == ptr);
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)
+{
+ return make_lisp_symbol (lispsym + index);
+}
+
INLINE Lisp_Object
make_lisp_proc (struct Lisp_Process *p)
{
#define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons))
#define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, 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 XSETSYMBOL(a, b) ((a) = make_lisp_symbol (b))
#define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float))
#define XSETMISC(a, b) ((a) = make_lisp_ptr (b, Lisp_Misc))
#define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
#define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE))
+/* Efficiently convert a pointer to a Lisp object and back. The
+ pointer is represented as a Lisp integer, so the garbage collector
+ does not know about it. The pointer should not have both Lisp_Int1
+ bits set, which makes this conversion inherently unportable. */
+
+INLINE void *
+XINTPTR (Lisp_Object a)
+{
+ return XUNTAG (a, Lisp_Int0);
+}
+
+INLINE Lisp_Object
+make_pointer_integer (void *p)
+{
+ Lisp_Object a = XIL (TAG_PTR (Lisp_Int0, p));
+ eassert (INTEGERP (a) && XINTPTR (a) == p);
+ return a;
+}
+
/* Type checking. */
LISP_MACRO_DEFUN_VOID (CHECK_TYPE,
/* In a string or vector, the sign bit of the `size' is the gc mark bit. */
-struct Lisp_String
+struct GCALIGNED Lisp_String
{
ptrdiff_t size;
ptrdiff_t size_byte;
Symbols
***********************************************************************/
-/* Interned state of a symbol. */
-
-enum symbol_interned
-{
- SYMBOL_UNINTERNED = 0,
- SYMBOL_INTERNED = 1,
- SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2
-};
-
-enum symbol_redirect
-{
- SYMBOL_PLAINVAL = 4,
- SYMBOL_VARALIAS = 1,
- SYMBOL_LOCALIZED = 2,
- SYMBOL_FORWARDED = 3
-};
-
-struct Lisp_Symbol
-{
- bool_bf gcmarkbit : 1;
-
- /* Indicates where the value can be found:
- 0 : it's a plain var, the value is in the `value' field.
- 1 : it's a varalias, the value is really in the `alias' symbol.
- 2 : it's a localized var, the value is in the `blv' object.
- 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;
-
- /* Interned state of the symbol. This is an enumerator from
- enum symbol_interned. */
- unsigned interned : 2;
-
- /* True means that this variable has been explicitly declared
- special (with `defvar' etc), and shouldn't be lexically bound. */
- bool_bf declared_special : 1;
-
- /* True if pointed to from purespace and hence can't be GC'd. */
- bool_bf pinned : 1;
-
- /* The symbol's name, as a Lisp string. */
- Lisp_Object name;
-
- /* Value of the symbol or Qunbound if unbound. Which alternative of the
- union is used depends on the `redirect' field above. */
- union {
- Lisp_Object value;
- struct Lisp_Symbol *alias;
- struct Lisp_Buffer_Local_Value *blv;
- union Lisp_Fwd *fwd;
- } val;
-
- /* Function value of the symbol or Qnil if not fboundp. */
- Lisp_Object function;
-
- /* The symbol's property list. */
- Lisp_Object plist;
-
- /* Next symbol in obarray bucket, if the symbol is interned. */
- struct Lisp_Symbol *next;
-};
-
/* Value is name of symbol. */
LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (struct Lisp_Symbol *sym), (sym))
LISP_MACRO_DEFUN (SYMBOL_CONSTANT_P, int, (Lisp_Object sym), (sym))
-#define DEFSYM(sym, name) \
- do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (false)
+/* Placeholder for make-docfile to process. The actual symbol
+ definition is done by lread.c's defsym. */
+#define DEFSYM(sym, name) /* empty */
\f
/***********************************************************************
Lisp_Object fnname
#endif
-/* Note that the weird token-substitution semantics of ANSI C makes
- this work for MANY and UNEVALLED. */
-#define DEFUN_ARGS_MANY (ptrdiff_t, Lisp_Object *)
-#define DEFUN_ARGS_UNEVALLED (Lisp_Object)
-#define DEFUN_ARGS_0 (void)
-#define DEFUN_ARGS_1 (Lisp_Object)
-#define DEFUN_ARGS_2 (Lisp_Object, Lisp_Object)
-#define DEFUN_ARGS_3 (Lisp_Object, Lisp_Object, Lisp_Object)
-#define DEFUN_ARGS_4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
-#define DEFUN_ARGS_5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
- Lisp_Object)
-#define DEFUN_ARGS_6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
- Lisp_Object, Lisp_Object)
-#define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
- Lisp_Object, Lisp_Object, Lisp_Object)
-#define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
- Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
-
/* True if OBJ is a Lisp function. */
INLINE bool
FUNCTIONP (Lisp_Object obj)
void staticpro (Lisp_Object *);
\f
-/* Declare a Lisp-callable function. The MAXARGS parameter has the same
- meaning as in the DEFUN macro, and is used to construct a prototype. */
-/* We can use the same trick as in the DEFUN macro to generate the
- appropriate prototype. */
-#define EXFUN(fnname, maxargs) \
- extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs
-
-#include "globals.h"
-
/* Forward declarations for prototypes. */
struct window;
struct frame;
XSUB_CHAR_TABLE (table)->contents[idx] = val;
}
-/* Defined in data.c. */
-extern Lisp_Object Qquote, Qunbound;
-extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
-extern Lisp_Object Qerror, Qquit, Qargs_out_of_range;
-extern Lisp_Object Qvoid_variable, Qvoid_function;
-extern Lisp_Object Qinvalid_read_syntax;
-extern Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
-extern Lisp_Object Quser_error, Qend_of_file, Qarith_error, Qmark_inactive;
-extern Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
-extern Lisp_Object Qtext_read_only;
-extern Lisp_Object Qinteractive_form;
-extern Lisp_Object Qcircular_list;
-extern Lisp_Object Qsequencep;
-extern Lisp_Object Qchar_or_string_p, Qinteger_or_marker_p;
-extern Lisp_Object Qfboundp;
-
-extern Lisp_Object Qcdr;
-
-extern Lisp_Object Qrange_error, Qoverflow_error;
-
-extern Lisp_Object Qnumber_or_marker_p;
-
-extern Lisp_Object Qbuffer, Qinteger, Qsymbol;
-
/* Defined in data.c. */
extern Lisp_Object indirect_function (Lisp_Object);
extern Lisp_Object find_symbol_value (Lisp_Object);
extern void keys_of_cmds (void);
/* Defined in coding.c. */
-extern Lisp_Object Qcharset;
extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t,
ptrdiff_t, bool, bool, Lisp_Object);
extern void init_coding (void);
extern void syms_of_syntax (void);
/* Defined in fns.c. */
-extern Lisp_Object QCrehash_size, QCrehash_threshold;
enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST;
extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t);
extern void sweep_weak_hash_tables (void);
-extern Lisp_Object Qcursor_in_echo_area;
-extern Lisp_Object Qstring_lessp;
-extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq;
EMACS_UINT hash_string (char const *, ptrdiff_t);
EMACS_UINT sxhash (Lisp_Object, int);
Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object,
#endif /* HAVE_WINDOW_SYSTEM */
/* Defined in image.c. */
-extern Lisp_Object QCascent, QCmargin, QCrelief;
-extern Lisp_Object QCconversion;
extern int x_bitmap_mask (struct frame *, ptrdiff_t);
extern void reset_image_types (void);
extern void syms_of_image (void);
/* Defined in insdel.c. */
-extern Lisp_Object Qinhibit_modification_hooks;
-extern Lisp_Object Qregion_extract_function;
extern void move_gap_both (ptrdiff_t, ptrdiff_t);
extern _Noreturn void buffer_overflow (void);
extern void make_gap (ptrdiff_t);
extern Lisp_Object sit_for (Lisp_Object, bool, int);
/* Defined in xdisp.c. */
-extern Lisp_Object Qinhibit_point_motion_hooks;
-extern Lisp_Object Qinhibit_redisplay;
-extern Lisp_Object Qmenu_bar_update_hook;
-extern Lisp_Object Qwindow_scroll_functions;
-extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
-extern Lisp_Object Qtext, Qboth, Qboth_horiz, Qtext_image_horiz;
-extern Lisp_Object Qspace, Qcenter, QCalign_to;
-extern Lisp_Object Qbar, Qhbar, Qhollow;
-extern Lisp_Object Qleft_margin, Qright_margin;
-extern Lisp_Object QCdata, QCfile;
-extern Lisp_Object QCmap;
-extern Lisp_Object Qrisky_local_variable;
extern bool noninteractive_need_newline;
extern Lisp_Object echo_area_buffer[2];
extern void add_to_log (const char *, Lisp_Object, Lisp_Object);
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 local_string_init (struct Lisp_String *, char const *,
- ptrdiff_t);
extern Lisp_Object make_formatted_string (char *, const char *, ...)
ATTRIBUTE_FORMAT_PRINTF (2, 3);
extern Lisp_Object make_unibyte_string (const char *, ptrdiff_t);
extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
extern void make_byte_code (struct Lisp_Vector *);
-extern Lisp_Object Qautomatic_gc;
-extern Lisp_Object Qchar_table_extra_slots;
extern struct Lisp_Vector *allocate_vector (EMACS_INT);
/* Make an uninitialized vector for SIZE objects. NOTE: you must
extern struct window *allocate_window (void);
extern struct frame *allocate_frame (void);
extern struct Lisp_Process *allocate_process (void);
-extern Lisp_Object local_vector_init (struct Lisp_Vector *, ptrdiff_t,
- Lisp_Object);
extern struct terminal *allocate_terminal (void);
extern bool gc_in_progress;
extern bool abort_on_gc;
/* Defined in print.c. */
extern Lisp_Object Vprin1_to_string_buffer;
extern void debug_print (Lisp_Object) EXTERNALLY_VISIBLE;
-extern Lisp_Object Qstandard_output;
-extern Lisp_Object Qexternal_debugging_output;
extern void temp_output_buffer_setup (const char *);
extern int print_level;
-extern Lisp_Object Qprint_escape_newlines;
extern void write_string (const char *, int);
extern void print_error_message (Lisp_Object, Lisp_Object, const char *,
Lisp_Object);
ATTRIBUTE_FORMAT_PRINTF (5, 0);
/* Defined in lread.c. */
-extern Lisp_Object Qvariable_documentation, Qstandard_input;
-extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
-extern Lisp_Object Qlexical_binding;
extern Lisp_Object check_obarray (Lisp_Object);
extern Lisp_Object intern_1 (const char *, ptrdiff_t);
extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
-extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, ptrdiff_t);
+extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, Lisp_Object);
+extern void init_symbol (Lisp_Object, Lisp_Object);
extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
INLINE void
LOADHIST_ATTACH (Lisp_Object x)
/* Defined in eval.c. */
extern EMACS_INT lisp_eval_depth;
-extern Lisp_Object Qexit, Qinteractive, Qcommandp, Qmacro;
-extern Lisp_Object Qinhibit_quit, Qinternal_interpreter_environment, Qclosure;
-extern Lisp_Object Qand_rest;
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;
call1 (Vrun_hooks, Qmy_funny_hook);
should no longer be used. */
-extern Lisp_Object Vrun_hooks;
+extern void run_hook (Lisp_Object);
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)
/* Defined in editfns.c. */
-extern Lisp_Object Qfield;
extern void insert1 (Lisp_Object);
extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object);
extern Lisp_Object save_excursion_save (void);
ptrdiff_t, bool);
extern void init_editfns (void);
extern void syms_of_editfns (void);
-extern void set_time_zone_rule (const char *);
/* Defined in buffer.c. */
extern bool mouse_face_overlay_overlaps (Lisp_Object);
/* Defined in fileio.c. */
-extern Lisp_Object Qfile_error;
-extern Lisp_Object Qfile_notify_error;
-extern Lisp_Object Qfile_exists_p;
-extern Lisp_Object Qfile_directory_p;
-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,
extern void init_fileio (void);
extern void syms_of_fileio (void);
extern Lisp_Object make_temp_name (Lisp_Object, bool);
-extern Lisp_Object Qdelete_file;
/* Defined in search.c. */
extern void shrink_regexp_cache (void);
ptrdiff_t, ptrdiff_t *, ptrdiff_t *, bool);
extern ptrdiff_t scan_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
ptrdiff_t, bool);
+extern ptrdiff_t scan_newline_from_point (ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
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,
/* Defined in minibuf.c. */
-extern Lisp_Object Qcompletion_ignore_case;
extern Lisp_Object Vminibuffer_list;
extern Lisp_Object last_minibuf_string;
extern Lisp_Object get_minibuffer (EMACS_INT);
/* Defined in callint.c. */
-extern Lisp_Object Qminus, Qplus;
-extern Lisp_Object Qprogn;
-extern Lisp_Object Qwhen;
-extern Lisp_Object Qmouse_leave_buffer_hook;
extern void syms_of_callint (void);
/* Defined in casefiddle.c. */
-extern Lisp_Object Qidentity;
extern void syms_of_casefiddle (void);
extern void keys_of_casefiddle (void);
extern Lisp_Object echo_message_buffer;
extern struct kboard *echo_kboard;
extern void cancel_echoing (void);
-extern Lisp_Object Qdisabled, QCfilter;
-extern Lisp_Object Qup, Qdown;
extern Lisp_Object last_undo_boundary;
extern bool input_pending;
#ifdef HAVE_STACK_OVERFLOW_HANDLING
extern void syms_of_indent (void);
/* Defined in frame.c. */
-extern Lisp_Object Qonly, Qnone;
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);
#endif
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);
-extern Lisp_Object Qkill_emacs;
#ifdef WINDOWSNT
extern Lisp_Object Vlibrary_cache;
#endif
extern bool running_asynch_code;
/* Defined in process.c. */
-extern Lisp_Object QCtype, Qlocal;
extern void kill_buffer_processes (Lisp_Object);
extern int wait_reading_process_output (intmax_t, int, int, bool, Lisp_Object,
struct Lisp_Process *, int);
extern void syms_of_callproc (void);
/* Defined in doc.c. */
-extern Lisp_Object Qfunction_documentation;
extern Lisp_Object read_doc_string (Lisp_Object);
extern Lisp_Object get_doc_string (Lisp_Object, bool, bool);
extern void syms_of_doc (void);
extern void syms_of_macros (void);
/* Defined in undo.c. */
-extern Lisp_Object Qapply;
-extern Lisp_Object Qinhibit_read_only;
extern void truncate_undo_list (struct buffer *);
extern void record_insert (ptrdiff_t, ptrdiff_t);
extern void record_delete (ptrdiff_t, Lisp_Object, bool);
Lisp_Object, Lisp_Object,
Lisp_Object);
extern void syms_of_undo (void);
-/* Defined in textprop.c. */
-extern Lisp_Object Qmouse_face;
-extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks;
-extern Lisp_Object Qminibuffer_prompt;
+/* Defined in textprop.c. */
extern void report_interval_modification (Lisp_Object, Lisp_Object);
/* Defined in menu.c. */
#ifdef HAVE_WINDOW_SYSTEM
/* Defined in fontset.c. */
extern void syms_of_fontset (void);
-
-/* Defined in xfns.c, w32fns.c, or macfns.c. */
-extern Lisp_Object Qfont_param;
#endif
/* Defined in gfilenotify.c */
#endif
/* Defined in xfaces.c. */
-extern Lisp_Object Qdefault, Qfringe;
-extern Lisp_Object Qscroll_bar, Qcursor;
-extern Lisp_Object Qmode_line_inactive;
-extern Lisp_Object Qface;
-extern Lisp_Object Qnormal;
-extern Lisp_Object QCfamily, QCweight, QCslant;
-extern Lisp_Object QCheight, QCname, QCwidth, QCforeground, QCbackground;
-extern Lisp_Object Qextra_light, Qlight, Qsemi_light, Qsemi_bold;
-extern Lisp_Object Qbold, Qextra_bold, Qultra_bold;
-extern Lisp_Object Qoblique, Qitalic;
extern Lisp_Object Vface_alternative_font_family_alist;
extern Lisp_Object Vface_alternative_font_registry_alist;
extern void syms_of_xfaces (void);
extern void syms_of_xselect (void);
/* Defined in xterm.c. */
+extern void init_xterm (void);
extern void syms_of_xterm (void);
#endif /* HAVE_X_WINDOWS */
#ifdef HAVE_DBUS
/* Defined in dbusbind.c. */
+void init_dbusbind (void);
void syms_of_dbusbind (void);
#endif
extern char *xstrdup (const char *) ATTRIBUTE_MALLOC;
extern char *xlispstrdup (Lisp_Object) ATTRIBUTE_MALLOC;
extern void dupstring (char **, char const *);
+
+/* Make DEST a copy of STRING's data. Return a pointer to DEST's terminating
+ null byte. This is like stpcpy, except the source is a Lisp string. */
+
+INLINE char *
+lispstpcpy (char *dest, Lisp_Object string)
+{
+ ptrdiff_t len = SBYTES (string);
+ memcpy (dest, SDATA (string), len + 1);
+ return dest + len;
+}
+
extern void xputenv (const char *);
extern char *egetenv_internal (const char *, ptrdiff_t);
extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
#define USE_SAFE_ALLOCA \
+ ptrdiff_t sa_avail = MAX_ALLOCA; \
ptrdiff_t sa_count = SPECPDL_INDEX (); bool sa_must_free = false
+#define AVAIL_ALLOCA(size) (sa_avail -= (size), alloca (size))
+
/* SAFE_ALLOCA allocates a simple buffer. */
-#define SAFE_ALLOCA(size) ((size) <= MAX_ALLOCA \
- ? alloca (size) \
+#define SAFE_ALLOCA(size) ((size) <= sa_avail \
+ ? AVAIL_ALLOCA (size) \
: (sa_must_free = true, record_xmalloc (size)))
/* SAFE_NALLOCA sets BUF to a newly allocated array of MULTIPLIER *
#define SAFE_NALLOCA(buf, multiplier, nitems) \
do { \
- if ((nitems) <= MAX_ALLOCA / sizeof *(buf) / (multiplier)) \
- (buf) = alloca (sizeof *(buf) * (multiplier) * (nitems)); \
+ if ((nitems) <= sa_avail / sizeof *(buf) / (multiplier)) \
+ (buf) = AVAIL_ALLOCA (sizeof *(buf) * (multiplier) * (nitems)); \
else \
{ \
(buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \
} while (false)
+/* Return floor (NBYTES / WORD_SIZE). */
+
+INLINE ptrdiff_t
+lisp_word_count (ptrdiff_t nbytes)
+{
+ if (-1 >> 1 == -1)
+ switch (word_size)
+ {
+ case 2: return nbytes >> 1;
+ case 4: return nbytes >> 2;
+ case 8: return nbytes >> 3;
+ case 16: return nbytes >> 4;
+ }
+ return nbytes / word_size - (nbytes % word_size < 0);
+}
+
/* 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); \
+ if ((nelt) <= lisp_word_count (sa_avail)) \
+ (buf) = AVAIL_ALLOCA ((nelt) * word_size); \
else if ((nelt) <= min (PTRDIFF_MAX, SIZE_MAX) / word_size) \
{ \
Lisp_Object arg_; \
} while (false)
-/* If USE_STACK_LISP_OBJECTS, define macros that and functions that
- allocate block-scoped conses and function-scoped vectors and
- strings. These objects are not managed by the garbage collector,
- so they are dangerous: passing them out of their scope (e.g., to
- user code) results in undefined behavior. Conversely, they have
- better performance because GC is not involved.
+/* If USE_STACK_LISP_OBJECTS, define macros that and functions that allocate
+ block-scoped conses and strings. These objects are not
+ managed by the garbage collector, so they are dangerous: passing them
+ out of their scope (e.g., to user code) results in undefined behavior.
+ Conversely, they have better performance because GC is not involved.
This feature is experimental and requires careful debugging.
- Brave users can compile with CPPFLAGS='-DUSE_STACK_LISP_OBJECTS'
- to get into the game. */
+ Build with CPPFLAGS='-DUSE_STACK_LISP_OBJECTS=0' to disable it. */
+
+#ifndef USE_STACK_LISP_OBJECTS
+# define USE_STACK_LISP_OBJECTS true
+#endif
+
+/* USE_STACK_LISP_OBJECTS requires GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS. */
+
+#if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS
+# undef USE_STACK_LISP_OBJECTS
+# define USE_STACK_LISP_OBJECTS false
+#endif
+
+#ifdef GC_CHECK_STRING_BYTES
+enum { defined_GC_CHECK_STRING_BYTES = true };
+#else
+enum { defined_GC_CHECK_STRING_BYTES = false };
+#endif
-/* A struct Lisp_Cons inside a union that is no larger and may be
- better-aligned. */
+/* Struct inside unions that are typically no larger and aligned enough. */
union Aligned_Cons
{
struct Lisp_Cons s;
double d; intmax_t i; void *p;
};
-verify (sizeof (struct Lisp_Cons) == sizeof (union Aligned_Cons));
-/* Allocate a block-scoped cons. */
-
-#define scoped_cons(car, cdr) \
- ((USE_STACK_LISP_OBJECTS \
- && alignof (union Aligned_Cons) % GCALIGNMENT == 0) \
- ? make_lisp_ptr (&((union Aligned_Cons) {{car, {cdr}}}).s, Lisp_Cons) \
- : Fcons (car, cdr))
-
-/* Convenient utility macros similar to listX functions. */
-
-#if USE_STACK_LISP_OBJECTS
-# define scoped_list1(a) scoped_cons (a, Qnil)
-# define scoped_list2(a, b) scoped_cons (a, scoped_list1 (b))
-# define scoped_list3(a, b, c) scoped_cons (a, scoped_list2 (b, c))
-# define scoped_list4(a, b, c, d) scoped_cons (a, scoped_list3 (b, c, d))
-#else
-# define scoped_list1(a) list1 (a)
-# define scoped_list2(a, b) list2 (a, b)
-# define scoped_list3(a, b, c) list3 (a, b, c)
-# define scoped_list4(a, b, c, d) list4 (a, b, c, d)
-#endif
+union Aligned_String
+{
+ struct Lisp_String s;
+ double d; intmax_t i; void *p;
+};
-/* Local allocators require both statement expressions and a
- GCALIGNMENT-aligned alloca. clang's alloca isn't properly aligned
- in some cases. In the absence of solid information, play it safe
- for other non-GCC compilers. */
-#if (USE_STACK_LISP_OBJECTS && HAVE_STATEMENT_EXPRESSIONS \
- && __GNUC__ && !__clang__)
-# define USE_LOCAL_ALLOCATORS
-#endif
+/* True for stack-based cons and string implementations, respectively.
+ Use stack-based strings only if stack-based cons also works.
+ Otherwise, STACK_CONS would create heap-based cons cells that
+ could point to stack-based strings, which is a no-no. */
-#ifdef USE_LOCAL_ALLOCATORS
-
-/* Return a function-scoped cons whose car is X and cdr is Y. */
-
-# define local_cons(x, y) \
- ({ \
- struct Lisp_Cons *c_ = alloca (sizeof (struct Lisp_Cons)); \
- c_->car = (x); \
- c_->u.cdr = (y); \
- make_lisp_ptr (c_, Lisp_Cons); \
- })
-
-# define local_list1(a) local_cons (a, Qnil)
-# define local_list2(a, b) local_cons (a, local_list1 (b))
-# define local_list3(a, b, c) local_cons (a, local_list2 (b, c))
-# define local_list4(a, b, c, d) local_cons (a, local_list3 (b, c, d))
-
-/* Return a function-scoped vector of length SIZE, with each element
- being INIT. */
-
-# define make_local_vector(size, init) \
- ({ \
- ptrdiff_t size_ = size; \
- Lisp_Object init_ = init; \
- Lisp_Object vec_; \
- if (size_ <= (MAX_ALLOCA - header_size) / word_size) \
- { \
- void *ptr_ = alloca (size_ * word_size + header_size); \
- vec_ = local_vector_init (ptr_, size_, init_); \
- } \
- else \
- vec_ = Fmake_vector (make_number (size_), init_); \
- vec_; \
- })
-
-/* Return a function-scoped string with contents DATA and length NBYTES. */
-
-# define make_local_string(data, nbytes) \
- ({ \
- char const *data_ = data; \
- ptrdiff_t nbytes_ = nbytes; \
- Lisp_Object string_; \
- if (nbytes_ <= MAX_ALLOCA - sizeof (struct Lisp_String) - 1) \
- { \
- struct Lisp_String *ptr_ \
- = alloca (sizeof (struct Lisp_String) + 1 + nbytes_); \
- string_ = local_string_init (ptr_, data_, nbytes_); \
- } \
- else \
- string_ = make_string (data_, nbytes_); \
- string_; \
- })
-
-/* Return a function-scoped string with contents DATA. */
-
-# define build_local_string(data) \
- ({ char const *data1_ = (data); \
- make_local_string (data1_, strlen (data1_)); })
+enum
+ {
+ USE_STACK_CONS = (USE_STACK_LISP_OBJECTS
+ && alignof (union Aligned_Cons) % GCALIGNMENT == 0),
+ USE_STACK_STRING = (USE_STACK_CONS
+ && !defined_GC_CHECK_STRING_BYTES
+ && alignof (union Aligned_String) % GCALIGNMENT == 0)
+ };
+/* Auxiliary macros used for auto allocation of Lisp objects. Please
+ use these only in macros like AUTO_CONS that declare a local
+ variable whose lifetime will be clear to the programmer. */
+#define STACK_CONS(a, b) \
+ make_lisp_ptr (&(union Aligned_Cons) { { a, { b } } }.s, Lisp_Cons)
+#define AUTO_CONS_EXPR(a, b) \
+ (USE_STACK_CONS ? STACK_CONS (a, b) : Fcons (a, b))
+
+/* Declare NAME as an auto Lisp cons or short list if possible, a
+ GC-based one otherwise. This is in the sense of the C keyword
+ 'auto'; i.e., the object has the lifetime of the containing block.
+ The resulting object should not be made visible to user Lisp code. */
+
+#define AUTO_CONS(name, a, b) Lisp_Object name = AUTO_CONS_EXPR (a, b)
+#define AUTO_LIST1(name, a) \
+ Lisp_Object name = (USE_STACK_CONS ? STACK_CONS (a, Qnil) : list1 (a))
+#define AUTO_LIST2(name, a, b) \
+ Lisp_Object name = (USE_STACK_CONS \
+ ? STACK_CONS (a, STACK_CONS (b, Qnil)) \
+ : list2 (a, b))
+#define AUTO_LIST3(name, a, b, c) \
+ Lisp_Object name = (USE_STACK_CONS \
+ ? STACK_CONS (a, STACK_CONS (b, STACK_CONS (c, Qnil))) \
+ : list3 (a, b, c))
+#define AUTO_LIST4(name, a, b, c, d) \
+ Lisp_Object name \
+ = (USE_STACK_CONS \
+ ? STACK_CONS (a, STACK_CONS (b, STACK_CONS (c, \
+ STACK_CONS (d, Qnil)))) \
+ : list4 (a, b, c, d))
+
+/* Check whether stack-allocated strings are ASCII-only. */
+
+#if defined (ENABLE_CHECKING) && USE_STACK_LISP_OBJECTS
+extern const char *verify_ascii (const char *);
#else
-
-/* Safer but slower implementations. */
-INLINE Lisp_Object
-local_cons (Lisp_Object car, Lisp_Object cdr)
-{
- return Fcons (car, cdr);
-}
-INLINE Lisp_Object
-local_list1 (Lisp_Object a)
-{
- return list1 (a);
-}
-INLINE Lisp_Object
-local_list2 (Lisp_Object a, Lisp_Object b)
-{
- return list2 (a, b);
-}
-INLINE Lisp_Object
-local_list3 (Lisp_Object a, Lisp_Object b, Lisp_Object c)
-{
- return list3 (a, b, c);
-}
-INLINE Lisp_Object
-local_list4 (Lisp_Object a, Lisp_Object b, Lisp_Object c, Lisp_Object d)
-{
- return list4 (a, b, c, d);
-}
-INLINE Lisp_Object
-make_local_vector (ptrdiff_t size, Lisp_Object init)
-{
- return Fmake_vector (make_number (size), init);
-}
-INLINE Lisp_Object
-make_local_string (char const *str, ptrdiff_t nbytes)
-{
- return make_string (str, nbytes);
-}
-INLINE Lisp_Object
-build_local_string (const char *str)
-{
- return build_string (str);
-}
+# define verify_ascii(str) (str)
#endif
+/* 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. */
+
+#define AUTO_STRING(name, str) \
+ 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)))
/* Loop over all tails of a list, checking for cycles.
FIXME: Make tortoise and n internal declarations.