Add macros to allocate temporary Lisp objects with alloca.

Respect MAX_ALLOCA and fall back to regular GC for large objects.
* character.h (parse_str_as_multibyte): Move prototype to ...
* lisp.h (parse_str_as_multibyte): ... here.
(struct Lisp_Cons): Add GCALIGNED attribute if supported.
(scoped_cons, scoped_list2, build_local_vector, build_local_string):
New macros.
(scoped_cons_init, pointer_valid_for_lisp_object, local_vector_init)
(local_string_init): New functions.
* alloc.c (verify_alloca) [ENABLE_CHECKING]: New function.
(init_alloc_once): Call it.

4 files changed, 158 insertions, 5 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index a01c753161c..d1e8314b172 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -5,6 +5,18 @@
         (x_delete_terminal): Do not close X connection fd (Bug#18403).
         Add eassert and mark dpyinfo as dead only if it was alive.
 
+        Add macros to allocate temporary Lisp objects with alloca.
+        Respect MAX_ALLOCA and fall back to regular GC for large objects.
+        * character.h (parse_str_as_multibyte): Move prototype to ...
+        * lisp.h (parse_str_as_multibyte): ... here.
+        (struct Lisp_Cons): Add GCALIGNED attribute if supported.
+        (scoped_cons, scoped_list2, build_local_vector, build_local_string):
+        New macros.
+        (scoped_cons_init, pointer_valid_for_lisp_object, local_vector_init)
+        (local_string_init): New functions.
+        * alloc.c (verify_alloca) [ENABLE_CHECKING]: New function.
+        (init_alloc_once): Call it.
+
 2014-09-08  Eli Zaretskii  <eliz@gnu.org>
 
         * dispnew.c (prepare_desired_row): When MODE_LINE_P is zero,
diff --git a/src/alloc.c b/src/alloc.c
index 31b0644c285..13043d6d9d7 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -7117,8 +7117,29 @@ die (const char *msg, const char *file, int line)
            file, line, msg);
   terminate_due_to_signal (SIGABRT, INT_MAX);
 }
-#endif
-
+
+/* Stress alloca with inconveniently sized requests and check
+   whether all allocated areas may be used for Lisp_Object.  */
+
+NO_INLINE static void
+verify_alloca (void)
+{
+  int i;
+  enum { ALLOCA_CHECK_MAX = 256 };
+  /* Start from size of the smallest Lisp object.  */
+  for (i = sizeof (struct Lisp_Cons); i <= ALLOCA_CHECK_MAX; i++)
+    {
+      char *ptr = alloca (i);
+      eassert (pointer_valid_for_lisp_object (ptr));
+    }
+}
+
+#else /* not ENABLE_CHECKING */
+
+#define verify_alloca() ((void) 0)
+
+#endif /* ENABLE_CHECKING */
+
 /* Initialization.  */
 
 void
@@ -7128,6 +7149,8 @@ init_alloc_once (void)
   purebeg = PUREBEG;
   pure_size = PURESIZE;
 
+  verify_alloca ();
+
 #if GC_MARK_STACK || defined GC_MALLOC_CHECK
   mem_init ();
   Vdead = make_pure_string ("DEAD", 4, 4, 0);
diff --git a/src/character.h b/src/character.h
index 66cd4e47ef8..624f4fff3f0 100644
--- a/src/character.h
+++ b/src/character.h
@@ -644,8 +644,6 @@ extern int string_char (const unsigned char *,
                         const unsigned char **, int *);
 
 extern int translate_char (Lisp_Object, int c);
-extern void parse_str_as_multibyte (const unsigned char *,
-                                    ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
 extern ptrdiff_t count_size_as_multibyte (const unsigned char *, ptrdiff_t);
 extern ptrdiff_t str_as_multibyte (unsigned char *, ptrdiff_t, ptrdiff_t,
                                    ptrdiff_t *);
diff --git a/src/lisp.h b/src/lisp.h
index 15c459c9fdb..a89e80729cd 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -298,6 +298,13 @@ error !;
 # endif
 #endif
 
+/* Stolen from gnulib.  */
+#if (__GNUC__ || __HP_cc || __HP_aCC || __IBMC__        \
+     || __IBMCPP__ || __ICC || 0x5110 <= __SUNPRO_C)
+#define GCALIGNED __attribute__ ((aligned (GCALIGNMENT)))
+#else
+#define GCALIGNED /* empty */
+#endif
 
 /* Some operations are so commonly executed that they are implemented
    as macros, not functions, because otherwise runtime performance would
@@ -1016,7 +1023,7 @@ LISP_MACRO_DEFUN_VOID (CHECK_TYPE,
 
 typedef struct interval *INTERVAL;
 
-struct Lisp_Cons
+struct GCALIGNED Lisp_Cons
   {
     /* Car of this cons cell.  */
     Lisp_Object car;
@@ -3622,6 +3629,10 @@ extern void syms_of_xsettings (void);
 /* Defined in vm-limit.c.  */
 extern void memory_warnings (void *, void (*warnfun) (const char *));
 
+/* Defined in character.c.  */
+extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t,
+                                    ptrdiff_t *, ptrdiff_t *);
+
 /* Defined in alloc.c.  */
 extern void check_pure_size (void);
 extern void free_misc (Lisp_Object);
@@ -4535,6 +4546,115 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
       memory_full (SIZE_MAX);                                  \
   } while (false)
 
+/* 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)
+
+/* 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... */
+
+/* Helper function for an alternate scoped cons, see below.  */                              
+
+INLINE Lisp_Object
+scoped_cons_init (void *ptr, Lisp_Object x, Lisp_Object y)
+{
+  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);
+}
+
+/* This version uses explicit alignment.  */
+
+#define scoped_cons(car, cdr)                                           \
+  scoped_cons_init ((char[sizeof (struct Lisp_Cons)                     \
+                          + (GCALIGNMENT - 1)]) {}, (car), (cdr))
+
+#endif /* __GNUC__ etc... */
+
+/* Convenient utility macro similar to list2.  */
+
+#define scoped_list2(x, y) scoped_cons (x, scoped_cons (y, 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 build_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 build_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)))
+
 /* Loop over all tails of a list, checking for cycles.
    FIXME: Make tortoise and n internal declarations.
    FIXME: Unroll the loop body so we don't need `n'.  */