=== modified file 'src/alloc.c' --- src/alloc.c 2014-08-29 07:29:47 +0000 +++ src/alloc.c 2014-09-05 02:43:56 +0000 @@ -7118,8 +7118,29 @@ 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 @@ -7129,6 +7150,8 @@ 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); === modified file 'src/character.h' --- src/character.h 2014-07-08 07:17:04 +0000 +++ src/character.h 2014-09-04 16:18:48 +0000 @@ -644,8 +644,6 @@ 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 *); === modified file 'src/lisp.h' --- src/lisp.h 2014-09-02 18:05:00 +0000 +++ src/lisp.h 2014-09-05 02:45:18 +0000 @@ -298,6 +298,13 @@ # 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 @@ typedef struct interval *INTERVAL; -struct Lisp_Cons +struct GCALIGNED Lisp_Cons { /* Car of this cons cell. */ Lisp_Object car; @@ -3622,6 +3629,10 @@ /* 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); @@ -4533,6 +4544,111 @@ 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 + causes an immediate crash in 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... */ + +/* 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'. */