#endif
#ifdef WINDOWSNT
#include "w32.h"
+#include "w32heap.h" /* for sbrk */
#endif
#ifdef DOUG_LEA_MALLOC
static void mark_terminals (void);
static void gc_sweep (void);
static Lisp_Object make_pure_vector (ptrdiff_t);
-static void mark_glyph_matrix (struct glyph_matrix *);
-static void mark_face_cache (struct face_cache *);
static void mark_buffer (struct buffer *);
#if !defined REL_ALLOC || defined SYSTEM_MALLOC
static void refill_memory_reserve (void);
#endif
-static struct Lisp_String *allocate_string (void);
static void compact_small_strings (void);
static void free_large_strings (void);
-static void sweep_strings (void);
static void free_misc (Lisp_Object);
extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE;
-/* When scanning the C stack for live Lisp objects, Emacs keeps track
- of what memory allocated via lisp_malloc is intended for what
- purpose. This enumeration specifies the type of memory. */
+/* When scanning the C stack for live Lisp objects, Emacs keeps track of
+ what memory allocated via lisp_malloc and lisp_align_malloc is intended
+ for what purpose. This enumeration specifies the type of memory. */
enum mem_type
{
MEM_TYPE_MISC,
MEM_TYPE_SYMBOL,
MEM_TYPE_FLOAT,
- /* We used to keep separate mem_types for subtypes of vectors such as
- process, hash_table, frame, terminal, and window, but we never made
- use of the distinction, so it only caused source-code complexity
- and runtime slowdown. Minor but pointless. */
+ /* Since all non-bool pseudovectors are small enough to be
+ allocated from vector blocks, this memory type denotes
+ large regular vectors and large bool pseudovectors. */
MEM_TYPE_VECTORLIKE,
/* Special type to denote vector blocks. */
MEM_TYPE_VECTOR_BLOCK,
MEM_TYPE_SPARE
};
-static void *lisp_malloc (size_t, enum mem_type);
-
-
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
static void mem_rotate_right (struct mem_node *);
static void mem_delete (struct mem_node *);
static void mem_delete_fixup (struct mem_node *);
-static inline struct mem_node *mem_find (void *);
+static struct mem_node *mem_find (void *);
#endif
/* Addresses of staticpro'd variables. Initialize it to a nonzero
value; otherwise some compilers put it into BSS. */
-#define NSTATICS 0x650
+#define NSTATICS 0x800
static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
/* Index of next unused slot in staticvec. */
val = Fmake_vector (make_number (length_in_elts + extra_bool_elts), Qnil);
/* No Lisp_Object to trace in there. */
- XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0);
+ XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0);
p = XBOOL_VECTOR (val);
p->size = XFASTINT (length);
#define VINDEX(nbytes) (((nbytes) - VBLOCK_BYTES_MIN) / roundup_size)
+/* Get and set the next field in block-allocated vectorlike objects on
+ the free list. Doing it this way respects C's aliasing rules.
+ We could instead make 'contents' a union, but that would mean
+ changes everywhere that the code uses 'contents'. */
+static struct Lisp_Vector *
+next_in_free_list (struct Lisp_Vector *v)
+{
+ intptr_t i = XLI (v->contents[0]);
+ return (struct Lisp_Vector *) i;
+}
+static void
+set_next_in_free_list (struct Lisp_Vector *v, struct Lisp_Vector *next)
+{
+ v->contents[0] = XIL ((intptr_t) next);
+}
+
/* Common shortcut to setup vector on a free list. */
-#define SETUP_ON_FREE_LIST(v, nbytes, index) \
- do { \
- XSETPVECTYPESIZE (v, PVEC_FREE, nbytes); \
- eassert ((nbytes) % roundup_size == 0); \
- (index) = VINDEX (nbytes); \
- eassert ((index) < VECTOR_MAX_FREE_LIST_INDEX); \
- (v)->header.next.vector = vector_free_lists[index]; \
- vector_free_lists[index] = (v); \
- total_free_vector_slots += (nbytes) / word_size; \
+#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_in_free_list (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. */
+
+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 (sizeof (struct large_vector *))];
+#endif
+ } next;
+ struct Lisp_Vector v;
+};
+
+/* This internal type is used to maintain an underlying storage
+ for small vectors. */
+
struct vector_block
{
char data[VECTOR_BLOCK_BYTES];
/* Singly-linked list of large vectors. */
-static struct Lisp_Vector *large_vectors;
+static struct large_vector *large_vectors;
/* The only vector with 0 slots, allocated from pure space. */
static struct Lisp_Vector *
allocate_vector_from_block (size_t nbytes)
{
- struct Lisp_Vector *vector, *rest;
+ struct Lisp_Vector *vector;
struct vector_block *block;
size_t index, restbytes;
if (vector_free_lists[index])
{
vector = vector_free_lists[index];
- vector_free_lists[index] = vector->header.next.vector;
- vector->header.next.nbytes = nbytes;
+ vector_free_lists[index] = next_in_free_list (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->header.next.vector;
- vector->header.next.nbytes = nbytes;
+ vector_free_lists[index] = next_in_free_list (vector);
total_free_vector_slots -= nbytes / word_size;
/* Excess bytes are used for the smaller vector,
which should be set on an appropriate free list. */
restbytes = index * roundup_size + VBLOCK_BYTES_MIN - nbytes;
eassert (restbytes % roundup_size == 0);
- rest = ADVANCE (vector, nbytes);
- SETUP_ON_FREE_LIST (rest, restbytes, index);
+ SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index);
return vector;
}
/* New vector will be at the beginning of this block. */
vector = (struct Lisp_Vector *) block->data;
- vector->header.next.nbytes = nbytes;
/* If the rest of space from this block is large enough
for one-slot vector at least, set up it on a free list. */
if (restbytes >= VBLOCK_BYTES_MIN)
{
eassert (restbytes % roundup_size == 0);
- rest = ADVANCE (vector, nbytes);
- SETUP_ON_FREE_LIST (rest, restbytes, index);
+ SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index);
}
return vector;
- }
+}
/* Nonzero if VECTOR pointer is valid pointer inside BLOCK. */
((char *) (vector) <= (block)->data \
+ VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN)
-/* Number of bytes used by vector-block-allocated object. This is the only
- place where we actually use the `nbytes' field of the vector-header.
- I.e. we could get rid of the `nbytes' field by computing it based on the
- vector-type. */
+/* Return the memory footprint of V in bytes. */
-#define PSEUDOVECTOR_NBYTES(vector) \
- (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) \
- ? vector->header.size & PSEUDOVECTOR_SIZE_MASK \
- : vector->header.next.nbytes)
+static ptrdiff_t
+vector_nbytes (struct Lisp_Vector *v)
+{
+ ptrdiff_t size = v->header.size & ~ARRAY_MARK_FLAG;
+
+ if (size & PSEUDOVECTOR_FLAG)
+ {
+ if (PSEUDOVECTOR_TYPEP (&v->header, PVEC_BOOL_VECTOR))
+ size = (bool_header_size
+ + (((struct Lisp_Bool_Vector *) v)->size
+ + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR);
+ else
+ size = (header_size
+ + ((size & PSEUDOVECTOR_SIZE_MASK)
+ + ((size & PSEUDOVECTOR_REST_MASK)
+ >> PSEUDOVECTOR_SIZE_BITS)) * word_size);
+ }
+ else
+ size = header_size + size * word_size;
+ return vroundup (size);
+}
/* Reclaim space used by unmarked vectors. */
sweep_vectors (void)
{
struct vector_block *block = vector_blocks, **bprev = &vector_blocks;
- struct Lisp_Vector *vector, *next, **vprev = &large_vectors;
+ struct large_vector *lv, **lvprev = &large_vectors;
+ struct Lisp_Vector *vector, *next;
total_vectors = total_vector_slots = total_free_vector_slots = 0;
memset (vector_free_lists, 0, sizeof (vector_free_lists));
for (block = vector_blocks; block; block = *bprev)
{
bool free_this_block = 0;
+ ptrdiff_t nbytes;
for (vector = (struct Lisp_Vector *) block->data;
VECTOR_IN_BLOCK (vector, block); vector = next)
{
VECTOR_UNMARK (vector);
total_vectors++;
- total_vector_slots += vector->header.next.nbytes / word_size;
- next = ADVANCE (vector, vector->header.next.nbytes);
+ nbytes = vector_nbytes (vector);
+ total_vector_slots += nbytes / word_size;
+ next = ADVANCE (vector, nbytes);
}
else
{
- ptrdiff_t nbytes = PSEUDOVECTOR_NBYTES (vector);
- ptrdiff_t total_bytes = nbytes;
+ ptrdiff_t total_bytes;
+ nbytes = vector_nbytes (vector);
+ total_bytes = nbytes;
next = ADVANCE (vector, nbytes);
/* While NEXT is not marked, try to coalesce with VECTOR,
{
if (VECTOR_MARKED_P (next))
break;
- nbytes = PSEUDOVECTOR_NBYTES (next);
+ nbytes = vector_nbytes (next);
total_bytes += nbytes;
next = ADVANCE (next, nbytes);
}
/* Sweep large vectors. */
- for (vector = large_vectors; vector; vector = *vprev)
+ for (lv = large_vectors; lv; lv = *lvprev)
{
+ vector = &lv->v;
if (VECTOR_MARKED_P (vector))
{
VECTOR_UNMARK (vector);
else
total_vector_slots
+= header_size / word_size + vector->header.size;
- vprev = &vector->header.next.vector;
+ lvprev = &lv->next.vector;
}
else
{
- *vprev = vector->header.next.vector;
- lisp_free (vector);
+ *lvprev = lv->next.vector;
+ lisp_free (lv);
}
}
}
p = allocate_vector_from_block (vroundup (nbytes));
else
{
- p = lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE);
- p->header.next.vector = large_vectors;
- large_vectors = p;
+ struct large_vector *lv
+ = lisp_malloc (sizeof (*lv) + (len - 1) * word_size,
+ MEM_TYPE_VECTORLIKE);
+ lv->next.vector = large_vectors;
+ large_vectors = lv;
+ p = &lv->v;
}
#ifdef DOUG_LEA_MALLOC
/* Allocate other vector-like structures. */
struct Lisp_Vector *
-allocate_pseudovector (int memlen, int lisplen, int tag)
+allocate_pseudovector (int memlen, int lisplen, enum pvec_type tag)
{
struct Lisp_Vector *v = allocate_vectorlike (memlen);
int i;
+ /* Catch bogus values. */
+ eassert (tag <= PVEC_FONT);
+ eassert (memlen - lisplen <= (1 << PSEUDOVECTOR_REST_BITS) - 1);
+ eassert (lisplen <= (1 << PSEUDOVECTOR_SIZE_BITS) - 1);
+
/* Only the first lisplen slots will be traced normally by the GC. */
for (i = 0; i < lisplen; ++i)
v->contents[i] = Qnil;
- XSETPVECTYPESIZE (v, tag, lisplen);
+ XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen);
return v;
}
{
struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER);
- XSETPVECTYPESIZE (b, PVEC_BUFFER, (offsetof (struct buffer, own_text)
- - header_size) / word_size);
+ BUFFER_PVEC_INIT (b);
/* Put B on the chain of all buffers including killed ones. */
- b->header.next.buffer = all_buffers;
+ b->next = all_buffers;
all_buffers = b;
/* Note that the rest fields of B are not initialized. */
return b;
ptrdiff_t i;
register struct Lisp_Vector *p;
- /* We used to purecopy everything here, if purify-flga was set. This worked
+ /* We used to purecopy everything here, if purify-flag was set. This worked
OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
dangerous, since make-byte-code is used during execution to build
closures, so any closure built during the preload phase would end up
/* Value is a pointer to the mem_node containing START. Value is
MEM_NIL if there is no node in the tree containing START. */
-static inline struct mem_node *
+static struct mem_node *
mem_find (void *start)
{
struct mem_node *p;
/* 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. */
-static inline bool
+static bool
live_string_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_STRING)
/* 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. */
-static inline bool
+static bool
live_cons_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_CONS)
/* 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 inline bool
+static bool
live_symbol_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_SYMBOL)
/* Value is non-zero if P is a pointer to a live Lisp float on
the heap. M is a pointer to the mem_block for P. */
-static inline bool
+static bool
live_float_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_FLOAT)
/* 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. */
-static inline bool
+static bool
live_misc_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_MISC)
/* Value is non-zero if P is a pointer to a live vector-like object.
M is a pointer to the mem_block for P. */
-static inline bool
+static bool
live_vector_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_VECTOR_BLOCK)
while (VECTOR_IN_BLOCK (vector, block)
&& vector <= (struct Lisp_Vector *) p)
{
- if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE))
- vector = ADVANCE (vector, (vector->header.size
- & PSEUDOVECTOR_SIZE_MASK));
- else if (vector == p)
+ if (!PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) && vector == p)
return 1;
else
- vector = ADVANCE (vector, vector->header.next.nbytes);
+ vector = ADVANCE (vector, vector_nbytes (vector));
}
}
- else if (m->type == MEM_TYPE_VECTORLIKE && p == m->start)
+ else if (m->type == MEM_TYPE_VECTORLIKE
+ && (char *) p == ((char *) m->start
+ + offsetof (struct large_vector, v)))
/* This memory node corresponds to a large vector. */
return 1;
return 0;
/* Value is non-zero if P is a pointer to a live buffer. M is a
pointer to the mem_block for P. */
-static inline bool
+static bool
live_buffer_p (struct mem_node *m, void *p)
{
/* P must point to the start of the block, and the buffer
/* Mark OBJ if we can prove it's a Lisp_Object. */
-static inline void
+static void
mark_maybe_object (Lisp_Object obj)
{
void *po;
/* If P points to Lisp data, mark that as live if it isn't already
marked. */
-static inline void
+static void
mark_maybe_pointer (void *p)
{
struct mem_node *m;
{
staticvec[staticidx++] = varaddress;
if (staticidx >= NSTATICS)
- emacs_abort ();
+ fatal ("NSTATICS too small; try increasing and recompiling Emacs.");
}
\f
/* Used to avoid possible overflows when
converting from C to Lisp integers. */
-static inline Lisp_Object
+static Lisp_Object
bounded_number (EMACS_INT number)
{
return make_number (min (MOST_POSITIVE_FIXNUM, number));
if (ptr->header.size & PSEUDOVECTOR_FLAG)
pvectype = ((ptr->header.size & PVEC_TYPE_MASK)
- >> PSEUDOVECTOR_SIZE_BITS);
+ >> PSEUDOVECTOR_AREA_BITS);
else
- pvectype = 0;
+ pvectype = PVEC_NORMAL_VECTOR;
if (pvectype != PVEC_SUBR && pvectype != PVEC_BUFFER)
CHECK_LIVE (live_vector_p);
struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr;
mark_vectorlike (ptr);
+ mark_object (h->test.name);
+ mark_object (h->test.user_hash_function);
+ mark_object (h->test.user_cmp_function);
/* If hash table is not weak, mark all keys and values.
For weak tables, mark only the vector. */
if (NILP (h->weak))
/* Free all unmarked buffers */
{
- register struct buffer *buffer = all_buffers, *prev = 0, *next;
+ register struct buffer *buffer, **bprev = &all_buffers;
total_buffers = 0;
- while (buffer)
+ for (buffer = all_buffers; buffer; buffer = *bprev)
if (!VECTOR_MARKED_P (buffer))
{
- if (prev)
- prev->header.next = buffer->header.next;
- else
- all_buffers = buffer->header.next.buffer;
- next = buffer->header.next.buffer;
+ *bprev = buffer->next;
lisp_free (buffer);
- buffer = next;
}
else
{
/* Do not use buffer_(set|get)_intervals here. */
buffer->text->intervals = balance_intervals (buffer->text->intervals);
total_buffers++;
- prev = buffer, buffer = buffer->header.next.buffer;
+ bprev = &buffer->next;
}
}
/* When compiled with GCC, GDB might say "No enum type named
pvec_type" if we don't have at least one symbol with that type, and
then xbacktrace could fail. Similarly for the other enums and
- their values. */
+ their values. Some non-GCC compilers don't like these constructs. */
+#ifdef __GNUC__
union
{
enum CHARTAB_SIZE_BITS CHARTAB_SIZE_BITS;
enum lsb_bits lsb_bits;
#endif
} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0};
+#endif /* __GNUC__ */