/* Storage allocation and gc for GNU Emacs Lisp interpreter.
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2013 Free Software
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2014 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
#if MAX_SAVE_STACK > 0
static char *stack_copy;
static ptrdiff_t stack_copy_size;
-#endif
+
+/* Copy to DEST a block of memory from SRC of size SIZE bytes,
+ avoiding any address sanitization. */
+
+static void * ATTRIBUTE_NO_SANITIZE_ADDRESS
+no_sanitize_memcpy (void *dest, void const *src, size_t size)
+{
+ if (! ADDRESS_SANITIZER)
+ return memcpy (dest, src, size);
+ else
+ {
+ size_t i;
+ char *d = dest;
+ char const *s = src;
+ for (i = 0; i < size; i++)
+ d[i] = s[i];
+ return dest;
+ }
+}
+
+#endif /* MAX_SAVE_STACK > 0 */
static Lisp_Object Qconses;
static Lisp_Object Qsymbols;
/* The entry point is lisp_align_malloc which returns blocks of at most
BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */
-#if defined (HAVE_POSIX_MEMALIGN) && defined (SYSTEM_MALLOC)
-#define USE_POSIX_MEMALIGN 1
+/* 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. */
+
+#if ! ADDRESS_SANITIZER
+# if !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC
+# define USE_ALIGNED_ALLOC 1
+/* Defined in gmalloc.c. */
+void *aligned_alloc (size_t, size_t);
+# elif defined HAVE_ALIGNED_ALLOC
+# define USE_ALIGNED_ALLOC 1
+# elif defined HAVE_POSIX_MEMALIGN
+# define USE_ALIGNED_ALLOC 1
+static void *
+aligned_alloc (size_t alignment, size_t size)
+{
+ void *p;
+ return posix_memalign (&p, alignment, size) == 0 ? p : 0;
+}
+# endif
#endif
/* BLOCK_ALIGN has to be a power of 2. */
malloc a chance to minimize the amount of memory wasted to alignment.
It should be tuned to the particular malloc library used.
On glibc-2.3.2, malloc never tries to align, so a padding of 0 is best.
- posix_memalign on the other hand would ideally prefer a value of 4
+ aligned_alloc on the other hand would ideally prefer a value of 4
because otherwise, there's 1020 bytes wasted between each ablocks.
In Emacs, testing shows that those 1020 can most of the time be
efficiently used by malloc to place other objects, so a value of 0 can
struct ablock blocks[ABLOCKS_SIZE];
};
-/* Size of the block requested from malloc or posix_memalign. */
+/* Size of the block requested from malloc or aligned_alloc. */
#define ABLOCKS_BYTES (sizeof (struct ablocks) - BLOCK_PADDING)
#define ABLOCK_ABASE(block) \
#define ABLOCKS_BUSY(abase) ((abase)->blocks[0].abase)
/* Pointer to the (not necessarily aligned) malloc block. */
-#ifdef USE_POSIX_MEMALIGN
+#ifdef USE_ALIGNED_ALLOC
#define ABLOCKS_BASE(abase) (abase)
#else
#define ABLOCKS_BASE(abase) \
mallopt (M_MMAP_MAX, 0);
#endif
-#ifdef USE_POSIX_MEMALIGN
- {
- int err = posix_memalign (&base, BLOCK_ALIGN, ABLOCKS_BYTES);
- if (err)
- base = NULL;
- abase = base;
- }
+#ifdef USE_ALIGNED_ALLOC
+ abase = base = aligned_alloc (BLOCK_ALIGN, ABLOCKS_BYTES);
#else
base = malloc (ABLOCKS_BYTES);
abase = ALIGN (base, BLOCK_ALIGN);
return val;
}
-static EMACS_INT
-bool_vector_exact_payload_bytes (EMACS_INT nbits)
-{
- eassume (0 <= nbits);
- return (nbits + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR;
-}
-
-static EMACS_INT
-bool_vector_payload_bytes (EMACS_INT nbits)
-{
- EMACS_INT exact_needed_bytes = bool_vector_exact_payload_bytes (nbits);
+/* Fill A with 1 bits if INIT is non-nil, and with 0 bits otherwise.
+ Return A. */
- /* Always allocate at least one machine word of payload so that
- bool-vector operations in data.c don't need a special case
- for empty vectors. */
- return ROUNDUP (exact_needed_bytes + !exact_needed_bytes,
- sizeof (bits_word));
-}
-
-void
+Lisp_Object
bool_vector_fill (Lisp_Object a, Lisp_Object init)
{
EMACS_INT nbits = bool_vector_size (a);
{
unsigned char *data = bool_vector_uchar_data (a);
int pattern = NILP (init) ? 0 : (1 << BOOL_VECTOR_BITS_PER_CHAR) - 1;
- ptrdiff_t nbytes = ((nbits + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR);
+ ptrdiff_t nbytes = bool_vector_bytes (nbits);
int last_mask = ~ (~0 << ((nbits - 1) % BOOL_VECTOR_BITS_PER_CHAR + 1));
memset (data, pattern, nbytes - 1);
data[nbytes - 1] = pattern & last_mask;
}
+ return a;
}
-DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
- doc: /* Return a new bool-vector of length LENGTH, using INIT for each element.
-LENGTH must be a number. INIT matters only in whether it is t or nil. */)
- (Lisp_Object length, Lisp_Object init)
+/* Return a newly allocated, uninitialized bool vector of size NBITS. */
+
+Lisp_Object
+make_uninit_bool_vector (EMACS_INT nbits)
{
Lisp_Object val;
- struct Lisp_Bool_Vector *p;
- EMACS_INT exact_payload_bytes, total_payload_bytes, needed_elements;
-
- CHECK_NATNUM (length);
-
- exact_payload_bytes = bool_vector_exact_payload_bytes (XFASTINT (length));
- total_payload_bytes = bool_vector_payload_bytes (XFASTINT (length));
-
- needed_elements = ((bool_header_size - header_size + total_payload_bytes
- + word_size - 1)
- / word_size);
-
- p = (struct Lisp_Bool_Vector *) allocate_vector (needed_elements);
+ EMACS_INT words = bool_vector_words (nbits);
+ EMACS_INT word_bytes = words * sizeof (bits_word);
+ EMACS_INT needed_elements = ((bool_header_size - header_size + word_bytes
+ + word_size - 1)
+ / word_size);
+ struct Lisp_Bool_Vector *p
+ = (struct Lisp_Bool_Vector *) allocate_vector (needed_elements);
XSETVECTOR (val, p);
XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0);
-
- p->size = XFASTINT (length);
- bool_vector_fill (val, init);
+ p->size = nbits;
/* Clear padding at the end. */
- eassume (exact_payload_bytes <= total_payload_bytes);
- memset (bool_vector_uchar_data (val) + exact_payload_bytes,
- 0,
- total_payload_bytes - exact_payload_bytes);
+ if (words)
+ p->data[words - 1] = 0;
return val;
}
+DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
+ doc: /* Return a new bool-vector of length LENGTH, using INIT for each element.
+LENGTH must be a number. INIT matters only in whether it is t or nil. */)
+ (Lisp_Object length, Lisp_Object init)
+{
+ Lisp_Object val;
+
+ CHECK_NATNUM (length);
+ val = make_uninit_bool_vector (XFASTINT (length));
+ return bool_vector_fill (val, init);
+}
+
/* Make a string from NBYTES bytes at CONTENTS, and compute the number
of characters from the contents. This string may be unibyte or
vector_nbytes (struct Lisp_Vector *v)
{
ptrdiff_t size = v->header.size & ~ARRAY_MARK_FLAG;
+ ptrdiff_t nwords;
if (size & PSEUDOVECTOR_FLAG)
{
if (PSEUDOVECTOR_TYPEP (&v->header, PVEC_BOOL_VECTOR))
{
struct Lisp_Bool_Vector *bv = (struct Lisp_Bool_Vector *) v;
- ptrdiff_t payload_bytes = bool_vector_payload_bytes (bv->size);
- size = bool_header_size + payload_bytes;
+ ptrdiff_t word_bytes = (bool_vector_words (bv->size)
+ * sizeof (bits_word));
+ ptrdiff_t boolvec_bytes = bool_header_size + word_bytes;
+ verify (header_size <= bool_header_size);
+ nwords = (boolvec_bytes - header_size + word_size - 1) / word_size;
}
else
- size = (header_size
- + ((size & PSEUDOVECTOR_SIZE_MASK)
- + ((size & PSEUDOVECTOR_REST_MASK)
- >> PSEUDOVECTOR_SIZE_BITS)) * word_size);
+ nwords = ((size & PSEUDOVECTOR_SIZE_MASK)
+ + ((size & PSEUDOVECTOR_REST_MASK)
+ >> PSEUDOVECTOR_SIZE_BITS));
}
else
- size = header_size + size * word_size;
- return vroundup (size);
+ nwords = size;
+ return vroundup (header_size + word_size * nwords);
}
/* Release extra resources still in use by VECTOR, which may be any
if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT)
&& ((vector->header.size & PSEUDOVECTOR_SIZE_MASK)
== FONT_OBJECT_MAX))
- ((struct font *) vector)->driver->close ((struct font *) vector);
+ {
+ /* Attempt to catch subtle bugs like Bug#16140. */
+ eassert (valid_font_driver (((struct font *) vector)->driver));
+ ((struct font *) vector)->driver->close ((struct font *) vector);
+ }
}
/* Reclaim space used by unmarked vectors. */
void
make_byte_code (struct Lisp_Vector *v)
{
- /* Don't allow the global zero_vector to become a byte code object. */
- eassert(0 < v->header.size);
+ /* Don't allow the global zero_vector to become a byte code object. */
+ eassert (0 < v->header.size);
+
if (v->header.size > 1 && STRINGP (v->contents[1])
&& STRING_MULTIBYTE (v->contents[1]))
/* BYTECODE-STRING must have been produced by Emacs 20.2 or the
return val;
}
-#if defined HAVE_MENUS && ! (defined USE_X_TOOLKIT || defined USE_GTK)
+#if ! (defined USE_X_TOOLKIT || defined USE_GTK)
Lisp_Object
make_save_ptr_ptr (void *a, void *b)
{
void dump_zombies (void) EXTERNALLY_VISIBLE;
/* Array of objects that are kept alive because the C stack contains
- a pattern that looks like a reference to them . */
+ a pattern that looks like a reference to them. */
#define MAX_ZOMBIES 10
static Lisp_Object zombies[MAX_ZOMBIES];
/* Mark Lisp objects referenced from the address range START+OFFSET..END
or END+OFFSET..START. */
-static void
+static void ATTRIBUTE_NO_SANITIZE_ADDRESS
mark_memory (void *start, void *end)
-#if defined (__clang__) && defined (__has_feature)
-#if __has_feature(address_sanitizer)
- /* Do not allow -faddress-sanitizer to check this function, since it
- crosses the function stack boundary, and thus would yield many
- false positives. */
- __attribute__((no_address_safety_analysis))
-#endif
-#endif
{
void **pp;
int i;
#ifdef HAVE_WINDOW_SYSTEM
+/* This code has a few issues on MS-Windows, see Bug#15876 and Bug#16140. */
+
+#if !defined (HAVE_NTGUI)
+
/* Remove unmarked font-spec and font-entity objects from ENTRY, which is
(DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...), and return changed entry. */
return entry;
}
+#endif /* not HAVE_NTGUI */
+
/* Compact font caches on all terminals and mark
everything which is still here after compaction. */
for (t = terminal_list; t; t = t->next_terminal)
{
Lisp_Object cache = TERMINAL_FONT_CACHE (t);
-
+#if !defined (HAVE_NTGUI)
if (CONSP (cache))
{
Lisp_Object entry;
for (entry = XCDR (cache); CONSP (entry); entry = XCDR (entry))
XSETCAR (entry, compact_font_cache_entry (XCAR (entry)));
}
+#endif /* not HAVE_NTGUI */
mark_object (cache);
}
}
stack_copy = xrealloc (stack_copy, stack_size);
stack_copy_size = stack_size;
}
- memcpy (stack_copy, stack, stack_size);
+ no_sanitize_memcpy (stack_copy, stack, stack_size);
}
}
#endif /* MAX_SAVE_STACK > 0 */
\f
-/* Sweep: find all structures not marked, and free them. */
+/* Sweep: find all structures not marked, and free them. */
static void
gc_sweep (void)
sweep_strings ();
check_string_bytes (!noninteractive);
- /* Put all unmarked conses on free list */
+ /* Put all unmarked conses on free list. */
{
register struct cons_block *cblk;
struct cons_block **cprev = &cons_block;
total_free_conses = num_free;
}
- /* Put all unmarked floats on free list */
+ /* Put all unmarked floats on free list. */
{
register struct float_block *fblk;
struct float_block **fprev = &float_block;
total_free_floats = num_free;
}
- /* Put all unmarked intervals on free list */
+ /* Put all unmarked intervals on free list. */
{
register struct interval_block *iblk;
struct interval_block **iprev = &interval_block;
total_free_intervals = num_free;
}
- /* Put all unmarked symbols on free list */
+ /* Put all unmarked symbols on free list. */
{
register struct symbol_block *sblk;
struct symbol_block **sprev = &symbol_block;
{
++num_used;
if (!pure_p)
- UNMARK_STRING (XSTRING (sym->s.name));
+ eassert (!STRING_MARKED_P (XSTRING (sym->s.name)));
sym->s.gcmarkbit = 0;
}
}
{
Lisp_Object end;
+#ifdef HAVE_NS
+ /* Avoid warning. sbrk has no relation to memory allocated anyway. */
+ XSETINT (end, 0);
+#else
XSETINT (end, (intptr_t) (char *) sbrk (0) / 1024);
+#endif
return end;
}