From 11e28ab08d44c1fc40e3e4dc728c14c521b3879d Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Tue, 9 Sep 2014 23:38:38 -0700
Subject: [PATCH] Improve the experimental local and scoped allocation.

* configure.ac (HAVE_STRUCT_ATTRIBUTE_ALIGNED)
(HAVE_STATEMENT_EXPRESSIONS): New configure-time checks.
* src/alloc.c (local_string_init, local_vector_init):
New functions, defined if USE_LOCAL_ALLOCATORS.
Mostly, these are moved here from lisp.h, as it's not
clear it's worth making them inline.
* src/lisp.h (USE_STACK_LISP_OBJECTS): Default to false.
(GCALIGNED): Depend on HAVE_STRUCT_ATTRIBUTE_ALIGNED and
USE_STACK_LISP_OBJECTS, not on a laundry list.
(local_string_init, local_vector_init): New decls.
(union Aligned_Cons): New type.
(scoped_cons): Use it.  Give up on the char trick, as it's a too
much of a maintenance hassle; if someone wants this speedup
they'll just need to convince their compiler to align properly.
Conversely, use the speedup if struct Lisp_Cons happens to
be aligned even without a directive.  Better yet, help it along
by using union Aligned_Cons rather than struct Lisp_Cons.
(pointer_valid_for_lisp_object): Remove.  This check is not
necessary, since make_lisp_ptr is already doing it.  All uses removed.
(local_vector_init, local_string_init): Move to alloc.c.
(build_local_vector): Remove this awkward macro, replacing with ...
(make_local_vector): New macro, which acts more like a function.
Use statement expressions and use __COUNTER__ to avoid macro
capture.  Fall back on functions if these features are not supported.
(build_local_string, make_local_string): Likewise.
---
 ChangeLog     |   6 ++
 configure.ac  |  27 ++++++
 src/ChangeLog |  27 ++++++
 src/alloc.c   |  42 ++++++++++
 src/lisp.h    | 225 ++++++++++++++++++++++----------------------------
 5 files changed, 201 insertions(+), 126 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 523d4724e09..aa7c6405bcf 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2014-09-10  Paul Eggert  <eggert@cs.ucla.edu>
+
+	Improve the experimental local and scoped allocation.
+	* configure.ac (HAVE_STRUCT_ATTRIBUTE_ALIGNED)
+	(HAVE_STATEMENT_EXPRESSIONS): New configure-time checks.
+
 2014-09-07  Paul Eggert  <eggert@cs.ucla.edu>
 
 	Expand @AM_DEFAULT_VERBOSITY@ even if Automake is old (Bug#18415).
diff --git a/configure.ac b/configure.ac
index 6bfa8cc4ad2..93487246f29 100644
--- a/configure.ac
+++ b/configure.ac
@@ -4822,6 +4822,33 @@ else
 fi
 AC_SUBST(LIBXMENU)
 
+AC_CACHE_CHECK([for struct alignment],
+  [emacs_cv_struct_alignment],
+  [AC_COMPILE_IFELSE(
+     [AC_LANG_PROGRAM([[#include <stddef.h>
+     		        struct __attribute__ ((aligned (8))) s { char c; };
+     			struct t { char c; struct s s; };
+			char verify[offsetof (struct t, s) == 8 ? 1 : -1];
+		      ]])],
+     [emacs_cv_struct_alignment=yes],
+     [emacs_cv_struct_alignment=no])])
+if test "$emacs_cv_struct_alignment" = yes; then
+  AC_DEFINE([HAVE_STRUCT_ATTRIBUTE_ALIGNED], 1,
+    [Define to 1 if 'struct __attribute__ ((aligned (N)))' aligns the
+     structure to an N-byte boundary.])
+fi
+
+AC_CACHE_CHECK([for statement expressions],
+  [emacs_cv_statement_expressions],
+  [AC_COMPILE_IFELSE(
+     [AC_LANG_PROGRAM([], [[return ({ int x = 5; x-x; });]])],
+     [emacs_cv_statement_expressions=yes],
+     [emacs_cv_statement_expressions=no])])
+if test "$emacs_cv_statement_expressions" = yes; then
+  AC_DEFINE([HAVE_STATEMENT_EXPRESSIONS], 1,
+    [Define to 1 if statement expressions work.])
+fi
+
 if test "${GNU_MALLOC}" = "yes" ; then
   AC_DEFINE(GNU_MALLOC, 1,
 	    [Define to 1 if you want to use the GNU memory allocator.])
diff --git a/src/ChangeLog b/src/ChangeLog
index b94ac53051a..b98d4eef355 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,30 @@
+2014-09-10  Paul Eggert  <eggert@cs.ucla.edu>
+
+	Improve the experimental local and scoped allocation.
+	* alloc.c (local_string_init, local_vector_init):
+	New functions, defined if USE_LOCAL_ALLOCATORS.
+	Mostly, these are moved here from lisp.h, as it's not
+	clear it's worth making them inline.
+	* lisp.h (USE_STACK_LISP_OBJECTS): Default to false.
+	(GCALIGNED): Depend on HAVE_STRUCT_ATTRIBUTE_ALIGNED and
+	USE_STACK_LISP_OBJECTS, not on a laundry list.
+	(local_string_init, local_vector_init): New decls.
+	(union Aligned_Cons): New type.
+	(scoped_cons): Use it.  Give up on the char trick, as it's a too
+	much of a maintenance hassle; if someone wants this speedup
+	they'll just need to convince their compiler to align properly.
+	Conversely, use the speedup if struct Lisp_Cons happens to
+	be aligned even without a directive.  Better yet, help it along
+	by using union Aligned_Cons rather than struct Lisp_Cons.
+	(pointer_valid_for_lisp_object): Remove.  This check is not
+	necessary, since make_lisp_ptr is already doing it.  All uses removed.
+	(local_vector_init, local_string_init): Move to alloc.c.
+	(build_local_vector): Remove this awkward macro, replacing with ...
+	(make_local_vector): New macro, which acts more like a function.
+	Use statement expressions and use __COUNTER__ to avoid macro
+	capture.  Fall back on functions if these features are not supported.
+	(build_local_string, make_local_string): Likewise.
+
 2014-09-09  Dmitry Antipov  <dmantipov@yandex.ru>
 
 	* xterm.c (x_term_init): Consolidate duplicated code.
diff --git a/src/alloc.c b/src/alloc.c
index 5c7ce31cad8..714827f6ae3 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2226,6 +2226,32 @@ make_string (const char *contents, ptrdiff_t nbytes)
   return val;
 }
 
