X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/df32db2f5f3dcad4b2b16fd52e51e1c7bd846609..f3aaca3552ba961d13cd1ee935c1c6b075f2398a:/src/alloc.c diff --git a/src/alloc.c b/src/alloc.c index 23ddd83d7d..6bc1b8afe1 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1,6 +1,6 @@ /* Storage allocation and gc for GNU Emacs Lisp interpreter. -Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2015 Free Software +Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2016 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -92,6 +92,18 @@ static bool valgrind_p; #include "w32heap.h" /* for sbrk */ #endif +#if defined DOUG_LEA_MALLOC || defined GNU_LINUX +/* The address where the heap starts. */ +void * +my_heap_start (void) +{ + static void *start; + if (! start) + start = sbrk (0); + return start; +} +#endif + #ifdef DOUG_LEA_MALLOC #include @@ -101,7 +113,69 @@ static bool valgrind_p; #define MMAP_MAX_AREAS 100000000 -#endif /* not DOUG_LEA_MALLOC */ +/* A pointer to the memory allocated that copies that static data + inside glibc's malloc. */ +static void *malloc_state_ptr; + +/* Get and free this pointer; useful around unexec. */ +void +alloc_unexec_pre (void) +{ + malloc_state_ptr = malloc_get_state (); +} +void +alloc_unexec_post (void) +{ + free (malloc_state_ptr); +} + +/* Restore the dumped malloc state. Because malloc can be invoked + even before main (e.g. by the dynamic linker), the dumped malloc + state must be restored as early as possible using this special hook. */ +static void +malloc_initialize_hook (void) +{ + static bool malloc_using_checking; + + if (! initialized) + { + my_heap_start (); + malloc_using_checking = getenv ("MALLOC_CHECK_") != NULL; + } + else + { + if (!malloc_using_checking) + { + /* Work around a bug in glibc's malloc. MALLOC_CHECK_ must be + ignored if the heap to be restored was constructed without + malloc checking. Can't use unsetenv, since that calls malloc. */ + char **p = environ; + if (p) + for (; *p; p++) + if (strncmp (*p, "MALLOC_CHECK_=", 14) == 0) + { + do + *p = p[1]; + while (*++p); + + break; + } + } + + malloc_set_state (malloc_state_ptr); +# ifndef XMALLOC_OVERRUN_CHECK + alloc_unexec_post (); +# endif + } +} + +# ifndef __MALLOC_HOOK_VOLATILE +# define __MALLOC_HOOK_VOLATILE +# endif +voidfuncptr __MALLOC_HOOK_VOLATILE __malloc_initialize_hook + = malloc_initialize_hook; + +#endif /* Mark, unmark, query mark bit of a Lisp string. S must be a pointer to a struct Lisp_String. */ @@ -728,8 +802,10 @@ malloc_unblock_input (void) malloc_probe (size); \ } while (0) +static void *lmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); +static void *lrealloc (void *, size_t); -/* Like malloc but check for no memory and block interrupt input.. */ +/* Like malloc but check for no memory and block interrupt input. */ void * xmalloc (size_t size) @@ -737,7 +813,7 @@ xmalloc (size_t size) void *val; MALLOC_BLOCK_INPUT; - val = malloc (size); + val = lmalloc (size); MALLOC_UNBLOCK_INPUT; if (!val && size) @@ -754,7 +830,7 @@ xzalloc (size_t size) void *val; MALLOC_BLOCK_INPUT; - val = malloc (size); + val = lmalloc (size); MALLOC_UNBLOCK_INPUT; if (!val && size) @@ -775,9 +851,9 @@ xrealloc (void *block, size_t size) /* We must call malloc explicitly when BLOCK is 0, since some reallocs don't do this. */ if (! block) - val = malloc (size); + val = lmalloc (size); else - val = realloc (block, size); + val = lrealloc (block, size); MALLOC_UNBLOCK_INPUT; if (!val && size) @@ -979,7 +1055,7 @@ lisp_malloc (size_t nbytes, enum mem_type type) allocated_mem_type = type; #endif - val = malloc (nbytes); + val = lmalloc (nbytes); #if ! USE_LSB_TAG /* If the memory just allocated cannot be addressed thru a Lisp @@ -1031,15 +1107,18 @@ lisp_free (void *block) /* Use aligned_alloc if it or a simple substitute is available. Address sanitization breaks aligned allocation, as of gcc 4.8.2 and - clang 3.3 anyway. */ + clang 3.3 anyway. Aligned allocation is incompatible with + unexmacosx.c, so don't use it on Darwin. */ -#if ! ADDRESS_SANITIZER +#if ! ADDRESS_SANITIZER && !defined DARWIN_OS # if !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC # define USE_ALIGNED_ALLOC 1 +# ifndef HAVE_ALIGNED_ALLOC /* Defined in gmalloc.c. */ void *aligned_alloc (size_t, size_t); +# endif # elif defined HYBRID_MALLOC -# if defined ALIGNED_ALLOC || defined HAVE_POSIX_MEMALIGN +# if defined HAVE_ALIGNED_ALLOC || defined HAVE_POSIX_MEMALIGN # define USE_ALIGNED_ALLOC 1 # define aligned_alloc hybrid_aligned_alloc /* Defined in gmalloc.c. */ @@ -1279,6 +1358,84 @@ lisp_align_free (void *block) MALLOC_UNBLOCK_INPUT; } +#if !defined __GNUC__ && !defined __alignof__ +# define __alignof__(type) alignof (type) +#endif + +/* True if malloc returns a multiple of GCALIGNMENT. In practice this + holds if __alignof__ (max_align_t) is a multiple. Use __alignof__ + if available, as otherwise this check would fail with GCC x86. + This is a macro, not an enum constant, for portability to HP-UX + 10.20 cc and AIX 3.2.5 xlc. */ +#define MALLOC_IS_GC_ALIGNED (__alignof__ (max_align_t) % GCALIGNMENT == 0) + +/* True if P is suitably aligned for SIZE, where Lisp alignment may be + needed if SIZE is Lisp-aligned. */ + +static bool +laligned (void *p, size_t size) +{ + return (MALLOC_IS_GC_ALIGNED || (intptr_t) p % GCALIGNMENT == 0 + || size % GCALIGNMENT != 0); +} + +/* Like malloc and realloc except that if SIZE is Lisp-aligned, make + sure the result is too, if necessary by reallocating (typically + with larger and larger sizes) until the allocator returns a + Lisp-aligned pointer. Code that needs to allocate C heap memory + for a Lisp object should use one of these functions to obtain a + pointer P; that way, if T is an enum Lisp_Type value and L == + make_lisp_ptr (P, T), then XPNTR (L) == P and XTYPE (L) == T. + + On typical modern platforms these functions' loops do not iterate. + On now-rare (and perhaps nonexistent) platforms, the loops in + theory could repeat forever. If an infinite loop is possible on a + platform, a build would surely loop and the builder can then send + us a bug report. Adding a counter to try to detect any such loop + would complicate the code (and possibly introduce bugs, in code + that's never really exercised) for little benefit. */ + +static void * +lmalloc (size_t size) +{ +#if USE_ALIGNED_ALLOC + if (! MALLOC_IS_GC_ALIGNED) + return aligned_alloc (GCALIGNMENT, size); +#endif + + void *p; + while (true) + { + p = malloc (size); + if (laligned (p, size)) + break; + free (p); + size_t bigger; + if (! INT_ADD_WRAPV (size, GCALIGNMENT, &bigger)) + size = bigger; + } + + eassert ((intptr_t) p % GCALIGNMENT == 0); + return p; +} + +static void * +lrealloc (void *p, size_t size) +{ + while (true) + { + p = realloc (p, size); + if (laligned (p, size)) + break; + size_t bigger; + if (! INT_ADD_WRAPV (size, GCALIGNMENT, &bigger)) + size = bigger; + } + + eassert ((intptr_t) p % GCALIGNMENT == 0); + return p; +} + /*********************************************************************** Interval Allocation @@ -2119,8 +2276,11 @@ INIT must be an integer that represents a character. */) { nbytes = XINT (length); val = make_uninit_string (nbytes); - memset (SDATA (val), c, nbytes); - SDATA (val)[nbytes] = 0; + if (nbytes) + { + memset (SDATA (val), c, nbytes); + SDATA (val)[nbytes] = 0; + } } else { @@ -2145,7 +2305,8 @@ INIT must be an integer that represents a character. */) memcpy (p, beg, len); } } - *p = 0; + if (nbytes) + *p = 0; } return val; @@ -3188,7 +3349,8 @@ allocate_vector (EMACS_INT len) if (min ((nbytes_max - header_size) / word_size, MOST_POSITIVE_FIXNUM) < len) memory_full (SIZE_MAX); v = allocate_vectorlike (len); - v->header.size = len; + if (len) + v->header.size = len; return v; } @@ -3727,7 +3889,7 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args) #ifdef HAVE_MODULES /* Create a new module user ptr object. */ Lisp_Object -make_user_ptr (void (*finalizer) (void*), void *p) +make_user_ptr (void (*finalizer) (void *), void *p) { Lisp_Object obj; struct Lisp_User_Ptr *uptr; @@ -4589,6 +4751,10 @@ maybe_lisp_pointer (void *p) return (uintptr_t) p % GCALIGNMENT == 0; } +#ifndef HAVE_MODULES +enum { HAVE_MODULES = false }; +#endif + /* If P points to Lisp data, mark that as live if it isn't already marked. */ @@ -4602,8 +4768,17 @@ mark_maybe_pointer (void *p) VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p)); #endif - if (!maybe_lisp_pointer (p)) - return; + if (sizeof (Lisp_Object) == sizeof (void *) || !HAVE_MODULES) + { + if (!maybe_lisp_pointer (p)) + return; + } + else + { + /* For the wide-int case, also mark emacs_value tagged pointers, + which can be generated by emacs-module.c's value_to_lisp. */ + p = (void *) ((uintptr_t) p & ~(GCALIGNMENT - 1)); + } m = mem_find (p); if (m != MEM_NIL) @@ -4680,8 +4855,7 @@ mark_maybe_pointer (void *p) static void ATTRIBUTE_NO_SANITIZE_ADDRESS mark_memory (void *start, void *end) { - void **pp; - int i; + char *pp; /* Make START the pointer to the start of the memory region, if it isn't already. */ @@ -4692,6 +4866,8 @@ mark_memory (void *start, void *end) end = tem; } + eassert (((uintptr_t) start) % GC_POINTER_ALIGNMENT == 0); + /* Mark Lisp data pointed to. This is necessary because, in some situations, the C compiler optimizes Lisp objects away, so that only a pointer to them remains. Example: @@ -4710,13 +4886,11 @@ mark_memory (void *start, void *end) away. The only reference to the life string is through the pointer `s'. */ - for (pp = start; (void *) pp < end; pp++) - for (i = 0; i < sizeof *pp; i += GC_POINTER_ALIGNMENT) - { - void *p = *(void **) ((char *) pp + i); - mark_maybe_pointer (p); - mark_maybe_object (XIL ((intptr_t) p)); - } + for (pp = start; (void *) pp < end; pp += GC_POINTER_ALIGNMENT) + { + mark_maybe_pointer (*(void **) pp); + mark_maybe_object (*(Lisp_Object *) pp); + } } #if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS @@ -5346,7 +5520,10 @@ compact_font_cache_entry (Lisp_Object entry) /* Consider OBJ if it is (font-spec . [font-entity font-entity ...]). */ if (CONSP (obj) && GC_FONT_SPEC_P (XCAR (obj)) && !VECTOR_MARKED_P (GC_XFONT_SPEC (XCAR (obj))) - && VECTORP (XCDR (obj))) + /* Don't use VECTORP here, as that calls ASIZE, which could + hit assertion violation during GC. */ + && (VECTORLIKEP (XCDR (obj)) + && ! (gc_asize (XCDR (obj)) & PSEUDOVECTOR_FLAG))) { ptrdiff_t i, size = gc_asize (XCDR (obj)); Lisp_Object obj_cdr = XCDR (obj); @@ -5505,9 +5682,16 @@ garbage_collect_1 (void *end) don't let that cause a recursive GC. */ consing_since_gc = 0; - /* Save what's currently displayed in the echo area. */ - message_p = push_message (); - record_unwind_protect_void (pop_message_unwind); + /* Save what's currently displayed in the echo area. Don't do that + if we are GC'ing because we've run out of memory, since + push_message will cons, and we might have no memory for that. */ + if (NILP (Vmemory_full)) + { + message_p = push_message (); + record_unwind_protect_void (pop_message_unwind); + } + else + message_p = false; /* Save a copy of the contents of the stack, for debugging. */ #if MAX_SAVE_STACK > 0 @@ -5638,7 +5822,7 @@ garbage_collect_1 (void *end) } } - if (garbage_collection_messages) + if (garbage_collection_messages && NILP (Vmemory_full)) { if (message_p || minibuf_level > 0) restore_message ();