/* 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.
#include "frame.h"
#include "blockinput.h"
#include "termhooks.h" /* For struct terminal. */
+#ifdef HAVE_WINDOW_SYSTEM
+#include TERM_HEADER
+#endif /* HAVE_WINDOW_SYSTEM */
#include <verify.h>
#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;
static void *pure_alloc (size_t, int);
+/* Return X rounded to the next multiple of Y. Arguments should not
+ have side effects, as they are evaluated more than once. Assume X
+ + Y - 1 does not overflow. Tune for Y being a power of 2. */
-/* Value is SZ rounded up to the next multiple of ALIGNMENT.
- ALIGNMENT must be a power of 2. */
+#define ROUNDUP(x, y) ((y) & ((y) - 1) \
+ ? ((x) + (y) - 1) - ((x) + (y) - 1) % (y) \
+ : ((x) + (y) - 1) & ~ ((y) - 1))
-#define ALIGN(ptr, ALIGNMENT) \
- ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \
- & ~ ((ALIGNMENT) - 1)))
+/* Return PTR rounded up to the next multiple of ALIGNMENT. */
+
+static void *
+ALIGN (void *ptr, int alignment)
+{
+ return (void *) ROUNDUP ((uintptr_t) ptr, alignment);
+}
static void
XFLOAT_INIT (Lisp_Object f, double n)
/* 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);
#define LARGE_STRING_BYTES 1024
-/* Struct or union describing string memory sub-allocated from an sblock.
- This is where the contents of Lisp strings are stored. */
+/* The SDATA typedef is a struct or union describing string memory
+ sub-allocated from an sblock. This is where the contents of Lisp
+ strings are stored. */
-#ifdef GC_CHECK_STRING_BYTES
-
-typedef struct
+struct sdata
{
/* Back-pointer to the string this sdata belongs to. If null, this
- structure is free, and the NBYTES member of the union below
+ structure is free, and NBYTES (in this structure or in the union below)
contains the string's byte size (the same value that STRING_BYTES
would return if STRING were non-null). If non-null, STRING_BYTES
(STRING) is the size of the data, and DATA contains the string's
contents. */
struct Lisp_String *string;
+#ifdef GC_CHECK_STRING_BYTES
ptrdiff_t nbytes;
+#endif
+
unsigned char data[FLEXIBLE_ARRAY_MEMBER];
-} sdata;
+};
+#ifdef GC_CHECK_STRING_BYTES
+
+typedef struct sdata sdata;
#define SDATA_NBYTES(S) (S)->nbytes
#define SDATA_DATA(S) (S)->data
-#define SDATA_SELECTOR(member) member
#else
{
struct Lisp_String *string;
- /* When STRING is non-null. */
- struct
- {
- struct Lisp_String *string;
- unsigned char data[FLEXIBLE_ARRAY_MEMBER];
- } u;
+ /* When STRING is nonnull, this union is actually of type 'struct sdata',
+ which has a flexible array member. However, if implemented by
+ giving this union a member of type 'struct sdata', the union
+ could not be the last (flexible) member of 'struct sblock',
+ because C99 prohibits a flexible array member from having a type
+ that is itself a flexible array. So, comment this member out here,
+ but remember that the option's there when using this union. */
+#if 0
+ struct sdata u;
+#endif
/* When STRING is null. */
struct
} sdata;
#define SDATA_NBYTES(S) (S)->n.nbytes
-#define SDATA_DATA(S) (S)->u.data
-#define SDATA_SELECTOR(member) u.member
+#define SDATA_DATA(S) ((struct sdata *) (S))->data
#endif /* not GC_CHECK_STRING_BYTES */
-#define SDATA_DATA_OFFSET offsetof (sdata, SDATA_SELECTOR (data))
-
+enum { SDATA_DATA_OFFSET = offsetof (struct sdata, data) };
/* Structure describing a block of memory which is sub-allocated to
obtain string data memory for strings. Blocks for small strings
of the sblock if there isn't any space left in this block. */
sdata *next_free;
- /* Start of data. */
- sdata first_data;
+ /* String data. */
+ sdata data[FLEXIBLE_ARRAY_MEMBER];
};
/* Number of Lisp strings in a string_block structure. The 1020 is
min (STRING_BYTES_BOUND,
((SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD
- GC_STRING_EXTRA
- - offsetof (struct sblock, first_data)
+ - offsetof (struct sblock, data)
- SDATA_DATA_OFFSET)
& ~(sizeof (EMACS_INT) - 1)));
end = b->next_free;
- for (from = &b->first_data; from < end; from = from_end)
+ for (from = b->data; from < end; from = from_end)
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
for (b = large_sblocks; b; b = b->next)
{
- struct Lisp_String *s = b->first_data.string;
+ struct Lisp_String *s = b->data[0].string;
if (s)
string_bytes (s);
}
if (nbytes > LARGE_STRING_BYTES)
{
- size_t size = offsetof (struct sblock, first_data) + needed;
+ size_t size = offsetof (struct sblock, data) + needed;
#ifdef DOUG_LEA_MALLOC
/* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif
- b->next_free = &b->first_data;
- b->first_data.string = NULL;
+ b->next_free = b->data;
+ b->data[0].string = NULL;
b->next = large_sblocks;
large_sblocks = b;
}
{
/* Not enough room in the current sblock. */
b = lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP);
- b->next_free = &b->first_data;
- b->first_data.string = NULL;
+ b->next_free = b->data;
+ b->data[0].string = NULL;
b->next = NULL;
if (current_sblock)
{
next = b->next;
- if (b->first_data.string == NULL)
+ if (b->data[0].string == NULL)
lisp_free (b);
else
{
to, and TB_END is the end of TB. */
tb = oldest_sblock;
tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
- to = &tb->first_data;
+ to = tb->data;
/* Step through the blocks from the oldest to the youngest. We
expect that old blocks will stabilize over time, so that less
end = b->next_free;
eassert ((char *) end <= (char *) b + SBLOCK_SIZE);
- for (from = &b->first_data; from < end; from = from_end)
+ for (from = b->data; from < end; from = from_end)
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
tb->next_free = to;
tb = tb->next;
tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
- to = &tb->first_data;
+ to = tb->data;
to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
}
(Lisp_Object length, Lisp_Object init)
{
register Lisp_Object val;
- register unsigned char *p, *end;
int c;
EMACS_INT nbytes;
{
nbytes = XINT (length);
val = make_uninit_string (nbytes);
- p = SDATA (val);
- end = p + SCHARS (val);
- while (p != end)
- *p++ = c;
+ memset (SDATA (val), c, nbytes);
+ SDATA (val)[nbytes] = 0;
}
else
{
unsigned char str[MAX_MULTIBYTE_LENGTH];
- int len = CHAR_STRING (c, str);
+ ptrdiff_t len = CHAR_STRING (c, str);
EMACS_INT string_len = XINT (length);
+ unsigned char *p, *beg, *end;
if (string_len > STRING_BYTES_MAX / len)
string_overflow ();
nbytes = len * string_len;
val = make_uninit_multibyte_string (string_len, nbytes);
- p = SDATA (val);
- end = p + nbytes;
- while (p != end)
+ for (beg = SDATA (val), p = beg, end = beg + nbytes; p < end; p += len)
{
- memcpy (p, str, len);
- p += len;
+ /* First time we just copy `str' to the data of `val'. */
+ if (p == beg)
+ memcpy (p, str, len);
+ else
+ {
+ /* Next time we copy largest possible chunk from
+ initialized to uninitialized part of `val'. */
+ len = min (p - beg, end - p);
+ memcpy (p, beg, len);
+ }
}
+ *p = 0;
}
- *p = 0;
return val;
}
-verify (sizeof (size_t) * CHAR_BIT == BITS_PER_SIZE_T);
-verify ((BITS_PER_SIZE_T & (BITS_PER_SIZE_T - 1)) == 0);
+/* Fill A with 1 bits if INIT is non-nil, and with 0 bits otherwise.
+ Return A. */
-static ptrdiff_t
-bool_vector_payload_bytes (ptrdiff_t nr_bits,
- ptrdiff_t *exact_needed_bytes_out)
+Lisp_Object
+bool_vector_fill (Lisp_Object a, Lisp_Object init)
{
- ptrdiff_t exact_needed_bytes;
- ptrdiff_t needed_bytes;
-
- eassert (nr_bits >= 0);
-
- exact_needed_bytes = ROUNDUP ((size_t) nr_bits, CHAR_BIT) / CHAR_BIT;
- needed_bytes = ROUNDUP ((size_t) nr_bits, BITS_PER_SIZE_T) / CHAR_BIT;
-
- if (needed_bytes == 0)
+ EMACS_INT nbits = bool_vector_size (a);
+ if (0 < nbits)
{
- /* 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. */
- needed_bytes = sizeof (size_t);
+ unsigned char *data = bool_vector_uchar_data (a);
+ int pattern = NILP (init) ? 0 : (1 << BOOL_VECTOR_BITS_PER_CHAR) - 1;
+ 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;
+}
+
+/* Return a newly allocated, uninitialized bool vector of size NBITS. */
+
+Lisp_Object
+make_uninit_bool_vector (EMACS_INT nbits)
+{
+ Lisp_Object val;
+ 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 = nbits;
- if (exact_needed_bytes_out != NULL)
- *exact_needed_bytes_out = exact_needed_bytes;
+ /* Clear padding at the end. */
+ if (words)
+ p->data[words - 1] = 0;
- return needed_bytes;
+ return val;
}
DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
LENGTH must be a number. INIT matters only in whether it is t or nil. */)
(Lisp_Object length, Lisp_Object init)
{
- register Lisp_Object val;
- struct Lisp_Bool_Vector *p;
- ptrdiff_t exact_payload_bytes;
- ptrdiff_t total_payload_bytes;
- ptrdiff_t needed_elements;
+ Lisp_Object val;
CHECK_NATNUM (length);
- if (PTRDIFF_MAX < XFASTINT (length))
- memory_full (SIZE_MAX);
-
- total_payload_bytes = bool_vector_payload_bytes
- (XFASTINT (length), &exact_payload_bytes);
-
- eassert (exact_payload_bytes <= total_payload_bytes);
- eassert (0 <= exact_payload_bytes);
-
- needed_elements = ROUNDUP ((size_t) ((bool_header_size - header_size)
- + total_payload_bytes),
- word_size) / word_size;
-
- p = (struct Lisp_Bool_Vector *) allocate_vector (needed_elements);
- XSETVECTOR (val, p);
- XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0);
-
- p->size = XFASTINT (length);
- if (exact_payload_bytes)
- {
- memset (p->data, ! NILP (init) ? -1 : 0, exact_payload_bytes);
-
- /* Clear any extraneous bits in the last byte. */
- p->data[exact_payload_bytes - 1]
- &= (1 << ((XFASTINT (length) - 1) % BOOL_VECTOR_BITS_PER_CHAR + 1)) - 1;
- }
-
- /* Clear padding at the end. */
- memset (p->data + exact_payload_bytes,
- 0,
- total_payload_bytes - exact_payload_bytes);
-
- return val;
+ val = make_uninit_bool_vector (XFASTINT (length));
+ return bool_vector_fill (val, init);
}
Vector Allocation
***********************************************************************/
+/* Sometimes a vector's contents are merely a pointer internally used
+ in vector allocation code. Usually you don't want to touch this. */
+
+static struct Lisp_Vector *
+next_vector (struct Lisp_Vector *v)
+{
+ return XUNTAG (v->contents[0], 0);
+}
+
+static void
+set_next_vector (struct Lisp_Vector *v, struct Lisp_Vector *p)
+{
+ v->contents[0] = make_lisp_ptr (p, 0);
+}
+
/* This value is balanced well enough to avoid too much internal overhead
for the most common cases; it's not required to be a power of two, but
it's expected to be a mult-of-ROUNDUP_SIZE (see below). */
#define VECTOR_BLOCK_SIZE 4096
-/* Align allocation request sizes to be a multiple of ROUNDUP_SIZE. */
enum
{
- roundup_size = COMMON_MULTIPLE (word_size, USE_LSB_TAG ? GCALIGNMENT : 1)
+ /* Alignment of struct Lisp_Vector objects. */
+ vector_alignment = COMMON_MULTIPLE (ALIGNOF_STRUCT_LISP_VECTOR,
+ USE_LSB_TAG ? GCALIGNMENT : 1),
+
+ /* Vector size requests are a multiple of this. */
+ roundup_size = COMMON_MULTIPLE (vector_alignment, word_size)
};
/* Verify assumptions described above. */
verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS));
/* Round up X to nearest mult-of-ROUNDUP_SIZE --- use at compile time. */
-#define vroundup_ct(x) ROUNDUP ((size_t) (x), roundup_size)
+#define vroundup_ct(x) ROUNDUP (x, roundup_size)
/* Round up X to nearest mult-of-ROUNDUP_SIZE --- use at runtime. */
-#define vroundup(x) (assume ((x) >= 0), vroundup_ct (x))
+#define vroundup(x) (eassume ((x) >= 0), vroundup_ct (x))
/* Rounding helps to maintain alignment constraints if USE_LSB_TAG. */
eassert ((nbytes) % roundup_size == 0); \
(tmp) = VINDEX (nbytes); \
eassert ((tmp) < VECTOR_MAX_FREE_LIST_INDEX); \
- v->u.next = vector_free_lists[tmp]; \
+ set_next_vector (v, vector_free_lists[tmp]); \
vector_free_lists[tmp] = (v); \
total_free_vector_slots += (nbytes) / word_size; \
} while (0)
/* This internal type is used to maintain the list of large vectors
- which are allocated at their own, e.g. outside of vector blocks. */
+ which are allocated at their own, e.g. outside of vector blocks.
+
+ struct large_vector itself cannot contain a struct Lisp_Vector, as
+ the latter contains a flexible array member and C99 does not allow
+ such structs to be nested. Instead, each struct large_vector
+ object LV is followed by a struct Lisp_Vector, which is at offset
+ large_vector_offset from LV, and whose address is therefore
+ large_vector_vec (&LV). */
struct large_vector
{
- union {
- struct large_vector *vector;
-#if USE_LSB_TAG
- /* We need to maintain ROUNDUP_SIZE alignment for the vector member. */
- unsigned char c[vroundup_ct (sizeof (struct large_vector *))];
-#endif
- } next;
- struct Lisp_Vector v;
+ struct large_vector *next;
};
+enum
+{
+ large_vector_offset = ROUNDUP (sizeof (struct large_vector), vector_alignment)
+};
+
+static struct Lisp_Vector *
+large_vector_vec (struct large_vector *p)
+{
+ return (struct Lisp_Vector *) ((char *) p + large_vector_offset);
+}
+
/* This internal type is used to maintain an underlying storage
for small vectors. */
if (vector_free_lists[index])
{
vector = vector_free_lists[index];
- vector_free_lists[index] = vector->u.next;
+ vector_free_lists[index] = next_vector (vector);
total_free_vector_slots -= nbytes / word_size;
return vector;
}
{
/* This vector is larger than requested. */
vector = vector_free_lists[index];
- vector_free_lists[index] = vector->u.next;
+ vector_free_lists[index] = next_vector (vector);
total_free_vector_slots -= nbytes / word_size;
/* Excess bytes are used for the smaller vector,
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, NULL);
-
- eassert (payload_bytes >= 0);
- size = bool_header_size + ROUNDUP (payload_bytes, word_size);
+ 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
+ vector-like object. For now, this is used just to free data in
+ font objects. */
+
+static void
+cleanup_vector (struct Lisp_Vector *vector)
+{
+ if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT)
+ && ((vector->header.size & PSEUDOVECTOR_SIZE_MASK)
+ == FONT_OBJECT_MAX))
+ {
+ /* 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. */
{
ptrdiff_t total_bytes;
+ cleanup_vector (vector);
nbytes = vector_nbytes (vector);
total_bytes = nbytes;
next = ADVANCE (vector, nbytes);
{
if (VECTOR_MARKED_P (next))
break;
+ cleanup_vector (next);
nbytes = vector_nbytes (next);
total_bytes += nbytes;
next = ADVANCE (next, nbytes);
for (lv = large_vectors; lv; lv = *lvprev)
{
- vector = &lv->v;
+ vector = large_vector_vec (lv);
if (VECTOR_MARKED_P (vector))
{
VECTOR_UNMARK (vector);
else
total_vector_slots
+= header_size / word_size + vector->header.size;
- lvprev = &lv->next.vector;
+ lvprev = &lv->next;
}
else
{
- *lvprev = lv->next.vector;
+ *lvprev = lv->next;
lisp_free (lv);
}
}
else
{
struct large_vector *lv
- = lisp_malloc ((offsetof (struct large_vector, v.u.contents)
+ = lisp_malloc ((large_vector_offset + header_size
+ len * word_size),
MEM_TYPE_VECTORLIKE);
- lv->next.vector = large_vectors;
+ lv->next = large_vectors;
large_vectors = lv;
- p = &lv->v;
+ p = large_vector_vec (lv);
}
#ifdef DOUG_LEA_MALLOC
/* Only the first lisplen slots will be traced normally by the GC. */
for (i = 0; i < lisplen; ++i)
- v->u.contents[i] = Qnil;
+ v->contents[i] = Qnil;
XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen);
return v;
p = allocate_vector (XFASTINT (length));
sizei = XFASTINT (length);
for (i = 0; i < sizei; i++)
- p->u.contents[i] = init;
+ p->contents[i] = init;
XSETVECTOR (vector, p);
return vector;
register struct Lisp_Vector *p = XVECTOR (val);
for (i = 0; i < nargs; i++)
- p->u.contents[i] = args[i];
+ p->contents[i] = args[i];
return val;
}
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);
- if (v->header.size > 1 && STRINGP (v->u.contents[1])
- && STRING_MULTIBYTE (v->u.contents[1]))
+ /* 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
earlier because they produced a raw 8-bit string for byte-code
and now such a byte-code string is loaded as multibyte while
raw 8-bit characters converted to multibyte form. Thus, now we
must convert them back to the original unibyte form. */
- v->u.contents[1] = Fstring_as_unibyte (v->u.contents[1]);
+ v->contents[1] = Fstring_as_unibyte (v->contents[1]);
XSETPVECTYPE (v, PVEC_COMPILED);
}
to be setcar'd). */
for (i = 0; i < nargs; i++)
- p->u.contents[i] = args[i];
+ p->contents[i] = args[i];
make_byte_code (p);
XSETCOMPILED (val, p);
return val;
return val;
}
-#if defined HAVE_NS || defined HAVE_NTGUI
Lisp_Object
make_save_ptr (void *a)
{
p->data[0].pointer = a;
return val;
}
-#endif
Lisp_Object
make_save_ptr_int (void *a, ptrdiff_t b)
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)
{
vector = ADVANCE (vector, vector_nbytes (vector));
}
}
- else if (m->type == MEM_TYPE_VECTORLIKE
- && (char *) p == ((char *) m->start
- + offsetof (struct large_vector, v)))
+ else if (m->type == MEM_TYPE_VECTORLIKE && p == large_vector_vec (m->start))
/* This memory node corresponds to a large vector. */
return 1;
return 0;
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;
if (emacs_pipe (fd) == 0)
{
- bool valid = emacs_write (fd[1], (char *) p, 16) == 16;
+ bool valid = emacs_write (fd[1], p, 16) == 16;
emacs_close (fd[1]);
emacs_close (fd[0]);
return valid;
size &= PSEUDOVECTOR_SIZE_MASK;
vec = XVECTOR (make_pure_vector (size));
for (i = 0; i < size; i++)
- vec->u.contents[i] = Fpurecopy (AREF (obj, i));
+ vec->contents[i] = Fpurecopy (AREF (obj, i));
if (COMPILEDP (obj))
{
XSETPVECTYPE (vec, PVEC_COMPILED);
return tot;
}
+#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. */
+
+static Lisp_Object
+compact_font_cache_entry (Lisp_Object entry)
+{
+ Lisp_Object tail, *prev = &entry;
+
+ for (tail = entry; CONSP (tail); tail = XCDR (tail))
+ {
+ bool drop = 0;
+ Lisp_Object obj = XCAR (tail);
+
+ /* Consider OBJ if it is (font-spec . [font-entity font-entity ...]). */
+ if (CONSP (obj) && FONT_SPEC_P (XCAR (obj))
+ && !VECTOR_MARKED_P (XFONT_SPEC (XCAR (obj)))
+ && VECTORP (XCDR (obj)))
+ {
+ ptrdiff_t i, size = ASIZE (XCDR (obj)) & ~ARRAY_MARK_FLAG;
+
+ /* If font-spec is not marked, most likely all font-entities
+ are not marked too. But we must be sure that nothing is
+ marked within OBJ before we really drop it. */
+ for (i = 0; i < size; i++)
+ if (VECTOR_MARKED_P (XFONT_ENTITY (AREF (XCDR (obj), i))))
+ break;
+
+ if (i == size)
+ drop = 1;
+ }
+ if (drop)
+ *prev = XCDR (tail);
+ else
+ prev = xcdr_addr (tail);
+ }
+ return entry;
+}
+
+#endif /* not HAVE_NTGUI */
+
+/* Compact font caches on all terminals and mark
+ everything which is still here after compaction. */
+
+static void
+compact_font_caches (void)
+{
+ struct terminal *t;
+
+ 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);
+ }
+}
+
+#else /* not HAVE_WINDOW_SYSTEM */
+
+#define compact_font_caches() (void)(0)
+
+#endif /* HAVE_WINDOW_SYSTEM */
+
+/* Remove (MARKER . DATA) entries with unmarked MARKER
+ from buffer undo LIST and return changed list. */
+
+static Lisp_Object
+compact_undo_list (Lisp_Object list)
+{
+ Lisp_Object tail, *prev = &list;
+
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
+ {
+ if (CONSP (XCAR (tail))
+ && MARKERP (XCAR (XCAR (tail)))
+ && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
+ *prev = XCDR (tail);
+ else
+ prev = xcdr_addr (tail);
+ }
+ return list;
+}
+
DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
doc: /* Reclaim storage for Lisp objects no longer needed.
Garbage collection happens automatically if you cons more than
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 */
mark_stack ();
#endif
- /* Everything is now marked, except for the things that require special
- finalization, i.e. the undo_list.
- Look thru every buffer's undo list
- for elements that update markers that were not marked,
- and delete them. */
+ /* Everything is now marked, except for the data in font caches
+ and undo lists. They're compacted by removing an items which
+ aren't reachable otherwise. */
+
+ compact_font_caches ();
+
FOR_EACH_BUFFER (nextb)
{
- /* If a buffer's undo list is Qt, that means that undo is
- turned off in that buffer. Calling truncate_undo_list on
- Qt tends to return NULL, which effectively turns undo back on.
- So don't call truncate_undo_list if undo_list is Qt. */
- if (! EQ (nextb->INTERNAL_FIELD (undo_list), Qt))
- {
- Lisp_Object tail, prev;
- tail = nextb->INTERNAL_FIELD (undo_list);
- prev = Qnil;
- while (CONSP (tail))
- {
- if (CONSP (XCAR (tail))
- && MARKERP (XCAR (XCAR (tail)))
- && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
- {
- if (NILP (prev))
- nextb->INTERNAL_FIELD (undo_list) = tail = XCDR (tail);
- else
- {
- tail = XCDR (tail);
- XSETCDR (prev, tail);
- }
- }
- else
- {
- prev = tail;
- tail = XCDR (tail);
- }
- }
- }
- /* Now that we have stripped the elements that need not be in the
- undo_list any more, we can finally mark the list. */
- mark_object (nextb->INTERNAL_FIELD (undo_list));
+ if (!EQ (BVAR (nextb, undo_list), Qt))
+ bset_undo_list (nextb, compact_undo_list (BVAR (nextb, undo_list)));
+ /* Now that we have stripped the elements that need not be
+ in the undo_list any more, we can finally mark the list. */
+ mark_object (BVAR (nextb, undo_list));
}
gc_sweep ();
}
}
-
-/* Mark Lisp faces in the face cache C. */
-
-static void
-mark_face_cache (struct face_cache *c)
-{
- if (c)
- {
- int i, j;
- for (i = 0; i < c->used; ++i)
- {
- struct face *face = FACE_FROM_ID (c->f, i);
-
- if (face)
- {
- for (j = 0; j < LFACE_VECTOR_SIZE; ++j)
- mark_object (face->lface[j]);
- }
- }
- }
-}
-
-
-\f
/* Mark reference to a Lisp_Object.
If the object referred to has not been seen yet, recursively mark
all the references contained in it. */
The distinction is used e.g. by Lisp_Process which places extra
non-Lisp_Object fields at the end of the structure... */
for (i = 0; i < size; i++) /* ...and then mark its elements. */
- mark_object (ptr->u.contents[i]);
+ mark_object (ptr->contents[i]);
}
/* Like mark_vectorlike but optimized for char-tables (and
VECTOR_MARK (ptr);
for (i = 0; i < size; i++)
{
- Lisp_Object val = ptr->u.contents[i];
+ Lisp_Object val = ptr->contents[i];
if (INTEGERP (val) || (SYMBOLP (val) && XSYMBOL (val)->gcmarkbit))
continue;
mark_buffer (buffer->base_buffer);
}
+/* Mark Lisp faces in the face cache C. */
+
+static void
+mark_face_cache (struct face_cache *c)
+{
+ if (c)
+ {
+ int i, j;
+ for (i = 0; i < c->used; ++i)
+ {
+ struct face *face = FACE_FROM_ID (c->f, i);
+
+ if (face)
+ {
+ if (face->font && !VECTOR_MARKED_P (face->font))
+ mark_vectorlike ((struct Lisp_Vector *) face->font);
+
+ for (j = 0; j < LFACE_VECTOR_SIZE; ++j)
+ mark_object (face->lface[j]);
+ }
+ }
+ }
+}
+
/* Remove killed buffers or items whose car is a killed buffer from
LIST, and mark other items. Return changed LIST, which is marked. */
VECTOR_MARK (ptr);
for (i = 0; i < size; i++)
if (i != COMPILED_CONSTANTS)
- mark_object (ptr->u.contents[i]);
+ mark_object (ptr->contents[i]);
if (size > COMPILED_CONSTANTS)
{
- obj = ptr->u.contents[COMPILED_CONSTANTS];
+ obj = ptr->contents[COMPILED_CONSTANTS];
goto loop;
}
}
break;
case PVEC_FRAME:
- mark_vectorlike (ptr);
- mark_face_cache (((struct frame *) ptr)->face_cache);
+ {
+ struct frame *f = (struct frame *) ptr;
+
+ mark_vectorlike (ptr);
+ mark_face_cache (f->face_cache);
+#ifdef HAVE_WINDOW_SYSTEM
+ if (FRAME_WINDOW_P (f) && FRAME_X_OUTPUT (f))
+ {
+ struct font *font = FRAME_FONT (f);
+
+ if (font && !VECTOR_MARKED_P (font))
+ mark_vectorlike ((struct Lisp_Vector *) font);
+ }
+#endif
+ }
break;
case PVEC_WINDOW:
\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;
}
HCoop / bpt / emacs.git / blobdiff