/* 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. */
/* 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)
#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_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
#define LISP_INITIALLY_ZERO 0
enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false };
#endif /* CHECK_LISP_OBJECT_TYPE */
+\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;
+extern Lisp_Object Qfontification_functions;
+\f
/* 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))
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;
}
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. */
/* 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;
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 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;
ATTRIBUTE_FORMAT_PRINTF (5, 0);
/* Defined in lread.c. */
-extern Lisp_Object Qvariable_documentation, Qstandard_input;
+extern Lisp_Object Qsize, 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 oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
INLINE void
LOADHIST_ATTACH (Lisp_Object x)
extern void init_eval (void);
extern void syms_of_eval (void);
extern void unwind_body (Lisp_Object);
-extern void record_in_backtrace (Lisp_Object function,
- Lisp_Object *args, ptrdiff_t nargs);
+extern ptrdiff_t record_in_backtrace (Lisp_Object, Lisp_Object *, ptrdiff_t);
extern void mark_specpdl (void);
extern void get_backtrace (Lisp_Object array);
Lisp_Object backtrace_top_function (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);
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,
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
-/* A struct Lisp_Cons inside a union that is no larger and may be
- better-aligned. */
+/* 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
+
+/* 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(x) scoped_cons (x, Qnil)
-# define scoped_list2(x, y) scoped_cons (x, scoped_list1 (y))
-# define scoped_list3(x, y, z) scoped_cons (x, scoped_list2 (y, z))
-#else
-# define scoped_list1(x) list1 (x)
-# define scoped_list2(x, y) list2 (x, y)
-# define scoped_list3(x, y, z) list3 (x, y, z)
-#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(x) local_cons (x, Qnil)
-# define local_list2(x, y) local_cons (x, local_list1 (y))
-# define local_list3(x, y, z) local_cons (x, local_list2 (y, z))
-# define local_list4(x, y, z, t) local_cons (x, local_list3 (y, z, t))
-
-/* 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. */
-# define local_cons(car, cdr) Fcons (car, cdr)
-# define local_list1(x) list1 (x)
-# define local_list2(x, y) list2 (x, y)
-# define local_list3(x, y, z) list3 (x, y, z)
-# define local_list4(x, y, z, t) list4 (x, y, z, t)
-# define make_local_vector(size, init) Fmake_vector (make_number (size), init)
-# define make_local_string(data, nbytes) make_string (data, nbytes)
-# define build_local_string(data) build_string (data)
+# 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.