/* 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 SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC
-# define USE_ALIGNED_ALLOC 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
+# 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. */
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;
}