From c7dfea947eba1980fe3a23ad13f04dd40c6c0d68 Mon Sep 17 00:00:00 2001 From: Dmitry Antipov Date: Tue, 9 Sep 2014 07:44:06 +0400 Subject: [PATCH] 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. --- src/ChangeLog | 12 +++++ src/alloc.c | 27 ++++++++++- src/character.h | 2 - src/lisp.h | 122 +++++++++++++++++++++++++++++++++++++++++++++++- 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 * 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'. */ -- 2.39.5