Reinstall recent GC-related changes
The report that they broke macOS was a false alarm, as the previous commit was also broken (Bug#43152#62). * src/alloc.c (live_string_holding, live_cons_holding) (live_symbol_holding): Count only pointers that point to a struct component, or are a tagged pointer to the start of the struct. Exception: for non-bool-vector pseudovectors, count any pointer past the header, since it’s too much of a pain to write code for every pseudovector. (live_float_holding, live_vector_pointer): New functions, which are similar about counting pointers. (live_float_p, live_large_vector_holding) (live_small_vector_pointer, mark_maybe_pointer): Use them. (mark_maybe_object, mark_maybe_objects): Remove, and remove all callers; mark_maybe_pointer now suffices. (mark_objects): New function. * src/alloc.c (mark_vectorlike, mark_face_cache): * src/eval.c (mark_specpdl): * src/fringe.c (mark_fringe_data): * src/keyboard.c (mark_kboards): Simplify by using mark_objects. * src/lisp.h (SAFE_ALLOCA_LISP_EXTRA): Clear any Lisp_Object arrays large enough to not fit into the stack, so that GC need not worry about whether they contain objects.
This commit is contained in:
Paul Eggert
parent
940ea15491
commit
6cf62141c4
5 changed files with 130 additions and 145 deletions
249
src/alloc.c
249
src/alloc.c
|
|
@ -4457,9 +4457,17 @@ live_string_holding (struct mem_node *m, void *p)
|
|||
must not be on the free-list. */
|
||||
if (0 <= offset && offset < sizeof b->strings)
|
||||
{
|
||||
struct Lisp_String *s = p = cp -= offset % sizeof b->strings[0];
|
||||
if (s->u.s.data)
|
||||
return s;
|
||||
ptrdiff_t off = offset % sizeof b->strings[0];
|
||||
if (off == Lisp_String
|
||||
|| off == 0
|
||||
|| off == offsetof (struct Lisp_String, u.s.size_byte)
|
||||
|| off == offsetof (struct Lisp_String, u.s.intervals)
|
||||
|| off == offsetof (struct Lisp_String, u.s.data))
|
||||
{
|
||||
struct Lisp_String *s = p = cp -= off;
|
||||
if (s->u.s.data)
|
||||
return s;
|
||||
}
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
|
@ -4489,9 +4497,15 @@ live_cons_holding (struct mem_node *m, void *p)
|
|||
&& (b != cons_block
|
||||
|| offset / sizeof b->conses[0] < cons_block_index))
|
||||
{
|
||||
struct Lisp_Cons *s = p = cp -= offset % sizeof b->conses[0];
|
||||
if (!deadp (s->u.s.car))
|
||||
return s;
|
||||
ptrdiff_t off = offset % sizeof b->conses[0];
|
||||
if (off == Lisp_Cons
|
||||
|| off == 0
|
||||
|| off == offsetof (struct Lisp_Cons, u.s.u.cdr))
|
||||
{
|
||||
struct Lisp_Cons *s = p = cp -= off;
|
||||
if (!deadp (s->u.s.car))
|
||||
return s;
|
||||
}
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
|
@ -4522,9 +4536,23 @@ live_symbol_holding (struct mem_node *m, void *p)
|
|||
&& (b != symbol_block
|
||||
|| offset / sizeof b->symbols[0] < symbol_block_index))
|
||||
{
|
||||
struct Lisp_Symbol *s = p = cp -= offset % sizeof b->symbols[0];
|
||||
if (!deadp (s->u.s.function))
|
||||
return s;
|
||||
ptrdiff_t off = offset % sizeof b->symbols[0];
|
||||
if (off == Lisp_Symbol
|
||||
|
||||
/* Plain '|| off == 0' would run afoul of GCC 10.2
|
||||
-Wlogical-op, as Lisp_Symbol happens to be zero. */
|
||||
|| (Lisp_Symbol != 0 && off == 0)
|
||||
|
||||
|| off == offsetof (struct Lisp_Symbol, u.s.name)
|
||||
|| off == offsetof (struct Lisp_Symbol, u.s.val)
|
||||
|| off == offsetof (struct Lisp_Symbol, u.s.function)
|
||||
|| off == offsetof (struct Lisp_Symbol, u.s.plist)
|
||||
|| off == offsetof (struct Lisp_Symbol, u.s.next))
|
||||
{
|
||||
struct Lisp_Symbol *s = p = cp -= off;
|
||||
if (!deadp (s->u.s.function))
|
||||
return s;
|
||||
}
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
|
@ -4536,23 +4564,70 @@ live_symbol_p (struct mem_node *m, void *p)
|
|||
}
|
||||
|
||||
|
||||
/* Return true if P is a pointer to a live Lisp float on
|
||||
the heap. M is a pointer to the mem_block for P. */
|
||||
/* If P is a (possibly-tagged) pointer to a live Lisp_Float on the
|
||||
heap, return the address of the Lisp_Float. Otherwise, return NULL.
|
||||
M is a pointer to the mem_block for P. */
|
||||
|
||||
static bool
|
||||
live_float_p (struct mem_node *m, void *p)
|
||||
static struct Lisp_Float *
|
||||
live_float_holding (struct mem_node *m, void *p)
|
||||
{
|
||||
eassert (m->type == MEM_TYPE_FLOAT);
|
||||
struct float_block *b = m->start;
|
||||
char *cp = p;
|
||||
ptrdiff_t offset = cp - (char *) &b->floats[0];
|
||||
|
||||
/* P must point to the start of a Lisp_Float and not be
|
||||
one of the unused cells in the current float block. */
|
||||
return (0 <= offset && offset < sizeof b->floats
|
||||
&& offset % sizeof b->floats[0] == 0
|
||||
/* P must point to (or be a tagged pointer to) the start of a
|
||||
Lisp_Float and not be one of the unused cells in the current
|
||||
float block. */
|
||||
if (0 <= offset && offset < sizeof b->floats)
|
||||
{
|
||||
int off = offset % sizeof b->floats[0];
|
||||
if ((off == Lisp_Float || off == 0)
|
||||
&& (b != float_block
|
||||
|| offset / sizeof b->floats[0] < float_block_index));
|
||||
|| offset / sizeof b->floats[0] < float_block_index))
|
||||
{
|
||||
p = cp - off;
|
||||
return p;
|
||||
}
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static bool
|
||||
live_float_p (struct mem_node *m, void *p)
|
||||
{
|
||||
return live_float_holding (m, p) == p;
|
||||
}
|
||||
|
||||
/* Return VECTOR if P points within it, NULL otherwise. */
|
||||
|
||||
static struct Lisp_Vector *
|
||||
live_vector_pointer (struct Lisp_Vector *vector, void *p)
|
||||
{
|
||||
void *vvector = vector;
|
||||
char *cvector = vvector;
|
||||
char *cp = p;
|
||||
ptrdiff_t offset = cp - cvector;
|
||||
return ((offset == Lisp_Vectorlike
|
||||
|| offset == 0
|
||||
|| (sizeof vector->header <= offset
|
||||
&& offset < vector_nbytes (vector)
|
||||
&& (! (vector->header.size & PSEUDOVECTOR_FLAG)
|
||||
? (offsetof (struct Lisp_Vector, contents) <= offset
|
||||
&& (((offset - offsetof (struct Lisp_Vector, contents))
|
||||
% word_size)
|
||||
== 0))
|
||||
/* For non-bool-vector pseudovectors, treat any pointer
|
||||
past the header as valid since it's too much of a pain
|
||||
to write special-case code for every pseudovector. */
|
||||
: (! PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BOOL_VECTOR)
|
||||
|| offset == offsetof (struct Lisp_Bool_Vector, size)
|
||||
|| (offsetof (struct Lisp_Bool_Vector, data) <= offset
|
||||
&& (((offset
|
||||
- offsetof (struct Lisp_Bool_Vector, data))
|
||||
% sizeof (bits_word))
|
||||
== 0))))))
|
||||
? vector : NULL);
|
||||
}
|
||||
|
||||
/* If P is a pointer to a live, large vector-like object, return the object.
|
||||
|
|
@ -4563,10 +4638,7 @@ static struct Lisp_Vector *
|
|||
live_large_vector_holding (struct mem_node *m, void *p)
|
||||
{
|
||||
eassert (m->type == MEM_TYPE_VECTORLIKE);
|
||||
struct Lisp_Vector *vp = p;
|
||||
struct Lisp_Vector *vector = large_vector_vec (m->start);
|
||||
struct Lisp_Vector *next = ADVANCE (vector, vector_nbytes (vector));
|
||||
return vector <= vp && vp < next ? vector : NULL;
|
||||
return live_vector_pointer (large_vector_vec (m->start), p);
|
||||
}
|
||||
|
||||
static bool
|
||||
|
|
@ -4596,7 +4668,7 @@ live_small_vector_holding (struct mem_node *m, void *p)
|
|||
{
|
||||
struct Lisp_Vector *next = ADVANCE (vector, vector_nbytes (vector));
|
||||
if (vp < next && !PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE))
|
||||
return vector;
|
||||
return live_vector_pointer (vector, vp);
|
||||
vector = next;
|
||||
}
|
||||
return NULL;
|
||||
|
|
@ -4608,97 +4680,6 @@ live_small_vector_p (struct mem_node *m, void *p)
|
|||
return live_small_vector_holding (m, p) == p;
|
||||
}
|
||||
|
||||
/* Mark OBJ if we can prove it's a Lisp_Object. */
|
||||
|
||||
static void
|
||||
mark_maybe_object (Lisp_Object obj)
|
||||
{
|
||||
#if USE_VALGRIND
|
||||
VALGRIND_MAKE_MEM_DEFINED (&obj, sizeof (obj));
|
||||
#endif
|
||||
|
||||
int type_tag = XTYPE (obj);
|
||||
intptr_t pointer_word_tag = LISP_WORD_TAG (type_tag), offset, ipo;
|
||||
|
||||
switch (type_tag)
|
||||
{
|
||||
case_Lisp_Int: case Lisp_Type_Unused0:
|
||||
return;
|
||||
|
||||
case Lisp_Symbol:
|
||||
offset = (intptr_t) lispsym;
|
||||
break;
|
||||
|
||||
default:
|
||||
offset = 0;
|
||||
break;
|
||||
}
|
||||
|
||||
INT_ADD_WRAPV ((intptr_t) XLP (obj), offset - pointer_word_tag, &ipo);
|
||||
void *po = (void *) ipo;
|
||||
|
||||
/* If the pointer is in the dump image and the dump has a record
|
||||
of the object starting at the place where the pointer points, we
|
||||
definitely have an object. If the pointer is in the dump image
|
||||
and the dump has no idea what the pointer is pointing at, we
|
||||
definitely _don't_ have an object. */
|
||||
if (pdumper_object_p (po))
|
||||
{
|
||||
/* Don't use pdumper_object_p_precise here! It doesn't check the
|
||||
tag bits. OBJ here might be complete garbage, so we need to
|
||||
verify both the pointer and the tag. */
|
||||
if (pdumper_find_object_type (po) == type_tag)
|
||||
mark_object (obj);
|
||||
return;
|
||||
}
|
||||
|
||||
struct mem_node *m = mem_find (po);
|
||||
|
||||
if (m != MEM_NIL)
|
||||
{
|
||||
bool mark_p = false;
|
||||
|
||||
switch (type_tag)
|
||||
{
|
||||
case Lisp_String:
|
||||
mark_p = m->type == MEM_TYPE_STRING && live_string_p (m, po);
|
||||
break;
|
||||
|
||||
case Lisp_Cons:
|
||||
mark_p = m->type == MEM_TYPE_CONS && live_cons_p (m, po);
|
||||
break;
|
||||
|
||||
case Lisp_Symbol:
|
||||
mark_p = m->type == MEM_TYPE_SYMBOL && live_symbol_p (m, po);
|
||||
break;
|
||||
|
||||
case Lisp_Float:
|
||||
mark_p = m->type == MEM_TYPE_FLOAT && live_float_p (m, po);
|
||||
break;
|
||||
|
||||
case Lisp_Vectorlike:
|
||||
mark_p = (m->type == MEM_TYPE_VECTOR_BLOCK
|
||||
? live_small_vector_p (m, po)
|
||||
: (m->type == MEM_TYPE_VECTORLIKE
|
||||
&& live_large_vector_p (m, po)));
|
||||
break;
|
||||
|
||||
default:
|
||||
eassume (false);
|
||||
}
|
||||
|
||||
if (mark_p)
|
||||
mark_object (obj);
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
mark_maybe_objects (Lisp_Object const *array, ptrdiff_t nelts)
|
||||
{
|
||||
for (Lisp_Object const *lim = array + nelts; array < lim; array++)
|
||||
mark_maybe_object (*array);
|
||||
}
|
||||
|
||||
/* If P points to Lisp data, mark that as live if it isn't already
|
||||
marked. */
|
||||
|
||||
|
|
@ -4711,14 +4692,21 @@ mark_maybe_pointer (void *p)
|
|||
VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p));
|
||||
#endif
|
||||
|
||||
/* If the pointer is in the dump image and the dump has a record
|
||||
of the object starting at the place where the pointer points, we
|
||||
definitely have an object. If the pointer is in the dump image
|
||||
and the dump has no idea what the pointer is pointing at, we
|
||||
definitely _don't_ have an object. */
|
||||
if (pdumper_object_p (p))
|
||||
{
|
||||
/* Don't use pdumper_object_p_precise here! It doesn't check the
|
||||
tag bits. OBJ here might be complete garbage, so we need to
|
||||
verify both the pointer and the tag. */
|
||||
int type = pdumper_find_object_type (p);
|
||||
if (pdumper_valid_object_type_p (type))
|
||||
mark_object (type == Lisp_Symbol
|
||||
? make_lisp_symbol (p)
|
||||
: make_lisp_ptr (p, type));
|
||||
/* See mark_maybe_object for why we can confidently return. */
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -4762,9 +4750,12 @@ mark_maybe_pointer (void *p)
|
|||
break;
|
||||
|
||||
case MEM_TYPE_FLOAT:
|
||||
if (! live_float_p (m, p))
|
||||
return;
|
||||
obj = make_lisp_ptr (p, Lisp_Float);
|
||||
{
|
||||
struct Lisp_Float *h = live_float_holding (m, p);
|
||||
if (!h)
|
||||
return;
|
||||
obj = make_lisp_ptr (h, Lisp_Float);
|
||||
}
|
||||
break;
|
||||
|
||||
case MEM_TYPE_VECTORLIKE:
|
||||
|
|
@ -4849,11 +4840,6 @@ mark_memory (void const *start, void const *end)
|
|||
intptr_t ip;
|
||||
INT_ADD_WRAPV ((intptr_t) p, (intptr_t) lispsym, &ip);
|
||||
mark_maybe_pointer ((void *) ip);
|
||||
|
||||
verify (alignof (Lisp_Object) % GC_POINTER_ALIGNMENT == 0);
|
||||
if (alignof (Lisp_Object) == GC_POINTER_ALIGNMENT
|
||||
|| (uintptr_t) pp % alignof (Lisp_Object) == 0)
|
||||
mark_maybe_object (*(Lisp_Object const *) pp);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -6261,7 +6247,6 @@ mark_vectorlike (union vectorlike_header *header)
|
|||
{
|
||||
struct Lisp_Vector *ptr = (struct Lisp_Vector *) header;
|
||||
ptrdiff_t size = ptr->header.size;
|
||||
ptrdiff_t i;
|
||||
|
||||
eassert (!vector_marked_p (ptr));
|
||||
|
||||
|
|
@ -6276,8 +6261,7 @@ mark_vectorlike (union vectorlike_header *header)
|
|||
the number of Lisp_Object fields that we should trace.
|
||||
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->contents[i]);
|
||||
mark_objects (ptr->contents, size);
|
||||
}
|
||||
|
||||
/* Like mark_vectorlike but optimized for char-tables (and
|
||||
|
|
@ -6376,8 +6360,7 @@ mark_face_cache (struct face_cache *c)
|
|||
{
|
||||
if (c)
|
||||
{
|
||||
int i, j;
|
||||
for (i = 0; i < c->used; ++i)
|
||||
for (int i = 0; i < c->used; i++)
|
||||
{
|
||||
struct face *face = FACE_FROM_ID_OR_NULL (c->f, i);
|
||||
|
||||
|
|
@ -6386,8 +6369,7 @@ mark_face_cache (struct face_cache *c)
|
|||
if (face->font && !vectorlike_marked_p (&face->font->header))
|
||||
mark_vectorlike (&face->font->header);
|
||||
|
||||
for (j = 0; j < LFACE_VECTOR_SIZE; ++j)
|
||||
mark_object (face->lface[j]);
|
||||
mark_objects (face->lface, LFACE_VECTOR_SIZE);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -6500,6 +6482,13 @@ mark_hash_table (struct Lisp_Vector *ptr)
|
|||
}
|
||||
}
|
||||
|
||||
void
|
||||
mark_objects (Lisp_Object *obj, ptrdiff_t n)
|
||||
{
|
||||
for (ptrdiff_t i = 0; i < n; i++)
|
||||
mark_object (obj[i]);
|
||||
}
|
||||
|
||||
/* Determine type of generic Lisp_Object and mark it accordingly.
|
||||
|
||||
This function implements a straightforward depth-first marking
|
||||
|
|
|
|||
|
|
@ -3960,7 +3960,7 @@ mark_specpdl (union specbinding *first, union specbinding *ptr)
|
|||
break;
|
||||
|
||||
case SPECPDL_UNWIND_ARRAY:
|
||||
mark_maybe_objects (pdl->unwind_array.array, pdl->unwind_array.nelts);
|
||||
mark_objects (pdl->unwind_array.array, pdl->unwind_array.nelts);
|
||||
break;
|
||||
|
||||
case SPECPDL_UNWIND_EXCURSION:
|
||||
|
|
@ -3974,8 +3974,7 @@ mark_specpdl (union specbinding *first, union specbinding *ptr)
|
|||
mark_object (backtrace_function (pdl));
|
||||
if (nargs == UNEVALLED)
|
||||
nargs = 1;
|
||||
while (nargs--)
|
||||
mark_object (backtrace_args (pdl)[nargs]);
|
||||
mark_objects (backtrace_args (pdl), nargs);
|
||||
}
|
||||
break;
|
||||
|
||||
|
|
|
|||
|
|
@ -1733,11 +1733,7 @@ If nil, also continue lines which are exactly as wide as the window. */);
|
|||
void
|
||||
mark_fringe_data (void)
|
||||
{
|
||||
int i;
|
||||
|
||||
for (i = 0; i < max_fringe_bitmaps; i++)
|
||||
if (!NILP (fringe_faces[i]))
|
||||
mark_object (fringe_faces[i]);
|
||||
mark_objects (fringe_faces, max_fringe_bitmaps);
|
||||
}
|
||||
|
||||
/* Initialize this module when Emacs starts. */
|
||||
|
|
|
|||
|
|
@ -12475,13 +12475,11 @@ keys_of_keyboard (void)
|
|||
void
|
||||
mark_kboards (void)
|
||||
{
|
||||
KBOARD *kb;
|
||||
Lisp_Object *p;
|
||||
for (kb = all_kboards; kb; kb = kb->next_kboard)
|
||||
for (KBOARD *kb = all_kboards; kb; kb = kb->next_kboard)
|
||||
{
|
||||
if (kb->kbd_macro_buffer)
|
||||
for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
|
||||
mark_object (*p);
|
||||
mark_objects (kb->kbd_macro_buffer,
|
||||
kb->kbd_macro_ptr - kb->kbd_macro_buffer);
|
||||
mark_object (KVAR (kb, Voverriding_terminal_local_map));
|
||||
mark_object (KVAR (kb, Vlast_command));
|
||||
mark_object (KVAR (kb, Vreal_last_command));
|
||||
|
|
|
|||
|
|
@ -3756,12 +3756,12 @@ extern AVOID memory_full (size_t);
|
|||
extern AVOID buffer_memory_full (ptrdiff_t);
|
||||
extern bool survives_gc_p (Lisp_Object);
|
||||
extern void mark_object (Lisp_Object);
|
||||
extern void mark_objects (Lisp_Object *, ptrdiff_t);
|
||||
#if defined REL_ALLOC && !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
|
||||
extern void refill_memory_reserve (void);
|
||||
#endif
|
||||
extern void alloc_unexec_pre (void);
|
||||
extern void alloc_unexec_post (void);
|
||||
extern void mark_maybe_objects (Lisp_Object const *, ptrdiff_t);
|
||||
extern void mark_stack (char const *, char const *);
|
||||
extern void flush_stack_call_func1 (void (*func) (void *arg), void *arg);
|
||||
|
||||
|
|
@ -4873,7 +4873,10 @@ safe_free_unbind_to (ptrdiff_t count, ptrdiff_t sa_count, Lisp_Object val)
|
|||
(buf) = AVAIL_ALLOCA (alloca_nbytes); \
|
||||
else \
|
||||
{ \
|
||||
(buf) = xmalloc (alloca_nbytes); \
|
||||
/* Although only the first nelt words need clearing, \
|
||||
typically EXTRA is 0 or small so just use xzalloc; \
|
||||
this is simpler and often faster. */ \
|
||||
(buf) = xzalloc (alloca_nbytes); \
|
||||
record_unwind_protect_array (buf, nelt); \
|
||||
} \
|
||||
} while (false)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue