/* Common shortcut to advance vector pointer over a block data. */
-#define ADVANCE(v, nbytes) ((struct Lisp_Vector *) ((char *) (v) + (nbytes)))
+static struct Lisp_Vector *
+ADVANCE (struct Lisp_Vector *v, ptrdiff_t nbytes)
+{
+ void *vv = v;
+ char *cv = vv;
+ void *p = cv + nbytes;
+ return p;
+}
/* Common shortcut to calculate NBYTES-vector index in VECTOR_FREE_LISTS. */
-#define VINDEX(nbytes) (((nbytes) - VBLOCK_BYTES_MIN) / roundup_size)
-
-/* Common shortcut to setup vector on a free list. */
-
-#define SETUP_ON_FREE_LIST(v, nbytes, tmp) \
- do { \
- (tmp) = ((nbytes - header_size) / word_size); \
- XSETPVECTYPESIZE (v, PVEC_FREE, 0, (tmp)); \
- eassert ((nbytes) % roundup_size == 0); \
- (tmp) = VINDEX (nbytes); \
- eassert ((tmp) < VECTOR_MAX_FREE_LIST_INDEX); \
- set_next_vector (v, vector_free_lists[tmp]); \
- vector_free_lists[tmp] = (v); \
- total_free_vector_slots += (nbytes) / word_size; \
- } while (0)
+static ptrdiff_t
+VINDEX (ptrdiff_t nbytes)
+{
+ eassume (VBLOCK_BYTES_MIN <= nbytes);
+ return (nbytes - VBLOCK_BYTES_MIN) / roundup_size;
+}
/* This internal type is used to maintain the list of large vectors
which are allocated at their own, e.g. outside of vector blocks.
static EMACS_INT total_vector_slots, total_free_vector_slots;
+/* Common shortcut to setup vector on a free list. */
+
+static void
+setup_on_free_list (struct Lisp_Vector *v, ptrdiff_t nbytes)
+{
+ eassume (header_size <= nbytes);
+ ptrdiff_t nwords = (nbytes - header_size) / word_size;
+ XSETPVECTYPESIZE (v, PVEC_FREE, 0, nwords);
+ eassert (nbytes % roundup_size == 0);
+ ptrdiff_t vindex = VINDEX (nbytes);
+ eassert (vindex < VECTOR_MAX_FREE_LIST_INDEX);
+ set_next_vector (v, vector_free_lists[vindex]);
+ vector_free_lists[vindex] = v;
+ total_free_vector_slots += nbytes / word_size;
+}
+
/* Get a new vector block. */
static struct vector_block *
which should be set on an appropriate free list. */
restbytes = index * roundup_size + VBLOCK_BYTES_MIN - nbytes;
eassert (restbytes % roundup_size == 0);
- SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index);
+ setup_on_free_list (ADVANCE (vector, nbytes), restbytes);
return vector;
}
if (restbytes >= VBLOCK_BYTES_MIN)
{
eassert (restbytes % roundup_size == 0);
- SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index);
+ setup_on_free_list (ADVANCE (vector, nbytes), restbytes);
}
return vector;
}
space was coalesced into the only free vector. */
free_this_block = 1;
else
- {
- size_t tmp;
- SETUP_ON_FREE_LIST (vector, total_bytes, tmp);
- }
+ setup_on_free_list (vector, total_bytes);
}
}
block to the red-black tree with calls to mem_insert, and function
lisp_free removes it with mem_delete. Functions live_string_p etc
call mem_find to lookup information about a given pointer in the
- tree, and use that to determine if the pointer points to a Lisp
+ tree, and use that to determine if the pointer points into a Lisp
object or not. */
/* Initialize this part of alloc.c. */
}
-/* Value is non-zero if P is a pointer to a live Lisp string on
- the heap. M is a pointer to the mem_block for P. */
+/* If P is a pointer into a live Lisp string object on the heap,
+ return the object. Otherwise, return nil. M is a pointer to the
+ mem_block for P.
-static bool
-live_string_p (struct mem_node *m, void *p)
+ This and other *_holding functions look for a pointer anywhere into
+ the object, not merely for a pointer to the start of the object,
+ because some compilers sometimes optimize away the latter. See
+ Bug#28213. */
+
+static Lisp_Object
+live_string_holding (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_STRING)
{
struct string_block *b = m->start;
- ptrdiff_t offset = (char *) p - (char *) &b->strings[0];
+ char *cp = p;
+ ptrdiff_t offset = cp - (char *) &b->strings[0];
- /* P must point to the start of a Lisp_String structure, and it
+ /* P must point into a Lisp_String structure, and it
must not be on the free-list. */
- return (offset >= 0
- && offset % sizeof b->strings[0] == 0
- && offset < (STRING_BLOCK_SIZE * sizeof b->strings[0])
- && ((struct Lisp_String *) p)->data != NULL);
+ if (0 <= offset && offset < STRING_BLOCK_SIZE * sizeof b->strings[0])
+ {
+ struct Lisp_String *s = p = cp -= offset % sizeof b->strings[0];
+ if (s->data)
+ return make_lisp_ptr (s, Lisp_String);
+ }
}
- else
- return 0;
+ return Qnil;
}
+static bool
+live_string_p (struct mem_node *m, void *p)
+{
+ return !NILP (live_string_holding (m, p));
+}
-/* Value is non-zero if P is a pointer to a live Lisp cons on
- the heap. M is a pointer to the mem_block for P. */
+/* If P is a pointer into a live Lisp cons object on the heap, return
+ the object. Otherwise, return nil. M is a pointer to the
+ mem_block for P. */
-static bool
-live_cons_p (struct mem_node *m, void *p)
+static Lisp_Object
+live_cons_holding (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_CONS)
{
struct cons_block *b = m->start;
- ptrdiff_t offset = (char *) p - (char *) &b->conses[0];
+ char *cp = p;
+ ptrdiff_t offset = cp - (char *) &b->conses[0];
- /* P must point to the start of a Lisp_Cons, not be
+ /* P must point into a Lisp_Cons, not be
one of the unused cells in the current cons block,
and not be on the free-list. */
- return (offset >= 0
- && offset % sizeof b->conses[0] == 0
- && offset < (CONS_BLOCK_SIZE * sizeof b->conses[0])
- && (b != cons_block
- || offset / sizeof b->conses[0] < cons_block_index)
- && !EQ (((struct Lisp_Cons *) p)->car, Vdead));
+ if (0 <= offset && offset < CONS_BLOCK_SIZE * sizeof b->conses[0]
+ && (b != cons_block
+ || offset / sizeof b->conses[0] < cons_block_index))
+ {
+ struct Lisp_Cons *s = p = cp -= offset % sizeof b->conses[0];
+ if (!EQ (s->car, Vdead))
+ return make_lisp_ptr (s, Lisp_Cons);
+ }
}
- else
- return 0;
+ return Qnil;
}
+static bool
+live_cons_p (struct mem_node *m, void *p)
+{
+ return !NILP (live_cons_holding (m, p));
+}
-/* Value is non-zero if P is a pointer to a live Lisp symbol on
- the heap. M is a pointer to the mem_block for P. */
-static bool
-live_symbol_p (struct mem_node *m, void *p)
+/* If P is a pointer into a live Lisp symbol object on the heap,
+ return the object. Otherwise, return nil. M is a pointer to the
+ mem_block for P. */
+
+static Lisp_Object
+live_symbol_holding (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_SYMBOL)
{
struct symbol_block *b = m->start;
- ptrdiff_t offset = (char *) p - (char *) &b->symbols[0];
+ char *cp = p;
+ ptrdiff_t offset = cp - (char *) &b->symbols[0];
- /* P must point to the start of a Lisp_Symbol, not be
+ /* P must point into the Lisp_Symbol, not be
one of the unused cells in the current symbol block,
and not be on the free-list. */
- return (offset >= 0
- && offset % sizeof b->symbols[0] == 0
- && offset < (SYMBOL_BLOCK_SIZE * sizeof b->symbols[0])
- && (b != symbol_block
- || offset / sizeof b->symbols[0] < symbol_block_index)
- && !EQ (((struct Lisp_Symbol *)p)->function, Vdead));
+ if (0 <= offset && offset < SYMBOL_BLOCK_SIZE * sizeof b->symbols[0]
+ && (b != symbol_block
+ || offset / sizeof b->symbols[0] < symbol_block_index))
+ {
+ struct Lisp_Symbol *s = p = cp -= offset % sizeof b->symbols[0];
+ if (!EQ (s->function, Vdead))
+ return make_lisp_symbol (s);
+ }
}
- else
- return 0;
+ return Qnil;
}
+static bool
+live_symbol_p (struct mem_node *m, void *p)
+{
+ return !NILP (live_symbol_holding (m, p));
+}
-/* Value is non-zero if P is a pointer to a live Lisp float on
+
+/* 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. */
static bool
if (m->type == MEM_TYPE_FLOAT)
{
struct float_block *b = m->start;
- ptrdiff_t offset = (char *) p - (char *) &b->floats[0];
+ 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. */
}
-/* Value is non-zero if P is a pointer to a live Lisp Misc on
- the heap. M is a pointer to the mem_block for P. */
+/* If P is a pointer to a live Lisp Misc on the heap, return the object.
+ Otherwise, return nil. M is a pointer to the mem_block for P. */
-static bool
-live_misc_p (struct mem_node *m, void *p)
+static Lisp_Object
+live_misc_holding (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_MISC)
{
struct marker_block *b = m->start;
- ptrdiff_t offset = (char *) p - (char *) &b->markers[0];
+ char *cp = p;
+ ptrdiff_t offset = cp - (char *) &b->markers[0];
- /* P must point to the start of a Lisp_Misc, not be
+ /* P must point into a Lisp_Misc, not be
one of the unused cells in the current misc block,
and not be on the free-list. */
- return (offset >= 0
- && offset % sizeof b->markers[0] == 0
- && offset < (MARKER_BLOCK_SIZE * sizeof b->markers[0])
- && (b != marker_block
- || offset / sizeof b->markers[0] < marker_block_index)
- && ((union Lisp_Misc *) p)->u_any.type != Lisp_Misc_Free);
+ if (0 <= offset && offset < MARKER_BLOCK_SIZE * sizeof b->markers[0]
+ && (b != marker_block
+ || offset / sizeof b->markers[0] < marker_block_index))
+ {
+ union Lisp_Misc *s = p = cp -= offset % sizeof b->markers[0];
+ if (s->u_any.type != Lisp_Misc_Free)
+ return make_lisp_ptr (s, Lisp_Misc);
+ }
}
- else
- return 0;
+ return Qnil;
}
+static bool
+live_misc_p (struct mem_node *m, void *p)
+{
+ return !NILP (live_misc_holding (m, p));
+}
-/* Value is non-zero if P is a pointer to a live vector-like object.
+/* If P is a pointer to a live vector-like object, return the object.
+ Otherwise, return nil.
M is a pointer to the mem_block for P. */
-static bool
-live_vector_p (struct mem_node *m, void *p)
+static Lisp_Object
+live_vector_holding (struct mem_node *m, void *p)
{
+ struct Lisp_Vector *vp = p;
+
if (m->type == MEM_TYPE_VECTOR_BLOCK)
{
/* This memory node corresponds to a vector block. */
vector which is not on a free list. FIXME: check whether
some allocation patterns (probably a lot of short vectors)
may cause a substantial overhead of this loop. */
- while (VECTOR_IN_BLOCK (vector, block)
- && vector <= (struct Lisp_Vector *) p)
+ while (VECTOR_IN_BLOCK (vector, block) && vector <= vp)
{
- if (!PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) && vector == p)
- return true;
- else
- vector = ADVANCE (vector, vector_nbytes (vector));
+ struct Lisp_Vector *next = ADVANCE (vector, vector_nbytes (vector));
+ if (vp < next && !PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE))
+ return make_lisp_ptr (vector, Lisp_Vectorlike);
+ vector = next;
}
}
- 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;
+ else if (m->type == MEM_TYPE_VECTORLIKE)
+ {
+ /* This memory node corresponds to a large vector. */
+ struct Lisp_Vector *vector = large_vector_vec (m->start);
+ struct Lisp_Vector *next = ADVANCE (vector, vector_nbytes (vector));
+ if (vector <= vp && vp < next)
+ return make_lisp_ptr (vector, Lisp_Vectorlike);
+ }
+ return Qnil;
}
+static bool
+live_vector_p (struct mem_node *m, void *p)
+{
+ return !NILP (live_vector_holding (m, p));
+}
-/* Value is non-zero if P is a pointer to a live buffer. M is a
- pointer to the mem_block for P. */
+/* If P is a pointer into a live buffer, return the buffer.
+ Otherwise, return nil. M is a pointer to the mem_block for P. */
+
+static Lisp_Object
+live_buffer_holding (struct mem_node *m, void *p)
+{
+ /* P must point into the block, and the buffer
+ must not have been killed. */
+ if (m->type == MEM_TYPE_BUFFER)
+ {
+ struct buffer *b = m->start;
+ char *cb = m->start;
+ char *cp = p;
+ ptrdiff_t offset = cp - cb;
+ if (0 <= offset && offset < sizeof *b && !NILP (b->name_))
+ {
+ Lisp_Object obj;
+ XSETBUFFER (obj, b);
+ return obj;
+ }
+ }
+ return Qnil;
+}
static bool
live_buffer_p (struct mem_node *m, void *p)
{
- /* P must point to the start of the block, and the buffer
- must not have been killed. */
- return (m->type == MEM_TYPE_BUFFER
- && p == m->start
- && !NILP (((struct buffer *) p)->name_));
+ return !NILP (live_buffer_holding (m, p));
}
/* Mark OBJ if we can prove it's a Lisp_Object. */
switch (XTYPE (obj))
{
case Lisp_String:
- mark_p = (live_string_p (m, po)
- && !STRING_MARKED_P ((struct Lisp_String *) po));
+ mark_p = EQ (obj, live_string_holding (m, po));
break;
case Lisp_Cons:
- mark_p = (live_cons_p (m, po) && !CONS_MARKED_P (XCONS (obj)));
+ mark_p = EQ (obj, live_cons_holding (m, po));
break;
case Lisp_Symbol:
- mark_p = (live_symbol_p (m, po) && !XSYMBOL (obj)->gcmarkbit);
+ mark_p = EQ (obj, live_symbol_holding (m, po));
break;
case Lisp_Float:
- mark_p = (live_float_p (m, po) && !FLOAT_MARKED_P (XFLOAT (obj)));
+ mark_p = live_float_p (m, po);
break;
case Lisp_Vectorlike:
- /* Note: can't check BUFFERP before we know it's a
- buffer because checking that dereferences the pointer
- PO which might point anywhere. */
- if (live_vector_p (m, po))
- mark_p = !SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj));
- else if (live_buffer_p (m, po))
- mark_p = BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj));
+ mark_p = (EQ (obj, live_vector_holding (m, po))
+ || EQ (obj, live_buffer_holding (m, po)));
break;
case Lisp_Misc:
- mark_p = (live_misc_p (m, po) && !XMISCANY (obj)->gcmarkbit);
+ mark_p = EQ (obj, live_misc_holding (m, po));
break;
default:
break;
case MEM_TYPE_BUFFER:
- if (live_buffer_p (m, p) && !VECTOR_MARKED_P ((struct buffer *)p))
- XSETVECTOR (obj, p);
+ obj = live_buffer_holding (m, p);
break;
case MEM_TYPE_CONS:
- if (live_cons_p (m, p) && !CONS_MARKED_P ((struct Lisp_Cons *) p))
- XSETCONS (obj, p);
+ obj = live_cons_holding (m, p);
break;
case MEM_TYPE_STRING:
- if (live_string_p (m, p)
- && !STRING_MARKED_P ((struct Lisp_String *) p))
- XSETSTRING (obj, p);
+ obj = live_string_holding (m, p);
break;
case MEM_TYPE_MISC:
- if (live_misc_p (m, p) && !((struct Lisp_Free *) p)->gcmarkbit)
- XSETMISC (obj, p);
+ obj = live_misc_holding (m, p);
break;
case MEM_TYPE_SYMBOL:
- if (live_symbol_p (m, p) && !((struct Lisp_Symbol *) p)->gcmarkbit)
- XSETSYMBOL (obj, p);
+ obj = live_symbol_holding (m, p);
break;
case MEM_TYPE_FLOAT:
- if (live_float_p (m, p) && !FLOAT_MARKED_P (p))
- XSETFLOAT (obj, p);
+ if (live_float_p (m, p))
+ obj = make_lisp_ptr (p, Lisp_Float);
break;
case MEM_TYPE_VECTORLIKE:
case MEM_TYPE_VECTOR_BLOCK:
- if (live_vector_p (m, p))
- {
- Lisp_Object tem;
- XSETVECTOR (tem, p);
- if (!SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem)))
- obj = tem;
- }
+ obj = live_vector_holding (m, p);
break;
default:
projects / emacs.git / commitdiff