+#ifdef USE_LOCAL_ALLOCATORS
+
+/* Initialize the string S from DATA and SIZE.  S must be followed by
+   SIZE + 1 bytes of memory that can be used.  Return S tagged as a
+   Lisp object.  */
+
+Lisp_Object
+local_string_init (struct Lisp_String *s, char const *data, ptrdiff_t size)
+{
+  unsigned char *data_copy = (unsigned char *) (s + 1);
+  parse_str_as_multibyte ((unsigned char const *) data,
+			  size, &s->size, &s->size_byte);
+  if (size == s->size || size != s->size_byte)
+    {
+      s->size = size;
+      s->size_byte = -1;
+    }
+  s->intervals = NULL;
+  s->data = data_copy;
+  memcpy (data_copy, data, size);
+  data_copy[size] = '\0';
+  return make_lisp_ptr (s, Lisp_String);
+}
+
+#endif
+
 
 /* Make an unibyte string from LENGTH bytes at CONTENTS.  */
 
@@ -3288,6 +3314,22 @@ See also the function `vector'.  */)
   return vector;
 }
 
+#ifdef USE_LOCAL_ALLOCATORS
+
+/* Initialize V with LENGTH objects each with value INIT,
+   and return it tagged as a Lisp Object.  */
+
+INLINE Lisp_Object
+local_vector_init (struct Lisp_Vector *v, ptrdiff_t length, Lisp_Object init)
+{
+  v->header.size = length;
+  for (ptrdiff_t i = 0; i < length; i++)
+    v->contents[i] = init;
+  return make_lisp_ptr (v, Lisp_Vectorlike);
+}
+
+#endif
+
 
 DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
        doc: /* Return a newly created vector with specified arguments as elements.
diff --git a/src/lisp.h b/src/lisp.h
index cbb4c30bea1..3c7eb44b36d 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -298,12 +298,14 @@ error !;
 # endif
 #endif
 
-/* Stolen from gnulib.  */
-#if (__GNUC__ || __HP_cc || __HP_aCC || __IBMC__	\
-     || __IBMCPP__ || __ICC || 0x5110 <= __SUNPRO_C)
-#define GCALIGNED __attribute__ ((aligned (GCALIGNMENT)))
+#ifndef USE_STACK_LISP_OBJECTS
+# define USE_STACK_LISP_OBJECTS false
+#endif
+
+#if defined HAVE_STRUCT_ATTRIBUTE_ALIGNED && USE_STACK_LISP_OBJECTS
+# define GCALIGNED __attribute__ ((aligned (GCALIGNMENT)))
 #else
-#define GCALIGNED /* empty */
+# define GCALIGNED /* empty */
 #endif
 
 /* Some operations are so commonly executed that they are implemented
@@ -3685,6 +3687,8 @@ 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);
@@ -3773,6 +3777,8 @@ 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;
@@ -4546,142 +4552,109 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
       memory_full (SIZE_MAX);				       \
   } while (false)
 
-/* This feature is experimental and requires very careful debugging.
-   Brave user should compile with CPPFLAGS='-DUSE_STACK_LISP_OBJECTS'
-   to get into the game.  */
-
-#ifdef USE_STACK_LISP_OBJECTS
-
-/* Use the following functions to allocate temporary (function-
-   or block-scoped) conses, vectors, and strings.  These objects
-   are not managed by GC, and passing them out of their scope
-   most likely causes an immediate crash at next GC.  */
 
-#if (__GNUC__ || __HP_cc || __HP_aCC || __IBMC__	\
-     || __IBMCPP__ || __ICC || 0x5110 <= __SUNPRO_C)
+/* 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.
 
-/* Allocate temporary block-scoped cons.  This version assumes
-   that stack-allocated Lisp_Cons is always aligned properly.  */
-
-#define scoped_cons(car, cdr)						\
-  make_lisp_ptr (&((struct Lisp_Cons) { car, { cdr } }), Lisp_Cons)
-
-#else /* not __GNUC__ etc... */
+   This feature is experimental and requires careful debugging.
+   Brave users can compile with CPPFLAGS='-DUSE_STACK_LISP_OBJECTS'
+   to get into the game.  */
 
-/* Helper function for an alternate scoped cons, see below.  */				     
+/* A struct Lisp_Cons inside a union that is no larger and may be
+   better-aligned.  */
 
-INLINE Lisp_Object
-scoped_cons_init (void *ptr, Lisp_Object x, Lisp_Object y)
+union Aligned_Cons
 {
-  struct Lisp_Cons *c = (struct Lisp_Cons *)
-    (((uintptr_t) ptr + (GCALIGNMENT - 1)) & ~(GCALIGNMENT - 1));
-  c->car = x;
-  c->u.cdr = y;
-  return make_lisp_ptr (c, Lisp_Cons);
-}
+  struct Lisp_Cons s;
+  double d; intmax_t i; void *p;
+};
+verify (sizeof (struct Lisp_Cons) == sizeof (union Aligned_Cons));
 
-/* This version uses explicit alignment.  */
+/* Allocate a block-scoped cons.  */
 
 #define scoped_cons(car, cdr)						\
-  scoped_cons_init ((char[sizeof (struct Lisp_Cons)			\
-			  + (GCALIGNMENT - 1)]) {}, (car), (cdr))
-
-#endif /* __GNUC__ etc... */
+   ((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.  */
 
-#define scoped_list1(x) scoped_cons (x, Qnil)
-#define scoped_list2(x, y) scoped_cons (x, scoped_cons (y, Qnil))
-#define scoped_list3(x, y, z)					\
-  scoped_cons (x, scoped_cons (y, scoped_cons (z, Qnil)))
-
-/* True if Lisp_Object may be placed at P.  Used only
-   under ENABLE_CHECKING and optimized away otherwise.  */
-
-INLINE bool
-pointer_valid_for_lisp_object (void *p)
-{
-  uintptr_t v = (uintptr_t) p;
-  return !(USE_LSB_TAG ? (v & ~VALMASK) : v >> VALBITS);
-}
-
-/* Helper function for build_local_vector, see below.  */
-
-INLINE Lisp_Object
-local_vector_init (uintptr_t addr, ptrdiff_t length, Lisp_Object init)
-{
-  ptrdiff_t i;
-  struct Lisp_Vector *v = (struct Lisp_Vector *) addr;
-
-  eassert (pointer_valid_for_lisp_object (v));
-  v->header.size = length;
-  for (i = 0; i < length; i++)
-    v->contents[i] = init;
-  return make_lisp_ptr (v, Lisp_Vectorlike);
-}
-
-/* If size permits, create temporary function-scoped vector OBJ of
-   length SIZE, with each element being INIT.  Otherwise create
-   regular GC-managed vector.  */
-
-#define build_local_vector(obj, size, init)				\
-  (MAX_ALLOCA < (size) * word_size + header_size			\
-   ? obj = Fmake_vector (make_number (size), (init))			\
-   : (obj = XIL ((uintptr_t) alloca					\
-		 ((size) * word_size + header_size)),			\
-      obj = local_vector_init ((uintptr_t) XLI (obj), (size), (init))))
-
-/* Helper function for make_local_string, see below.  */
-
-INLINE Lisp_Object
-local_string_init (uintptr_t addr, const char *data, ptrdiff_t size)
-{
-  ptrdiff_t nchars, nbytes;
-  struct Lisp_String *s = (struct Lisp_String *) addr;
-
-  eassert (pointer_valid_for_lisp_object (s));
-  parse_str_as_multibyte ((const unsigned char *) data,
-			  size, &nchars, &nbytes);
-  s->data = (unsigned char *) (addr + sizeof *s);
-  s->intervals = NULL;
-  memcpy (s->data, data, size);
-  s->data[size] = '\0';
-  if (size == nchars || size != nbytes)
-    s->size = size, s->size_byte = -1;
-  else
-    s->size = nchars, s->size_byte = nbytes;
-  return make_lisp_ptr (s, Lisp_String);
-}
-
-/* If size permits, create temporary function-scoped string OBJ
-   with contents DATA of length NBYTES.  Otherwise create regular
-   GC-managed string.  */
-
-#define make_local_string(obj, data, nbytes)				\
-  (MAX_ALLOCA < (nbytes) + sizeof (struct Lisp_String)			\
-   ? obj = make_string ((data), (nbytes))				\
-   : (obj = XIL ((uintptr_t) alloca					\
-		 ((nbytes) + sizeof (struct Lisp_String))),		\
-      obj = local_string_init ((uintptr_t) XLI (obj), data, nbytes)))
-
-/* We want an interface similar to make_string and build_string, right?  */
+#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
 
-#define build_local_string(obj, data)		\
-  make_local_string (obj, data, strlen (data))
+#if USE_STACK_LISP_OBJECTS && HAVE_STATEMENT_EXPRESSIONS && defined __COUNTER__
+
+# define USE_LOCAL_ALLOCATORS
+
+/* Return a function-scoped vector of length SIZE, with each element
+   being INIT.  */
+
+# define make_local_vector(size, init) \
+    make_local_vector_n (size, init, __COUNTER__)
+# define make_local_vector_n(size_arg, init_arg, n)			\
+    ({									\
+       ptrdiff_t size##n = size_arg;					\
+       Lisp_Object init##n = init_arg;					\
+       Lisp_Object vec##n;						\
+       if (size##n <= (MAX_ALLOCA - header_size) / word_size)		\
+	 {								\
+	   void *ptr##n = alloca (size##n * word_size + header_size);	\
+	   vec##n = local_vector_init (ptr##n, size##n, init##n);	\
+	 }								\
+       else								\
+	 vec##n = Fmake_vector (make_number (size##n), init##n);	\
+       vec##n;								\
+    })
+
+/* Return a function-scoped string with contents DATA and length NBYTES.  */
+
+# define make_local_string(data, nbytes) \
+    make_local_string (data, nbytes, __COUNTER__)
+# define make_local_string_n(data_arg, nbytes_arg, n)			\
+    ({									\
+       char const *data##n = data_arg;					\
+       ptrdiff_t nbytes##n = nbytes_arg;				\
+       Lisp_Object string##n;						\
+       if (nbytes##n <= MAX_ALLOCA - sizeof (struct Lisp_String) - 1)	\
+	 {								\
+	   struct Lisp_String *ptr##n					\
+	     = alloca (sizeof (struct Lisp_String) + 1 + nbytes);	\
+	   string##n = local_string_init (ptr##n, data##n, nbytes##n);	\
+	 }								\
+       else								\
+	 string##n = make_string (data##n, nbytes##n);			\
+       string##n;							\
+    })
+
+/* Return a function-scoped string with contents DATA.  */
+
+# define build_local_string(data) build_local_string_n (data, __COUNTER__)
+# define build_local_string_n(data_arg, n)			\
+    ({								\
+       char const *data##n = data_arg;				\
+       make_local_string (data##n, strlen (data##n));		\
+    })
 
-#else /* not USE_STACK_LISP_OBJECTS */
+#else
 
-#define scoped_cons(x, y) Fcons ((x), (y))
-#define scoped_list1(x) list1 (x)
-#define scoped_list2(x, y) list2 ((x), (y))
-#define scoped_list3(x, y, z) list3 ((x), (y), (z))
-#define build_local_vector(obj, size, init)		\
-  (obj = Fmake_vector (make_number ((size), (init))))
-#define make_local_string(obj, data, nbytes)	\
-  (obj = make_string ((data), (nbytes)))
-#define build_local_string(obj, data) (obj = build_string (data))
+/* Safer but slower implementations.  */
+# 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)
+#endif
 
-#endif /* USE_STACK_LISP_OBJECTS */
 
 /* Loop over all tails of a list, checking for cycles.
    FIXME: Make tortoise and n internal declarations.
-- 
2.39.5