X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f135e94e4ecb4c6d3f88c7e028c935c2858f2e02..c6e9f7838aaf2efbb519c7401a60caffa36a4f9d:/src/lisp.h diff --git a/src/lisp.h b/src/lisp.h index 1347b35f04..8d44b97271 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1,6 +1,6 @@ /* 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. @@ -44,12 +44,13 @@ INLINE_HEADER_BEGIN 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. */ @@ -257,16 +258,17 @@ 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 @@ -282,11 +284,7 @@ error !; # 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 */ @@ -340,7 +338,7 @@ error !; #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) @@ -364,7 +362,7 @@ error !; #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)) @@ -576,7 +574,73 @@ typedef EMACS_INT Lisp_Object; #define LISP_INITIALLY_ZERO 0 enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false }; #endif /* CHECK_LISP_OBJECT_TYPE */ + +/* 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; + /* 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)) @@ -676,13 +740,18 @@ 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); } @@ -705,7 +774,8 @@ XINT (Lisp_Object a) 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; } @@ -750,7 +820,8 @@ INLINE Lisp_Object 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. */ @@ -769,71 +840,6 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) return num < lower ? lower : num <= upper ? num : upper; } -/* 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; - /* Extract a value or address from a Lisp_Object. */ @@ -1076,7 +1082,7 @@ CDR_SAFE (Lisp_Object c) /* 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; @@ -3693,8 +3699,6 @@ extern Lisp_Object make_uninit_bool_vector (EMACS_INT); extern Lisp_Object bool_vector_fill (Lisp_Object, Lisp_Object); extern _Noreturn void string_overflow (void); extern Lisp_Object make_string (const char *, ptrdiff_t); -extern Lisp_Object 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); @@ -3783,8 +3787,6 @@ extern struct Lisp_Hash_Table *allocate_hash_table (void); 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; @@ -3871,12 +3873,13 @@ extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char const *, ptrdiff_t, 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) @@ -3975,8 +3978,7 @@ extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object); extern void init_eval (void); extern void syms_of_eval (void); extern void unwind_body (Lisp_Object); -extern void record_in_backtrace (Lisp_Object function, - Lisp_Object *args, ptrdiff_t nargs); +extern 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); @@ -3998,7 +4000,6 @@ extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, 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); @@ -4075,6 +4076,7 @@ extern ptrdiff_t find_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, 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, @@ -4406,6 +4408,7 @@ extern void syms_of_xsmfns (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 */ @@ -4427,6 +4430,7 @@ extern void syms_of_decompress (void); #ifdef HAVE_DBUS /* Defined in dbusbind.c. */ +void init_dbusbind (void); void syms_of_dbusbind (void); #endif @@ -4462,6 +4466,18 @@ extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t); 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); @@ -4496,12 +4512,15 @@ enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 }; 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 * @@ -4510,8 +4529,8 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); #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)); \ @@ -4539,12 +4558,28 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); } 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_; \ @@ -4558,162 +4593,112 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); } 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(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.