/* Storage allocation and gc for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2011
- Free Software Foundation, Inc.
+
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2012
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "process.h"
#include "intervals.h"
#include "puresize.h"
+#include "character.h"
#include "buffer.h"
#include "window.h"
#include "keyboard.h"
#include "frame.h"
#include "blockinput.h"
-#include "character.h"
#include "syssignal.h"
#include "termhooks.h" /* For struct terminal. */
#include <setjmp.h>
#include <verify.h>
+/* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects.
+ Doable only if GC_MARK_STACK. */
+#if ! GC_MARK_STACK
+# undef GC_CHECK_MARKED_OBJECTS
+#endif
+
/* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
- memory. Can do this only if using gmalloc.c. */
+ memory. Can do this only if using gmalloc.c and if not checking
+ marked objects. */
-#if defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC
+#if (defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC \
+ || defined GC_CHECK_MARKED_OBJECTS)
#undef GC_MALLOC_CHECK
#endif
#include <unistd.h>
#ifndef HAVE_UNISTD_H
-extern POINTER_TYPE *sbrk ();
+extern void *sbrk ();
#endif
#include <fcntl.h>
extern size_t _bytes_used;
extern size_t __malloc_extra_blocks;
+extern void *_malloc_internal (size_t);
+extern void _free_internal (void *);
#endif /* not DOUG_LEA_MALLOC */
/* Index in pure at which next pure Lisp object will be allocated.. */
-static EMACS_INT pure_bytes_used_lisp;
+static ptrdiff_t pure_bytes_used_lisp;
/* Number of bytes allocated for non-Lisp objects in pure storage. */
-static EMACS_INT pure_bytes_used_non_lisp;
+static ptrdiff_t pure_bytes_used_non_lisp;
/* If nonzero, this is a warning delivered by malloc and not yet
displayed. */
static Lisp_Object Qpost_gc_hook;
-static void mark_buffer (Lisp_Object);
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 *);
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. */
- MEM_TYPE_VECTORLIKE
+ MEM_TYPE_VECTORLIKE,
+ /* Special type to denote vector blocks. */
+ MEM_TYPE_VECTOR_BLOCK
};
-static POINTER_TYPE *lisp_align_malloc (size_t, enum mem_type);
-static POINTER_TYPE *lisp_malloc (size_t, enum mem_type);
+static void *lisp_malloc (size_t, enum mem_type);
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
#ifdef GC_MALLOC_CHECK
enum mem_type allocated_mem_type;
-static int dont_register_blocks;
#endif /* GC_MALLOC_CHECK */
static struct mem_node mem_z;
#define MEM_NIL &mem_z
-static struct Lisp_Vector *allocate_vectorlike (EMACS_INT);
-static void lisp_free (POINTER_TYPE *);
+static struct Lisp_Vector *allocate_vectorlike (ptrdiff_t);
+static void lisp_free (void *);
static void mark_stack (void);
static int live_vector_p (struct mem_node *, void *);
static int live_buffer_p (struct mem_node *, void *);
static int live_misc_p (struct mem_node *, void *);
static void mark_maybe_object (Lisp_Object);
static void mark_memory (void *, void *);
+#if GC_MARK_STACK || defined GC_MALLOC_CHECK
static void mem_init (void);
static struct mem_node *mem_insert (void *, void *, enum mem_type);
static void mem_insert_fixup (struct mem_node *);
+#endif
static void mem_rotate_left (struct mem_node *);
static void mem_rotate_right (struct mem_node *);
static void mem_delete (struct mem_node *);
/* Addresses of staticpro'd variables. Initialize it to a nonzero
value; otherwise some compilers put it into BSS. */
-#define NSTATICS 0x640
+#define NSTATICS 0x650
static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
/* Index of next unused slot in staticvec. */
static int staticidx = 0;
-static POINTER_TYPE *pure_alloc (size_t, int);
+static void *pure_alloc (size_t, int);
/* Value is SZ rounded up to the next multiple of ALIGNMENT.
ALIGNMENT must be a power of 2. */
#define ALIGN(ptr, ALIGNMENT) \
- ((POINTER_TYPE *) ((((uintptr_t) (ptr)) + (ALIGNMENT) - 1) \
- & ~((ALIGNMENT) - 1)))
+ ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \
+ & ~ ((ALIGNMENT) - 1)))
\f
/* Called if we can't allocate relocatable space for a buffer. */
void
-buffer_memory_full (EMACS_INT nbytes)
+buffer_memory_full (ptrdiff_t nbytes)
{
/* If buffers use the relocating allocator, no need to free
spare_memory, because we may have plenty of malloc space left
xsignal (Qnil, Vmemory_signal_data);
}
+/* A common multiple of the positive integers A and B. Ideally this
+ would be the least common multiple, but there's no way to do that
+ as a constant expression in C, so do the best that we can easily do. */
+#define COMMON_MULTIPLE(a, b) \
+ ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b))
#ifndef XMALLOC_OVERRUN_CHECK
#define XMALLOC_OVERRUN_CHECK_OVERHEAD 0
char c; \
}, \
c)
-#ifdef USE_LSB_TAG
-/* A common multiple of the positive integers A and B. Ideally this
- would be the least common multiple, but there's no way to do that
- as a constant expression in C, so do the best that we can easily do. */
-# define COMMON_MULTIPLE(a, b) \
- ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b))
+
+#if USE_LSB_TAG
# define XMALLOC_HEADER_ALIGNMENT \
COMMON_MULTIPLE (1 << GCTYPEBITS, XMALLOC_BASE_ALIGNMENT)
#else
/* Like malloc, but wraps allocated block with header and trailer. */
-static POINTER_TYPE *
+static void *
overrun_check_malloc (size_t size)
{
register unsigned char *val;
if (SIZE_MAX - overhead < size)
abort ();
- val = (unsigned char *) malloc (size + overhead);
+ val = malloc (size + overhead);
if (val && check_depth == 1)
{
memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
XMALLOC_OVERRUN_CHECK_SIZE);
}
--check_depth;
- return (POINTER_TYPE *)val;
+ return val;
}
/* Like realloc, but checks old block for overrun, and wraps new block
with header and trailer. */
-static POINTER_TYPE *
-overrun_check_realloc (POINTER_TYPE *block, size_t size)
+static void *
+overrun_check_realloc (void *block, size_t size)
{
register unsigned char *val = (unsigned char *) block;
int overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_OVERHEAD : 0;
memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE);
}
- val = (unsigned char *) realloc ((POINTER_TYPE *)val, size + overhead);
+ val = realloc (val, size + overhead);
if (val && check_depth == 1)
{
XMALLOC_OVERRUN_CHECK_SIZE);
}
--check_depth;
- return (POINTER_TYPE *)val;
+ return val;
}
/* Like free, but checks block for overrun. */
static void
-overrun_check_free (POINTER_TYPE *block)
+overrun_check_free (void *block)
{
unsigned char *val = (unsigned char *) block;
/* Like malloc but check for no memory and block interrupt input.. */
-POINTER_TYPE *
+void *
xmalloc (size_t size)
{
- register POINTER_TYPE *val;
+ void *val;
MALLOC_BLOCK_INPUT;
- val = (POINTER_TYPE *) malloc (size);
+ val = malloc (size);
MALLOC_UNBLOCK_INPUT;
if (!val && size)
return val;
}
+/* Like the above, but zeroes out the memory just allocated. */
+
+void *
+xzalloc (size_t size)
+{
+ void *val;
+
+ MALLOC_BLOCK_INPUT;
+ val = malloc (size);
+ MALLOC_UNBLOCK_INPUT;
+
+ if (!val && size)
+ memory_full (size);
+ memset (val, 0, size);
+ return val;
+}
/* Like realloc but check for no memory and block interrupt input.. */
-POINTER_TYPE *
-xrealloc (POINTER_TYPE *block, size_t size)
+void *
+xrealloc (void *block, size_t size)
{
- register POINTER_TYPE *val;
+ void *val;
MALLOC_BLOCK_INPUT;
/* We must call malloc explicitly when BLOCK is 0, since some
reallocs don't do this. */
if (! block)
- val = (POINTER_TYPE *) malloc (size);
+ val = malloc (size);
else
- val = (POINTER_TYPE *) realloc (block, size);
+ val = realloc (block, size);
MALLOC_UNBLOCK_INPUT;
if (!val && size)
/* Like free but block interrupt input. */
void
-xfree (POINTER_TYPE *block)
+xfree (void *block)
{
if (!block)
return;
void *
xnmalloc (ptrdiff_t nitems, ptrdiff_t item_size)
{
- xassert (0 <= nitems && 0 < item_size);
+ eassert (0 <= nitems && 0 < item_size);
if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems)
memory_full (SIZE_MAX);
return xmalloc (nitems * item_size);
void *
xnrealloc (void *pa, ptrdiff_t nitems, ptrdiff_t item_size)
{
- xassert (0 <= nitems && 0 < item_size);
+ eassert (0 <= nitems && 0 < item_size);
if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems)
memory_full (SIZE_MAX);
return xrealloc (pa, nitems * item_size);
ptrdiff_t nitems_incr_max = n_max - n;
ptrdiff_t incr = max (nitems_incr_min, min (incr_estimate, nitems_incr_max));
- xassert (0 < item_size && 0 < nitems_incr_min && 0 <= n && -1 <= nitems_max);
+ eassert (0 < item_size && 0 < nitems_incr_min && 0 <= n && -1 <= nitems_max);
if (! pa)
*nitems = 0;
if (nitems_incr_max < incr)
xstrdup (const char *s)
{
size_t len = strlen (s) + 1;
- char *p = (char *) xmalloc (len);
+ char *p = xmalloc (len);
memcpy (p, s, len);
return p;
}
number of bytes to allocate, TYPE describes the intended use of the
allocated memory block (for strings, for conses, ...). */
-#ifndef USE_LSB_TAG
-static void *lisp_malloc_loser;
+#if ! USE_LSB_TAG
+void *lisp_malloc_loser EXTERNALLY_VISIBLE;
#endif
-static POINTER_TYPE *
+static void *
lisp_malloc (size_t nbytes, enum mem_type type)
{
register void *val;
allocated_mem_type = type;
#endif
- val = (void *) malloc (nbytes);
+ val = malloc (nbytes);
-#ifndef USE_LSB_TAG
+#if ! USE_LSB_TAG
/* If the memory just allocated cannot be addressed thru a Lisp
object's pointer, and it needs to be,
that's equivalent to running out of memory. */
call to lisp_malloc. */
static void
-lisp_free (POINTER_TYPE *block)
+lisp_free (void *block)
{
MALLOC_BLOCK_INPUT;
free (block);
MALLOC_UNBLOCK_INPUT;
}
-/* Allocation of aligned blocks of memory to store Lisp data. */
-/* 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. */
+/***** Allocation of aligned blocks of memory to store Lisp data. *****/
+
+/* 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. */
-/* Use posix_memalloc if the system has it and we're using the system's
- malloc (because our gmalloc.c routines don't have posix_memalign although
- its memalloc could be used). */
#if defined (HAVE_POSIX_MEMALIGN) && defined (SYSTEM_MALLOC)
#define USE_POSIX_MEMALIGN 1
#endif
struct ablock blocks[ABLOCKS_SIZE];
};
-/* Size of the block requested from malloc or memalign. */
+/* Size of the block requested from malloc or posix_memalign. */
#define ABLOCKS_BYTES (sizeof (struct ablocks) - BLOCK_PADDING)
#define ABLOCK_ABASE(block) \
/* Allocate an aligned block of nbytes.
Alignment is on a multiple of BLOCK_ALIGN and `nbytes' has to be
smaller or equal to BLOCK_BYTES. */
-static POINTER_TYPE *
+static void *
lisp_align_malloc (size_t nbytes, enum mem_type type)
{
void *base, *val;
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif
-#ifndef USE_LSB_TAG
+#if ! USE_LSB_TAG
/* If the memory just allocated cannot be addressed thru a Lisp
object's pointer, and it needs to be, that's equivalent to
running out of memory. */
#endif
/* Initialize the blocks and put them on the free list.
- Is `base' was not properly aligned, we can't use the last block. */
+ If `base' was not properly aligned, we can't use the last block. */
for (i = 0; i < (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1); i++)
{
abase->blocks[i].abase = abase;
}
static void
-lisp_align_free (POINTER_TYPE *block)
+lisp_align_free (void *block)
{
struct ablock *ablock = block;
struct ablocks *abase = ABLOCK_ABASE (ablock);
ablock->x.next_free = free_ablock;
free_ablock = ablock;
/* Update busy count. */
- ABLOCKS_BUSY (abase) =
- (struct ablocks *) (-2 + (intptr_t) ABLOCKS_BUSY (abase));
+ ABLOCKS_BUSY (abase)
+ = (struct ablocks *) (-2 + (intptr_t) ABLOCKS_BUSY (abase));
if (2 > (intptr_t) ABLOCKS_BUSY (abase))
{ /* All the blocks are free. */
MALLOC_UNBLOCK_INPUT;
}
-/* Return a new buffer structure allocated from the heap with
- a call to lisp_malloc. */
-
-struct buffer *
-allocate_buffer (void)
-{
- struct buffer *b
- = (struct buffer *) lisp_malloc (sizeof (struct buffer),
- MEM_TYPE_BUFFER);
- XSETPVECTYPESIZE (b, PVEC_BUFFER,
- ((sizeof (struct buffer) + sizeof (EMACS_INT) - 1)
- / sizeof (EMACS_INT)));
- return b;
-}
-
\f
#ifndef SYSTEM_MALLOC
# define BYTES_USED _bytes_used
#endif
+#ifdef GC_MALLOC_CHECK
+static int dont_register_blocks;
+#endif
+
static size_t bytes_used_when_reconsidered;
/* Value of _bytes_used, when spare_memory was freed. */
__malloc_extra_blocks = malloc_hysteresis;
#endif
- value = (void *) malloc (size);
+ value = malloc (size);
#ifdef GC_MALLOC_CHECK
{
{
fprintf (stderr, "Malloc returned %p which is already in use\n",
value);
- fprintf (stderr, "Region in use is %p...%p, %u bytes, type %d\n",
+ fprintf (stderr, "Region in use is %p...%p, %td bytes, type %d\n",
m->start, m->end, (char *) m->end - (char *) m->start,
m->type);
abort ();
dont_register_blocks = 1;
#endif /* GC_MALLOC_CHECK */
- value = (void *) realloc (ptr, size);
+ value = realloc (ptr, size);
#ifdef GC_MALLOC_CHECK
dont_register_blocks = 0;
{
if (interval_block_index == INTERVAL_BLOCK_SIZE)
{
- register struct interval_block *newi;
-
- newi = (struct interval_block *) lisp_malloc (sizeof *newi,
- MEM_TYPE_NON_LISP);
+ struct interval_block *newi
+ = lisp_malloc (sizeof *newi, MEM_TYPE_NON_LISP);
newi->next = interval_block;
interval_block = newi;
}
-/* Mark Lisp objects in interval I. */
+/* Mark Lisp objects in interval I. */
static void
mark_interval (register INTERVAL i, Lisp_Object dummy)
if (! NULL_INTERVAL_P (i)) \
(i) = balance_intervals (i); \
} while (0)
-
-\f
-/* Number support. If USE_LISP_UNION_TYPE is in effect, we
- can't create number objects in macros. */
-#ifndef make_number
-Lisp_Object
-make_number (EMACS_INT n)
-{
- Lisp_Object obj;
- obj.s.val = n;
- obj.s.type = Lisp_Int;
- return obj;
-}
-#endif
\f
/***********************************************************************
String Allocation
#ifdef GC_CHECK_STRING_BYTES
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
unsigned char data[1];
#define SDATA_NBYTES(S) (S)->nbytes
unsigned char data[1];
/* When STRING is null. */
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
} u;
#define SDATA_NBYTES(S) (S)->u.nbytes
#define SDATA_SIZE(NBYTES) \
((SDATA_DATA_OFFSET \
+ (NBYTES) + 1 \
- + sizeof (EMACS_INT) - 1) \
- & ~(sizeof (EMACS_INT) - 1))
+ + sizeof (ptrdiff_t) - 1) \
+ & ~(sizeof (ptrdiff_t) - 1))
#else /* not GC_CHECK_STRING_BYTES */
/* The 'max' reserves space for the nbytes union member even when NBYTES + 1 is
less than the size of that member. The 'max' is not needed when
- SDATA_DATA_OFFSET is a multiple of sizeof (EMACS_INT), because then the
+ SDATA_DATA_OFFSET is a multiple of sizeof (ptrdiff_t), because then the
alignment code reserves enough space. */
#define SDATA_SIZE(NBYTES) \
((SDATA_DATA_OFFSET \
- + (SDATA_DATA_OFFSET % sizeof (EMACS_INT) == 0 \
+ + (SDATA_DATA_OFFSET % sizeof (ptrdiff_t) == 0 \
? NBYTES \
- : max (NBYTES, sizeof (EMACS_INT) - 1)) \
+ : max (NBYTES, sizeof (ptrdiff_t) - 1)) \
+ 1 \
- + sizeof (EMACS_INT) - 1) \
- & ~(sizeof (EMACS_INT) - 1))
+ + sizeof (ptrdiff_t) - 1) \
+ & ~(sizeof (ptrdiff_t) - 1))
#endif /* not GC_CHECK_STRING_BYTES */
/* Like GC_STRING_BYTES, but with debugging check. */
-EMACS_INT
+ptrdiff_t
string_bytes (struct Lisp_String *s)
{
- EMACS_INT nbytes =
+ ptrdiff_t nbytes =
(s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
if (!PURE_POINTER_P (s)
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
/* Check that the string size recorded in the string is the
- same as the one recorded in the sdata structure. */
+ same as the one recorded in the sdata structure. */
if (from->string)
CHECK_STRING_BYTES (from->string);
for (b = oldest_sblock; b; b = b->next)
check_sblock (b);
}
- else
+ else if (current_sblock)
check_sblock (current_sblock);
}
add all the Lisp_Strings in it to the free-list. */
if (string_free_list == NULL)
{
- struct string_block *b;
+ struct string_block *b = lisp_malloc (sizeof *b, MEM_TYPE_STRING);
int i;
- b = (struct string_block *) lisp_malloc (sizeof *b, MEM_TYPE_STRING);
- memset (b, 0, sizeof *b);
b->next = string_blocks;
string_blocks = b;
for (i = STRING_BLOCK_SIZE - 1; i >= 0; --i)
{
s = b->strings + i;
+ /* Every string on a free list should have NULL data pointer. */
+ s->data = NULL;
NEXT_FREE_LISP_STRING (s) = string_free_list;
string_free_list = s;
}
MALLOC_UNBLOCK_INPUT;
- /* Probably not strictly necessary, but play it safe. */
- memset (s, 0, sizeof *s);
-
--total_free_strings;
++total_strings;
++strings_consed;
allocate_string_data (struct Lisp_String *s,
EMACS_INT nchars, EMACS_INT nbytes)
{
- struct sdata *data, *old_data;
+ struct sdata *data;
struct sblock *b;
- EMACS_INT needed, old_nbytes;
+ ptrdiff_t needed;
if (STRING_BYTES_MAX < nbytes)
string_overflow ();
/* Determine the number of bytes needed to store NBYTES bytes
of string data. */
needed = SDATA_SIZE (nbytes);
- old_data = s->data ? SDATA_OF_STRING (s) : NULL;
- old_nbytes = GC_STRING_BYTES (s);
MALLOC_BLOCK_INPUT;
mallopt (M_MMAP_MAX, 0);
#endif
- b = (struct sblock *) lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP);
+ b = lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP);
#ifdef DOUG_LEA_MALLOC
/* Back to a reasonable maximum of mmap'ed areas. */
< (needed + GC_STRING_EXTRA)))
{
/* Not enough room in the current sblock. */
- b = (struct sblock *) lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP);
+ b = lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP);
b->next_free = &b->first_data;
b->first_data.string = NULL;
b->next = NULL;
memcpy ((char *) data + needed, string_overrun_cookie,
GC_STRING_OVERRUN_COOKIE_SIZE);
#endif
-
- /* If S had already data assigned, mark that as free by setting its
- string back-pointer to null, and recording the size of the data
- in it. */
- if (old_data)
- {
- SDATA_NBYTES (old_data) = old_nbytes;
- old_data->string = NULL;
- }
-
consing_since_gc += needed;
}
for (b = oldest_sblock; b; b = b->next)
{
end = b->next_free;
- xassert ((char *) end <= (char *) b + SBLOCK_SIZE);
+ eassert ((char *) end <= (char *) b + SBLOCK_SIZE);
for (from = &b->first_data; from < end; from = from_end)
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
- EMACS_INT nbytes;
+ ptrdiff_t nbytes;
#ifdef GC_CHECK_STRING_BYTES
/* Check that the string size recorded in the string is the
/* Copy, and update the string's `data' pointer. */
if (from != to)
{
- xassert (tb != b || to < from);
+ eassert (tb != b || to < from);
memmove (to, from, nbytes + GC_STRING_EXTRA);
to->string->data = SDATA_DATA (to);
}
{
register Lisp_Object val;
struct Lisp_Bool_Vector *p;
- EMACS_INT length_in_chars, length_in_elts;
+ ptrdiff_t length_in_chars;
+ EMACS_INT length_in_elts;
int bits_per_value;
CHECK_NATNUM (length);
bits_per_value = sizeof (EMACS_INT) * BOOL_VECTOR_BITS_PER_CHAR;
length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;
- length_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR);
/* We must allocate one more elements than LENGTH_IN_ELTS for the
slot `size' of the struct Lisp_Bool_Vector. */
p = XBOOL_VECTOR (val);
p->size = XFASTINT (length);
+ length_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR);
if (length_in_chars)
{
memset (p->data, ! NILP (init) ? -1 : 0, length_in_chars);
multibyte, depending on the contents. */
Lisp_Object
-make_string (const char *contents, EMACS_INT nbytes)
+make_string (const char *contents, ptrdiff_t nbytes)
{
register Lisp_Object val;
- EMACS_INT nchars, multibyte_nbytes;
+ ptrdiff_t nchars, multibyte_nbytes;
parse_str_as_multibyte ((const unsigned char *) contents, nbytes,
&nchars, &multibyte_nbytes);
/* Make an unibyte string from LENGTH bytes at CONTENTS. */
Lisp_Object
-make_unibyte_string (const char *contents, EMACS_INT length)
+make_unibyte_string (const char *contents, ptrdiff_t length)
{
register Lisp_Object val;
val = make_uninit_string (length);
Lisp_Object
make_multibyte_string (const char *contents,
- EMACS_INT nchars, EMACS_INT nbytes)
+ ptrdiff_t nchars, ptrdiff_t nbytes)
{
register Lisp_Object val;
val = make_uninit_multibyte_string (nchars, nbytes);
Lisp_Object
make_string_from_bytes (const char *contents,
- EMACS_INT nchars, EMACS_INT nbytes)
+ ptrdiff_t nchars, ptrdiff_t nbytes)
{
register Lisp_Object val;
val = make_uninit_multibyte_string (nchars, nbytes);
Lisp_Object
make_specified_string (const char *contents,
- EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
+ ptrdiff_t nchars, ptrdiff_t nbytes, int multibyte)
{
register Lisp_Object val;
}
-/* Make a string from the data at STR, treating it as multibyte if the
- data warrants. */
-
-Lisp_Object
-build_string (const char *str)
-{
- return make_string (str, strlen (str));
-}
-
-
/* Return an unibyte Lisp_String set up to hold LENGTH characters
occupying LENGTH bytes. */
return empty_multibyte_string;
s = allocate_string ();
+ s->intervals = NULL_INTERVAL;
allocate_string_data (s, nchars, nbytes);
XSETSTRING (string, s);
string_chars_consed += nbytes;
return string;
}
+/* Print arguments to BUF according to a FORMAT, then return
+ a Lisp_String initialized with the data from BUF. */
+
+Lisp_Object
+make_formatted_string (char *buf, const char *format, ...)
+{
+ va_list ap;
+ int length;
+
+ va_start (ap, format);
+ length = vsprintf (buf, format, ap);
+ va_end (ap);
+ return make_string (buf, length);
+}
\f
/***********************************************************************
{
if (float_block_index == FLOAT_BLOCK_SIZE)
{
- register struct float_block *new;
-
- new = (struct float_block *) lisp_align_malloc (sizeof *new,
- MEM_TYPE_FLOAT);
+ struct float_block *new
+ = lisp_align_malloc (sizeof *new, MEM_TYPE_FLOAT);
new->next = float_block;
memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
float_block = new;
GC are put on a free list to be reallocated before allocating
any new cons cells from the latest cons_block. */
-#define CONS_BLOCK_SIZE \
- (((BLOCK_BYTES - sizeof (struct cons_block *)) * CHAR_BIT) \
+#define CONS_BLOCK_SIZE \
+ (((BLOCK_BYTES - sizeof (struct cons_block *) \
+ /* The compiler might add padding at the end. */ \
+ - (sizeof (struct Lisp_Cons) - sizeof (int))) * CHAR_BIT) \
/ (sizeof (struct Lisp_Cons) * CHAR_BIT + 1))
#define CONS_BLOCK(fptr) \
{
if (cons_block_index == CONS_BLOCK_SIZE)
{
- register struct cons_block *new;
- new = (struct cons_block *) lisp_align_malloc (sizeof *new,
- MEM_TYPE_CONS);
+ struct cons_block *new
+ = lisp_align_malloc (sizeof *new, MEM_TYPE_CONS);
memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
new->next = cons_block;
cons_block = new;
Vector Allocation
***********************************************************************/
-/* Singly-linked list of all vectors. */
+/* 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). */
-static struct Lisp_Vector *all_vectors;
+#define VECTOR_BLOCK_SIZE 4096
/* Handy constants for vectorlike objects. */
enum
{
header_size = offsetof (struct Lisp_Vector, contents),
- word_size = sizeof (Lisp_Object)
+ word_size = sizeof (Lisp_Object),
+ roundup_size = COMMON_MULTIPLE (sizeof (Lisp_Object),
+ USE_LSB_TAG ? 1 << GCTYPEBITS : 1)
};
+/* ROUNDUP_SIZE must be a power of 2. */
+verify ((roundup_size & (roundup_size - 1)) == 0);
+
+/* Verify assumptions described above. */
+verify ((VECTOR_BLOCK_SIZE % roundup_size) == 0);
+verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS));
+
+/* Round up X to nearest mult-of-ROUNDUP_SIZE. */
+
+#define vroundup(x) (((x) + (roundup_size - 1)) & ~(roundup_size - 1))
+
+/* Rounding helps to maintain alignment constraints if USE_LSB_TAG. */
+
+#define VECTOR_BLOCK_BYTES (VECTOR_BLOCK_SIZE - vroundup (sizeof (void *)))
+
+/* Size of the minimal vector allocated from block. */
+
+#define VBLOCK_BYTES_MIN vroundup (sizeof (struct Lisp_Vector))
+
+/* Size of the largest vector allocated from block. */
+
+#define VBLOCK_BYTES_MAX \
+ vroundup ((VECTOR_BLOCK_BYTES / 2) - sizeof (Lisp_Object))
+
+/* We maintain one free list for each possible block-allocated
+ vector size, and this is the number of free lists we have. */
+
+#define VECTOR_MAX_FREE_LIST_INDEX \
+ ((VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) / roundup_size + 1)
+
+/* Common shortcut to advance vector pointer over a block data. */
+
+#define ADVANCE(v, nbytes) ((struct Lisp_Vector *) ((char *) (v) + (nbytes)))
+
+/* 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, 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); \
+ } while (0)
+
+struct vector_block
+{
+ char data[VECTOR_BLOCK_BYTES];
+ struct vector_block *next;
+};
+
+/* Chain of vector blocks. */
+
+static struct vector_block *vector_blocks;
+
+/* Vector free lists, where NTH item points to a chain of free
+ vectors of the same NBYTES size, so NTH == VINDEX (NBYTES). */
+
+static struct Lisp_Vector *vector_free_lists[VECTOR_MAX_FREE_LIST_INDEX];
+
+/* Singly-linked list of large vectors. */
+
+static struct Lisp_Vector *large_vectors;
+
+/* The only vector with 0 slots, allocated from pure space. */
+
+static struct Lisp_Vector *zero_vector;
+
+/* Get a new vector block. */
+
+static struct vector_block *
+allocate_vector_block (void)
+{
+ struct vector_block *block = xmalloc (sizeof *block);
+
+#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+ mem_insert (block->data, block->data + VECTOR_BLOCK_BYTES,
+ MEM_TYPE_VECTOR_BLOCK);
+#endif
+
+ block->next = vector_blocks;
+ vector_blocks = block;
+ return block;
+}
+
+/* Called once to initialize vector allocation. */
+
+static void
+init_vectors (void)
+{
+ zero_vector = pure_alloc (header_size, Lisp_Vectorlike);
+ zero_vector->header.size = 0;
+}
+
+/* Allocate vector from a vector block. */
+
+static struct Lisp_Vector *
+allocate_vector_from_block (size_t nbytes)
+{
+ struct Lisp_Vector *vector, *rest;
+ struct vector_block *block;
+ size_t index, restbytes;
+
+ eassert (VBLOCK_BYTES_MIN <= nbytes && nbytes <= VBLOCK_BYTES_MAX);
+ eassert (nbytes % roundup_size == 0);
+
+ /* First, try to allocate from a free list
+ containing vectors of the requested size. */
+ index = VINDEX (nbytes);
+ if (vector_free_lists[index])
+ {
+ vector = vector_free_lists[index];
+ vector_free_lists[index] = vector->header.next.vector;
+ vector->header.next.nbytes = nbytes;
+ return vector;
+ }
+
+ /* Next, check free lists containing larger vectors. Since
+ we will split the result, we should have remaining space
+ large enough to use for one-slot vector at least. */
+ for (index = VINDEX (nbytes + VBLOCK_BYTES_MIN);
+ index < VECTOR_MAX_FREE_LIST_INDEX; index++)
+ if (vector_free_lists[index])
+ {
+ /* This vector is larger than requested. */
+ vector = vector_free_lists[index];
+ vector_free_lists[index] = vector->header.next.vector;
+ vector->header.next.nbytes = nbytes;
+
+ /* 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);
+ return vector;
+ }
+
+ /* Finally, need a new vector block. */
+ block = allocate_vector_block ();
+
+ /* 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. */
+ restbytes = VECTOR_BLOCK_BYTES - nbytes;
+ if (restbytes >= VBLOCK_BYTES_MIN)
+ {
+ eassert (restbytes % roundup_size == 0);
+ rest = ADVANCE (vector, nbytes);
+ SETUP_ON_FREE_LIST (rest, restbytes, index);
+ }
+ return vector;
+ }
+
+/* Return how many Lisp_Objects can be stored in V. */
+
+#define VECTOR_SIZE(v) ((v)->header.size & PSEUDOVECTOR_FLAG ? \
+ (PSEUDOVECTOR_SIZE_MASK & (v)->header.size) : \
+ (v)->header.size)
+
+/* Nonzero if VECTOR pointer is valid pointer inside BLOCK. */
+
+#define VECTOR_IN_BLOCK(vector, 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. */
+
+#define PSEUDOVECTOR_NBYTES(vector) \
+ (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) \
+ ? vector->header.size & PSEUDOVECTOR_SIZE_MASK \
+ : vector->header.next.nbytes)
+
+/* Reclaim space used by unmarked vectors. */
+
+static void
+sweep_vectors (void)
+{
+ struct vector_block *block = vector_blocks, **bprev = &vector_blocks;
+ struct Lisp_Vector *vector, *next, **vprev = &large_vectors;
+
+ total_vector_size = 0;
+ memset (vector_free_lists, 0, sizeof (vector_free_lists));
+
+ /* Looking through vector blocks. */
+
+ for (block = vector_blocks; block; block = *bprev)
+ {
+ int free_this_block = 0;
+
+ for (vector = (struct Lisp_Vector *) block->data;
+ VECTOR_IN_BLOCK (vector, block); vector = next)
+ {
+ if (VECTOR_MARKED_P (vector))
+ {
+ VECTOR_UNMARK (vector);
+ total_vector_size += VECTOR_SIZE (vector);
+ next = ADVANCE (vector, vector->header.next.nbytes);
+ }
+ else
+ {
+ ptrdiff_t nbytes = PSEUDOVECTOR_NBYTES (vector);
+ ptrdiff_t total_bytes = nbytes;
+
+ next = ADVANCE (vector, nbytes);
+
+ /* While NEXT is not marked, try to coalesce with VECTOR,
+ thus making VECTOR of the largest possible size. */
+
+ while (VECTOR_IN_BLOCK (next, block))
+ {
+ if (VECTOR_MARKED_P (next))
+ break;
+ nbytes = PSEUDOVECTOR_NBYTES (next);
+ total_bytes += nbytes;
+ next = ADVANCE (next, nbytes);
+ }
+
+ eassert (total_bytes % roundup_size == 0);
+
+ if (vector == (struct Lisp_Vector *) block->data
+ && !VECTOR_IN_BLOCK (next, block))
+ /* This block should be freed because all of it's
+ space was coalesced into the only free vector. */
+ free_this_block = 1;
+ else
+ {
+ int tmp;
+ SETUP_ON_FREE_LIST (vector, total_bytes, tmp);
+ }
+ }
+ }
+
+ if (free_this_block)
+ {
+ *bprev = block->next;
+#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+ mem_delete (mem_find (block->data));
+#endif
+ xfree (block);
+ }
+ else
+ bprev = &block->next;
+ }
+
+ /* Sweep large vectors. */
+
+ for (vector = large_vectors; vector; vector = *vprev)
+ {
+ if (VECTOR_MARKED_P (vector))
+ {
+ VECTOR_UNMARK (vector);
+ total_vector_size += VECTOR_SIZE (vector);
+ vprev = &vector->header.next.vector;
+ }
+ else
+ {
+ *vprev = vector->header.next.vector;
+ lisp_free (vector);
+ }
+ }
+}
+
/* Value is a pointer to a newly allocated Lisp_Vector structure
with room for LEN Lisp_Objects. */
static struct Lisp_Vector *
-allocate_vectorlike (EMACS_INT len)
+allocate_vectorlike (ptrdiff_t len)
{
struct Lisp_Vector *p;
- size_t nbytes;
MALLOC_BLOCK_INPUT;
-#ifdef DOUG_LEA_MALLOC
- /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
- because mapped region contents are not preserved in
- a dumped Emacs. */
- mallopt (M_MMAP_MAX, 0);
-#endif
-
/* This gets triggered by code which I haven't bothered to fix. --Stef */
/* eassert (!handling_signal); */
- nbytes = header_size + len * word_size;
- p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE);
+ if (len == 0)
+ p = zero_vector;
+ else
+ {
+ size_t nbytes = header_size + len * word_size;
#ifdef DOUG_LEA_MALLOC
- /* Back to a reasonable maximum of mmap'ed areas. */
- mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
+ /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
+ because mapped region contents are not preserved in
+ a dumped Emacs. */
+ mallopt (M_MMAP_MAX, 0);
#endif
- consing_since_gc += nbytes;
- vector_cells_consed += len;
+ if (nbytes <= VBLOCK_BYTES_MAX)
+ p = allocate_vector_from_block (vroundup (nbytes));
+ else
+ {
+ p = lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE);
+ p->header.next.vector = large_vectors;
+ large_vectors = p;
+ }
- p->header.next.vector = all_vectors;
- all_vectors = p;
+#ifdef DOUG_LEA_MALLOC
+ /* Back to a reasonable maximum of mmap'ed areas. */
+ mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
+#endif
+
+ consing_since_gc += nbytes;
+ vector_cells_consed += len;
+ }
MALLOC_UNBLOCK_INPUT;
/* Allocate other vector-like structures. */
struct Lisp_Vector *
-allocate_pseudovector (int memlen, int lisplen, EMACS_INT tag)
+allocate_pseudovector (int memlen, int lisplen, int tag)
{
struct Lisp_Vector *v = allocate_vectorlike (memlen);
int i;
return v;
}
+struct buffer *
+allocate_buffer (void)
+{
+ struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER);
+
+ XSETPVECTYPESIZE (b, PVEC_BUFFER, (offsetof (struct buffer, own_text)
+ - header_size) / word_size);
+ /* Note that the fields of B are not initialized. */
+ return b;
+}
+
struct Lisp_Hash_Table *
allocate_hash_table (void)
{
return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, count, PVEC_HASH_TABLE);
}
-
struct window *
allocate_window (void)
{
- return ALLOCATE_PSEUDOVECTOR (struct window, current_matrix, PVEC_WINDOW);
-}
+ struct window *w;
+ w = ALLOCATE_PSEUDOVECTOR (struct window, current_matrix, PVEC_WINDOW);
+ /* Users assumes that non-Lisp data is zeroed. */
+ memset (&w->current_matrix, 0,
+ sizeof (*w) - offsetof (struct window, current_matrix));
+ return w;
+}
struct terminal *
allocate_terminal (void)
{
- struct terminal *t = ALLOCATE_PSEUDOVECTOR (struct terminal,
- next_terminal, PVEC_TERMINAL);
- /* Zero out the non-GC'd fields. FIXME: This should be made unnecessary. */
- memset (&t->next_terminal, 0,
- (char*) (t + 1) - (char*) &t->next_terminal);
+ struct terminal *t;
+ t = ALLOCATE_PSEUDOVECTOR (struct terminal, next_terminal, PVEC_TERMINAL);
+ /* Users assumes that non-Lisp data is zeroed. */
+ memset (&t->next_terminal, 0,
+ sizeof (*t) - offsetof (struct terminal, next_terminal));
return t;
}
struct frame *
allocate_frame (void)
{
- struct frame *f = ALLOCATE_PSEUDOVECTOR (struct frame,
- face_cache, PVEC_FRAME);
- /* Zero out the non-GC'd fields. FIXME: This should be made unnecessary. */
+ struct frame *f;
+
+ f = ALLOCATE_PSEUDOVECTOR (struct frame, face_cache, PVEC_FRAME);
+ /* Users assumes that non-Lisp data is zeroed. */
memset (&f->face_cache, 0,
- (char *) (f + 1) - (char *) &f->face_cache);
+ sizeof (*f) - offsetof (struct frame, face_cache));
return f;
}
-
struct Lisp_Process *
allocate_process (void)
{
- return ALLOCATE_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
-}
+ struct Lisp_Process *p;
+ p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
+ /* Users assumes that non-Lisp data is zeroed. */
+ memset (&p->pid, 0,
+ sizeof (*p) - offsetof (struct Lisp_Process, pid));
+ return p;
+}
DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
doc: /* Return a newly created vector of length LENGTH, with each element being INIT.
(register Lisp_Object length, Lisp_Object init)
{
Lisp_Object vector;
- register EMACS_INT sizei;
- register EMACS_INT i;
+ register ptrdiff_t sizei;
+ register ptrdiff_t i;
register struct Lisp_Vector *p;
CHECK_NATNUM (length);
- sizei = XFASTINT (length);
- p = allocate_vector (sizei);
+ p = allocate_vector (XFASTINT (length));
+ sizei = XFASTINT (length);
for (i = 0; i < sizei; i++)
p->contents[i] = init;
return val;
}
+void
+make_byte_code (struct Lisp_Vector *v)
+{
+ 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->contents[1] = Fstring_as_unibyte (v->contents[1]);
+ XSETPVECTYPE (v, PVEC_COMPILED);
+}
DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
doc: /* Create a byte-code object with specified arguments as elements.
ptrdiff_t i;
register struct Lisp_Vector *p;
- XSETFASTINT (len, nargs);
- if (!NILP (Vpurify_flag))
- val = make_pure_vector (nargs);
- else
- val = Fmake_vector (len, Qnil);
+ /* We used to purecopy everything here, if purify-flga 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
+ copied into pure space, including its free variables, which is sometimes
+ just wasteful and other times plainly wrong (e.g. those free vars may want
+ to be setcar'd). */
- if (nargs > 1 && STRINGP (args[1]) && STRING_MULTIBYTE (args[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. */
- args[1] = Fstring_as_unibyte (args[1]);
+ XSETFASTINT (len, nargs);
+ val = Fmake_vector (len, Qnil);
p = XVECTOR (val);
for (i = 0; i < nargs; i++)
- {
- if (!NILP (Vpurify_flag))
- args[i] = Fpurecopy (args[i]);
- p->contents[i] = args[i];
- }
- XSETPVECTYPE (p, PVEC_COMPILED);
+ p->contents[i] = args[i];
+ make_byte_code (p);
XSETCOMPILED (val, p);
return val;
}
Symbol Allocation
***********************************************************************/
+/* Like struct Lisp_Symbol, but padded so that the size is a multiple
+ of the required alignment if LSB tags are used. */
+
+union aligned_Lisp_Symbol
+{
+ struct Lisp_Symbol s;
+#if USE_LSB_TAG
+ unsigned char c[(sizeof (struct Lisp_Symbol) + (1 << GCTYPEBITS) - 1)
+ & -(1 << GCTYPEBITS)];
+#endif
+};
+
/* Each symbol_block is just under 1020 bytes long, since malloc
really allocates in units of powers of two and uses 4 bytes for its
- own overhead. */
+ own overhead. */
#define SYMBOL_BLOCK_SIZE \
- ((1020 - sizeof (struct symbol_block *)) / sizeof (struct Lisp_Symbol))
+ ((1020 - sizeof (struct symbol_block *)) / sizeof (union aligned_Lisp_Symbol))
struct symbol_block
{
/* Place `symbols' first, to preserve alignment. */
- struct Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE];
+ union aligned_Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE];
struct symbol_block *next;
};
{
if (symbol_block_index == SYMBOL_BLOCK_SIZE)
{
- struct symbol_block *new;
- new = (struct symbol_block *) lisp_malloc (sizeof *new,
- MEM_TYPE_SYMBOL);
+ struct symbol_block *new
+ = lisp_malloc (sizeof *new, MEM_TYPE_SYMBOL);
new->next = symbol_block;
symbol_block = new;
symbol_block_index = 0;
}
- XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]);
+ XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index].s);
symbol_block_index++;
}
Marker (Misc) Allocation
***********************************************************************/
+/* Like union Lisp_Misc, but padded so that its size is a multiple of
+ the required alignment when LSB tags are used. */
+
+union aligned_Lisp_Misc
+{
+ union Lisp_Misc m;
+#if USE_LSB_TAG
+ unsigned char c[(sizeof (union Lisp_Misc) + (1 << GCTYPEBITS) - 1)
+ & -(1 << GCTYPEBITS)];
+#endif
+};
+
/* Allocation of markers and other objects that share that structure.
Works like allocation of conses. */
#define MARKER_BLOCK_SIZE \
- ((1020 - sizeof (struct marker_block *)) / sizeof (union Lisp_Misc))
+ ((1020 - sizeof (struct marker_block *)) / sizeof (union aligned_Lisp_Misc))
struct marker_block
{
/* Place `markers' first, to preserve alignment. */
- union Lisp_Misc markers[MARKER_BLOCK_SIZE];
+ union aligned_Lisp_Misc markers[MARKER_BLOCK_SIZE];
struct marker_block *next;
};
{
if (marker_block_index == MARKER_BLOCK_SIZE)
{
- struct marker_block *new;
- new = (struct marker_block *) lisp_malloc (sizeof *new,
- MEM_TYPE_MISC);
+ struct marker_block *new = lisp_malloc (sizeof *new, MEM_TYPE_MISC);
new->next = marker_block;
marker_block = new;
marker_block_index = 0;
total_free_markers += MARKER_BLOCK_SIZE;
}
- XSETMISC (val, &marker_block->markers[marker_block_index]);
+ XSETMISC (val, &marker_block->markers[marker_block_index].m);
marker_block_index++;
}
return val;
}
+/* Return a newly allocated marker which points into BUF
+ at character position CHARPOS and byte position BYTEPOS. */
+
+Lisp_Object
+build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos)
+{
+ Lisp_Object obj;
+ struct Lisp_Marker *m;
+
+ /* No dead buffers here. */
+ eassert (!NILP (BVAR (buf, name)));
+
+ /* Every character is at least one byte. */
+ eassert (charpos <= bytepos);
+
+ obj = allocate_misc ();
+ XMISCTYPE (obj) = Lisp_Misc_Marker;
+ m = XMARKER (obj);
+ m->buffer = buf;
+ m->charpos = charpos;
+ m->bytepos = bytepos;
+ m->insertion_type = 0;
+ m->next = BUF_MARKERS (buf);
+ BUF_MARKERS (buf) = m;
+ return obj;
+}
+
/* Put MARKER back on the free list after using it temporarily. */
void
{
#ifndef SYSTEM_MALLOC
if (spare_memory[0] == 0)
- spare_memory[0] = (char *) malloc (SPARE_MEMORY);
+ spare_memory[0] = malloc (SPARE_MEMORY);
if (spare_memory[1] == 0)
- spare_memory[1] = (char *) lisp_align_malloc (sizeof (struct cons_block),
+ spare_memory[1] = lisp_align_malloc (sizeof (struct cons_block),
MEM_TYPE_CONS);
if (spare_memory[2] == 0)
- spare_memory[2] = (char *) lisp_align_malloc (sizeof (struct cons_block),
- MEM_TYPE_CONS);
+ spare_memory[2] = lisp_align_malloc (sizeof (struct cons_block),
+ MEM_TYPE_CONS);
if (spare_memory[3] == 0)
- spare_memory[3] = (char *) lisp_align_malloc (sizeof (struct cons_block),
- MEM_TYPE_CONS);
+ spare_memory[3] = lisp_align_malloc (sizeof (struct cons_block),
+ MEM_TYPE_CONS);
if (spare_memory[4] == 0)
- spare_memory[4] = (char *) lisp_align_malloc (sizeof (struct cons_block),
- MEM_TYPE_CONS);
+ spare_memory[4] = lisp_align_malloc (sizeof (struct cons_block),
+ MEM_TYPE_CONS);
if (spare_memory[5] == 0)
- spare_memory[5] = (char *) lisp_malloc (sizeof (struct string_block),
- MEM_TYPE_STRING);
+ spare_memory[5] = lisp_malloc (sizeof (struct string_block),
+ MEM_TYPE_STRING);
if (spare_memory[6] == 0)
- spare_memory[6] = (char *) lisp_malloc (sizeof (struct string_block),
- MEM_TYPE_STRING);
+ spare_memory[6] = lisp_malloc (sizeof (struct string_block),
+ MEM_TYPE_STRING);
if (spare_memory[0] && spare_memory[1] && spare_memory[5])
Vmemory_full = Qnil;
#endif
/* Create a new node. */
#ifdef GC_MALLOC_CHECK
- x = (struct mem_node *) _malloc_internal (sizeof *x);
+ x = _malloc_internal (sizeof *x);
if (x == NULL)
abort ();
#else
- x = (struct mem_node *) xmalloc (sizeof *x);
+ x = xmalloc (sizeof *x);
#endif
x->start = start;
x->end = end;
static inline int
live_vector_p (struct mem_node *m, void *p)
{
- return (p == m->start && m->type == MEM_TYPE_VECTORLIKE);
+ if (m->type == MEM_TYPE_VECTOR_BLOCK)
+ {
+ /* This memory node corresponds to a vector block. */
+ struct vector_block *block = (struct vector_block *) m->start;
+ struct Lisp_Vector *vector = (struct Lisp_Vector *) block->data;
+
+ /* P is in the block's allocation range. Scan the block
+ up to P and see whether P points to the start of some
+ 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)
+ {
+ if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE))
+ vector = ADVANCE (vector, (vector->header.size
+ & PSEUDOVECTOR_SIZE_MASK));
+ else if (vector == p)
+ return 1;
+ else
+ vector = ADVANCE (vector, vector->header.next.nbytes);
+ }
+ }
+ else if (m->type == MEM_TYPE_VECTORLIKE && p == m->start)
+ /* This memory node corresponds to a large vector. */
+ return 1;
+ return 0;
}
{
struct mem_node *m;
- /* Quickly rule out some values which can't point to Lisp data. */
- if ((intptr_t) p %
-#ifdef USE_LSB_TAG
- 8 /* USE_LSB_TAG needs Lisp data to be aligned on multiples of 8. */
-#else
- 2 /* We assume that Lisp data is aligned on even addresses. */
-#endif
- )
+ /* Quickly rule out some values which can't point to Lisp data.
+ USE_LSB_TAG needs Lisp data to be aligned on multiples of 1 << GCTYPEBITS.
+ Otherwise, assume that Lisp data is aligned on even addresses. */
+ if ((intptr_t) p % (USE_LSB_TAG ? 1 << GCTYPEBITS : 2))
return;
m = mem_find (p);
break;
case MEM_TYPE_VECTORLIKE:
+ case MEM_TYPE_VECTOR_BLOCK:
if (live_vector_p (m, p))
{
Lisp_Object tem;
}
-/* Alignment of Lisp_Object and pointer values. Use offsetof, as it
- sometimes returns a smaller alignment than GCC's __alignof__ and
- mark_memory might miss objects if __alignof__ were used. For
- example, on x86 with WIDE_EMACS_INT, __alignof__ (Lisp_Object) is 8
- but GC_LISP_OBJECT_ALIGNMENT should be 4. */
-#ifndef GC_LISP_OBJECT_ALIGNMENT
-# define GC_LISP_OBJECT_ALIGNMENT offsetof (struct {char a; Lisp_Object b;}, b)
-#endif
+/* Alignment of pointer values. Use offsetof, as it sometimes returns
+ a smaller alignment than GCC's __alignof__ and mark_memory might
+ miss objects if __alignof__ were used. */
#define GC_POINTER_ALIGNMENT offsetof (struct {char a; void *b;}, b)
+/* Define POINTERS_MIGHT_HIDE_IN_OBJECTS to 1 if marking via C pointers does
+ not suffice, which is the typical case. A host where a Lisp_Object is
+ wider than a pointer might allocate a Lisp_Object in non-adjacent halves.
+ If USE_LSB_TAG, the bottom half is not a valid pointer, but it should
+ suffice to widen it to to a Lisp_Object and check it that way. */
+#if USE_LSB_TAG || VAL_MAX < UINTPTR_MAX
+# if !USE_LSB_TAG && VAL_MAX < UINTPTR_MAX >> GCTYPEBITS
+ /* If tag bits straddle pointer-word boundaries, neither mark_maybe_pointer
+ nor mark_maybe_object can follow the pointers. This should not occur on
+ any practical porting target. */
+# error "MSB type bits straddle pointer-word boundaries"
+# endif
+ /* Marking via C pointers does not suffice, because Lisp_Objects contain
+ pointer words that hold pointers ORed with type bits. */
+# define POINTERS_MIGHT_HIDE_IN_OBJECTS 1
+#else
+ /* Marking via C pointers suffices, because Lisp_Objects contain pointer
+ words that hold unmodified pointers. */
+# define POINTERS_MIGHT_HIDE_IN_OBJECTS 0
+#endif
+
/* Mark Lisp objects referenced from the address range START+OFFSET..END
or END+OFFSET..START. */
static void
mark_memory (void *start, void *end)
+#ifdef __clang__
+ /* 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
{
- Lisp_Object *p;
void **pp;
int i;
end = tem;
}
- /* Mark Lisp_Objects. */
- for (p = start; (void *) p < end; p++)
- for (i = 0; i < sizeof *p; i += GC_LISP_OBJECT_ALIGNMENT)
- mark_maybe_object (*(Lisp_Object *) ((char *) p + i));
-
/* Mark Lisp data pointed to. This is necessary because, in some
situations, the C compiler optimizes Lisp objects away, so that
only a pointer to them remains. Example:
for (pp = start; (void *) pp < end; pp++)
for (i = 0; i < sizeof *pp; i += GC_POINTER_ALIGNMENT)
- mark_maybe_pointer (*(void **) ((char *) pp + i));
+ {
+ void *p = *(void **) ((char *) pp + i);
+ mark_maybe_pointer (p);
+ if (POINTERS_MIGHT_HIDE_IN_OBJECTS)
+ mark_maybe_object (XIL ((intptr_t) p));
+ }
}
/* setjmp will work with GCC unless NON_SAVING_SETJMP is defined in
return live_float_p (m, p);
case MEM_TYPE_VECTORLIKE:
+ case MEM_TYPE_VECTOR_BLOCK:
return live_vector_p (m, p);
default:
pointer to it. TYPE is the Lisp type for which the memory is
allocated. TYPE < 0 means it's not used for a Lisp object. */
-static POINTER_TYPE *
+static void *
pure_alloc (size_t size, int type)
{
- POINTER_TYPE *result;
-#ifdef USE_LSB_TAG
+ void *result;
+#if USE_LSB_TAG
size_t alignment = (1 << GCTYPEBITS);
#else
size_t alignment = sizeof (EMACS_INT);
/* Don't allocate a large amount here,
because it might get mmap'd and then its address
might not be usable. */
- purebeg = (char *) xmalloc (10000);
+ purebeg = xmalloc (10000);
pure_size = 10000;
pure_bytes_used_before_overflow += pure_bytes_used - size;
pure_bytes_used = 0;
address. Return NULL if not found. */
static char *
-find_string_data_in_pure (const char *data, EMACS_INT nbytes)
+find_string_data_in_pure (const char *data, ptrdiff_t nbytes)
{
int i;
- EMACS_INT skip, bm_skip[256], last_char_skip, infinity, start, start_max;
+ ptrdiff_t skip, bm_skip[256], last_char_skip, infinity, start, start_max;
const unsigned char *p;
char *non_lisp_beg;
- if (pure_bytes_used_non_lisp < nbytes + 1)
+ if (pure_bytes_used_non_lisp <= nbytes)
return NULL;
/* Set up the Boyer-Moore table. */
Lisp_Object
make_pure_string (const char *data,
- EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
+ ptrdiff_t nchars, ptrdiff_t nbytes, int multibyte)
{
Lisp_Object string;
struct Lisp_String *s;
return string;
}
-/* Return a string a string allocated in pure space. Do not allocate
- the string data, just point to DATA. */
+/* Return a string allocated in pure space. Do not
+ allocate the string data, just point to DATA. */
Lisp_Object
-make_pure_c_string (const char *data)
+make_pure_c_string (const char *data, ptrdiff_t nchars)
{
Lisp_Object string;
struct Lisp_String *s;
- EMACS_INT nchars = strlen (data);
s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
s->size = nchars;
/* Return a vector with room for LEN Lisp_Objects allocated from
pure space. */
-Lisp_Object
-make_pure_vector (EMACS_INT len)
+static Lisp_Object
+make_pure_vector (ptrdiff_t len)
{
Lisp_Object new;
struct Lisp_Vector *p;
else if (COMPILEDP (obj) || VECTORP (obj))
{
register struct Lisp_Vector *vec;
- register EMACS_INT i;
- EMACS_INT size;
+ register ptrdiff_t i;
+ ptrdiff_t size;
size = ASIZE (obj);
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
vec = XVECTOR (make_pure_vector (size));
for (i = 0; i < size; i++)
- vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
+ vec->contents[i] = Fpurecopy (AREF (obj, i));
if (COMPILEDP (obj))
{
XSETPVECTYPE (vec, PVEC_COMPILED);
/* Temporarily prevent garbage collection. */
-int
+ptrdiff_t
inhibit_garbage_collection (void)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qgc_cons_threshold, make_number (MOST_POSITIVE_FIXNUM));
return count;
`gc-cons-threshold' bytes of Lisp data since previous garbage collection.
`garbage-collect' normally returns a list with info on amount of space in use:
((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
- (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS
+ (USED-MISCS . FREE-MISCS) USED-STRING-CHARS USED-VECTOR-SLOTS
(USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS)
(USED-STRINGS . FREE-STRINGS))
However, if there was overflow in pure space, `garbage-collect'
-returns nil, because real GC can't be done. */)
+returns nil, because real GC can't be done.
+See Info node `(elisp)Garbage Collection'. */)
(void)
{
register struct specbinding *bind;
ptrdiff_t i;
int message_p;
Lisp_Object total[8];
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
EMACS_TIME t1, t2, t3;
if (abort_on_gc)
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 (! NILP (nextb->BUFFER_INTERNAL_FIELD (name)) && ! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
+ if (! NILP (nextb->BUFFER_INTERNAL_FIELD (name))
+ && ! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
truncate_undo_list (nextb);
/* Shrink buffer gaps, but skip indirect and dead buffers. */
{
if (stack_copy_size < stack_size)
{
- stack_copy = (char *) xrealloc (stack_copy, stack_size);
+ stack_copy = xrealloc (stack_copy, stack_size);
stack_copy_size = stack_size;
}
memcpy (stack_copy, stack, stack_size);
if (!NILP (Vpost_gc_hook))
{
- int gc_count = inhibit_garbage_collection ();
+ ptrdiff_t gc_count = inhibit_garbage_collection ();
safe_run_hooks (Qpost_gc_hook);
unbind_to (gc_count, Qnil);
}
/* Accumulate statistics. */
- EMACS_GET_TIME (t2);
- EMACS_SUB_TIME (t3, t2, t1);
if (FLOATP (Vgc_elapsed))
- Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed) +
- EMACS_SECS (t3) +
- EMACS_USECS (t3) * 1.0e-6);
+ {
+ EMACS_GET_TIME (t2);
+ EMACS_SUB_TIME (t3, t2, t1);
+ Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed)
+ + EMACS_TIME_TO_DOUBLE (t3));
+ }
+
gcs_done++;
return Flist (sizeof total / sizeof *total, total);
static void
mark_vectorlike (struct Lisp_Vector *ptr)
{
- EMACS_INT size = ptr->header.size;
- EMACS_INT i;
+ ptrdiff_t size = ptr->header.size;
+ ptrdiff_t i;
eassert (!VECTOR_MARKED_P (ptr));
- VECTOR_MARK (ptr); /* Else mark it */
+ VECTOR_MARK (ptr); /* Else mark it. */
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
/* Note that this size is not the memory-footprint size, but only
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 */
+ 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 the chain of overlays starting at PTR. */
+
+static void
+mark_overlay (struct Lisp_Overlay *ptr)
+{
+ for (; ptr && !ptr->gcmarkbit; ptr = ptr->next)
+ {
+ ptr->gcmarkbit = 1;
+ mark_object (ptr->start);
+ mark_object (ptr->end);
+ mark_object (ptr->plist);
+ }
+}
+
+/* Mark Lisp_Objects and special pointers in BUFFER. */
+
+static void
+mark_buffer (struct buffer *buffer)
+{
+ /* This is handled much like other pseudovectors... */
+ mark_vectorlike ((struct Lisp_Vector *) buffer);
+
+ /* ...but there are some buffer-specific things. */
+
+ MARK_INTERVAL_TREE (BUF_INTERVALS (buffer));
+
+ /* For now, we just don't mark the undo_list. It's done later in
+ a special way just before the sweep phase, and after stripping
+ some of its elements that are not needed any more. */
+
+ mark_overlay (buffer->overlays_before);
+ mark_overlay (buffer->overlays_after);
+
+ /* If this is an indirect buffer, mark its base buffer. */
+ if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer))
+ mark_buffer (buffer->base_buffer);
+}
+
+/* Determine type of generic Lisp_Object and mark it accordingly. */
+
void
mark_object (Lisp_Object arg)
{
if (STRING_MARKED_P (ptr))
break;
CHECK_ALLOCATED_AND_LIVE (live_string_p);
- MARK_INTERVAL_TREE (ptr->intervals);
MARK_STRING (ptr);
+ MARK_INTERVAL_TREE (ptr->intervals);
#ifdef GC_CHECK_STRING_BYTES
/* Check that the string size recorded in the string is the
- same as the one recorded in the sdata structure. */
+ same as the one recorded in the sdata structure. */
CHECK_STRING_BYTES (ptr);
#endif /* GC_CHECK_STRING_BYTES */
}
break;
case Lisp_Vectorlike:
- if (VECTOR_MARKED_P (XVECTOR (obj)))
- break;
+ {
+ register struct Lisp_Vector *ptr = XVECTOR (obj);
+ register ptrdiff_t pvectype;
+
+ if (VECTOR_MARKED_P (ptr))
+ break;
+
#ifdef GC_CHECK_MARKED_OBJECTS
- m = mem_find (po);
- if (m == MEM_NIL && !SUBRP (obj)
- && po != &buffer_defaults
- && po != &buffer_local_symbols)
- abort ();
+ m = mem_find (po);
+ if (m == MEM_NIL && !SUBRP (obj)
+ && po != &buffer_defaults
+ && po != &buffer_local_symbols)
+ abort ();
#endif /* GC_CHECK_MARKED_OBJECTS */
- if (BUFFERP (obj))
- {
+ if (ptr->header.size & PSEUDOVECTOR_FLAG)
+ pvectype = ((ptr->header.size & PVEC_TYPE_MASK)
+ >> PSEUDOVECTOR_SIZE_BITS);
+ else
+ pvectype = 0;
+
+ if (pvectype != PVEC_SUBR && pvectype != PVEC_BUFFER)
+ CHECK_LIVE (live_vector_p);
+
+ switch (pvectype)
+ {
+ case PVEC_BUFFER:
#ifdef GC_CHECK_MARKED_OBJECTS
- if (po != &buffer_defaults && po != &buffer_local_symbols)
+ if (po != &buffer_defaults && po != &buffer_local_symbols)
+ {
+ struct buffer *b = all_buffers;
+ for (; b && b != po; b = b->header.next.buffer)
+ ;
+ if (b == NULL)
+ abort ();
+ }
+#endif /* GC_CHECK_MARKED_OBJECTS */
+ mark_buffer ((struct buffer *) ptr);
+ break;
+
+ case PVEC_COMPILED:
+ { /* We could treat this just like a vector, but it is better
+ to save the COMPILED_CONSTANTS element for last and avoid
+ recursion there. */
+ int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
+ int i;
+
+ VECTOR_MARK (ptr);
+ for (i = 0; i < size; i++)
+ if (i != COMPILED_CONSTANTS)
+ mark_object (ptr->contents[i]);
+ if (size > COMPILED_CONSTANTS)
+ {
+ obj = ptr->contents[COMPILED_CONSTANTS];
+ goto loop;
+ }
+ }
+ break;
+
+ case PVEC_FRAME:
{
- struct buffer *b;
- for (b = all_buffers; b && b != po; b = b->header.next.buffer)
- ;
- if (b == NULL)
- abort ();
+ mark_vectorlike (ptr);
+ mark_face_cache (((struct frame *) ptr)->face_cache);
}
-#endif /* GC_CHECK_MARKED_OBJECTS */
- mark_buffer (obj);
- }
- else if (SUBRP (obj))
- break;
- else if (COMPILEDP (obj))
- /* We could treat this just like a vector, but it is better to
- save the COMPILED_CONSTANTS element for last and avoid
- recursion there. */
- {
- register struct Lisp_Vector *ptr = XVECTOR (obj);
- int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
- int i;
+ break;
- CHECK_LIVE (live_vector_p);
- VECTOR_MARK (ptr); /* Else mark it */
- for (i = 0; i < size; i++) /* and then mark its elements */
+ case PVEC_WINDOW:
{
- if (i != COMPILED_CONSTANTS)
- mark_object (ptr->contents[i]);
+ struct window *w = (struct window *) ptr;
+
+ mark_vectorlike (ptr);
+ /* Mark glyphs for leaf windows. Marking window
+ matrices is sufficient because frame matrices
+ use the same glyph memory. */
+ if (NILP (w->hchild) && NILP (w->vchild) && w->current_matrix)
+ {
+ mark_glyph_matrix (w->current_matrix);
+ mark_glyph_matrix (w->desired_matrix);
+ }
}
- obj = ptr->contents[COMPILED_CONSTANTS];
- goto loop;
- }
- else if (FRAMEP (obj))
- {
- register struct frame *ptr = XFRAME (obj);
- mark_vectorlike (XVECTOR (obj));
- mark_face_cache (ptr->face_cache);
- }
- else if (WINDOWP (obj))
- {
- register struct Lisp_Vector *ptr = XVECTOR (obj);
- struct window *w = XWINDOW (obj);
- mark_vectorlike (ptr);
- /* Mark glyphs for leaf windows. Marking window matrices is
- sufficient because frame matrices use the same glyph
- memory. */
- if (NILP (w->hchild)
- && NILP (w->vchild)
- && w->current_matrix)
+ break;
+
+ case PVEC_HASH_TABLE:
{
- mark_glyph_matrix (w->current_matrix);
- mark_glyph_matrix (w->desired_matrix);
+ struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr;
+
+ mark_vectorlike (ptr);
+ /* If hash table is not weak, mark all keys and values.
+ For weak tables, mark only the vector. */
+ if (NILP (h->weak))
+ mark_object (h->key_and_value);
+ else
+ VECTOR_MARK (XVECTOR (h->key_and_value));
}
- }
- else if (HASH_TABLE_P (obj))
- {
- struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
- mark_vectorlike ((struct Lisp_Vector *)h);
- /* If hash table is not weak, mark all keys and values.
- For weak tables, mark only the vector. */
- if (NILP (h->weak))
- mark_object (h->key_and_value);
- else
- VECTOR_MARK (XVECTOR (h->key_and_value));
- }
- else if (CHAR_TABLE_P (obj))
- mark_char_table (XVECTOR (obj));
- else
- mark_vectorlike (XVECTOR (obj));
+ break;
+
+ case PVEC_CHAR_TABLE:
+ mark_char_table (ptr);
+ break;
+
+ case PVEC_BOOL_VECTOR:
+ /* No Lisp_Objects to mark in a bool vector. */
+ VECTOR_MARK (ptr);
+ break;
+
+ case PVEC_SUBR:
+ break;
+
+ case PVEC_FREE:
+ abort ();
+
+ default:
+ mark_vectorlike (ptr);
+ }
+ }
break;
case Lisp_Symbol:
ptr = ptr->next;
if (ptr)
{
- ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun */
+ ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun. */
XSETSYMBOL (obj, ptrx);
goto loop;
}
case Lisp_Misc:
CHECK_ALLOCATED_AND_LIVE (live_misc_p);
+
if (XMISCANY (obj)->gcmarkbit)
break;
- XMISCANY (obj)->gcmarkbit = 1;
switch (XMISCTYPE (obj))
{
-
case Lisp_Misc_Marker:
/* DO NOT mark thru the marker's chain.
The buffer's markers chain does not preserve markers from gc;
instead, markers are removed from the chain when freed by gc. */
+ XMISCANY (obj)->gcmarkbit = 1;
break;
case Lisp_Misc_Save_Value:
+ XMISCANY (obj)->gcmarkbit = 1;
#if GC_MARK_STACK
{
register struct Lisp_Save_Value *ptr = XSAVE_VALUE (obj);
break;
case Lisp_Misc_Overlay:
- {
- struct Lisp_Overlay *ptr = XOVERLAY (obj);
- mark_object (ptr->start);
- mark_object (ptr->end);
- mark_object (ptr->plist);
- if (ptr->next)
- {
- XSETMISC (obj, ptr->next);
- goto loop;
- }
- }
+ mark_overlay (XOVERLAY (obj));
break;
default:
#undef CHECK_ALLOCATED
#undef CHECK_ALLOCATED_AND_LIVE
}
-
-/* Mark the pointers in a buffer structure. */
-
-static void
-mark_buffer (Lisp_Object buf)
-{
- register struct buffer *buffer = XBUFFER (buf);
- register Lisp_Object *ptr, tmp;
- Lisp_Object base_buffer;
-
- eassert (!VECTOR_MARKED_P (buffer));
- VECTOR_MARK (buffer);
-
- MARK_INTERVAL_TREE (BUF_INTERVALS (buffer));
-
- /* For now, we just don't mark the undo_list. It's done later in
- a special way just before the sweep phase, and after stripping
- some of its elements that are not needed any more. */
-
- if (buffer->overlays_before)
- {
- XSETMISC (tmp, buffer->overlays_before);
- mark_object (tmp);
- }
- if (buffer->overlays_after)
- {
- XSETMISC (tmp, buffer->overlays_after);
- mark_object (tmp);
- }
-
- /* buffer-local Lisp variables start at `undo_list',
- tho only the ones from `name' on are GC'd normally. */
- for (ptr = &buffer->BUFFER_INTERNAL_FIELD (name);
- ptr <= &PER_BUFFER_VALUE (buffer,
- PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER));
- ptr++)
- mark_object (*ptr);
-
- /* If this is an indirect buffer, mark its base buffer. */
- if (buffer->base_buffer && !VECTOR_MARKED_P (buffer->base_buffer))
- {
- XSETBUFFER (base_buffer, buffer->base_buffer);
- mark_buffer (base_buffer);
- }
-}
-
/* Mark the Lisp pointers in the terminal objects.
- Called by the Fgarbage_collector. */
+ Called by Fgarbage_collect. */
static void
mark_terminals (void)
for (sblk = symbol_block; sblk; sblk = *sprev)
{
int this_free = 0;
- struct Lisp_Symbol *sym = sblk->symbols;
- struct Lisp_Symbol *end = sym + lim;
+ union aligned_Lisp_Symbol *sym = sblk->symbols;
+ union aligned_Lisp_Symbol *end = sym + lim;
for (; sym < end; ++sym)
{
/* Check if the symbol was created during loadup. In such a case
it might be pointed to by pure bytecode which we don't trace,
so we conservatively assume that it is live. */
- int pure_p = PURE_POINTER_P (XSTRING (sym->xname));
+ int pure_p = PURE_POINTER_P (XSTRING (sym->s.xname));
- if (!sym->gcmarkbit && !pure_p)
+ if (!sym->s.gcmarkbit && !pure_p)
{
- if (sym->redirect == SYMBOL_LOCALIZED)
- xfree (SYMBOL_BLV (sym));
- sym->next = symbol_free_list;
- symbol_free_list = sym;
+ if (sym->s.redirect == SYMBOL_LOCALIZED)
+ xfree (SYMBOL_BLV (&sym->s));
+ sym->s.next = symbol_free_list;
+ symbol_free_list = &sym->s;
#if GC_MARK_STACK
symbol_free_list->function = Vdead;
#endif
{
++num_used;
if (!pure_p)
- UNMARK_STRING (XSTRING (sym->xname));
- sym->gcmarkbit = 0;
+ UNMARK_STRING (XSTRING (sym->s.xname));
+ sym->s.gcmarkbit = 0;
}
}
{
*sprev = sblk->next;
/* Unhook from the free list. */
- symbol_free_list = sblk->symbols[0].next;
+ symbol_free_list = sblk->symbols[0].s.next;
lisp_free (sblk);
}
else
for (i = 0; i < lim; i++)
{
- if (!mblk->markers[i].u_any.gcmarkbit)
+ if (!mblk->markers[i].m.u_any.gcmarkbit)
{
- if (mblk->markers[i].u_any.type == Lisp_Misc_Marker)
- unchain_marker (&mblk->markers[i].u_marker);
+ if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker)
+ unchain_marker (&mblk->markers[i].m.u_marker);
/* Set the type of the freed object to Lisp_Misc_Free.
We could leave the type alone, since nobody checks it,
but this might catch bugs faster. */
- mblk->markers[i].u_marker.type = Lisp_Misc_Free;
- mblk->markers[i].u_free.chain = marker_free_list;
- marker_free_list = &mblk->markers[i];
+ mblk->markers[i].m.u_marker.type = Lisp_Misc_Free;
+ mblk->markers[i].m.u_free.chain = marker_free_list;
+ marker_free_list = &mblk->markers[i].m;
this_free++;
}
else
{
num_used++;
- mblk->markers[i].u_any.gcmarkbit = 0;
+ mblk->markers[i].m.u_any.gcmarkbit = 0;
}
}
lim = MARKER_BLOCK_SIZE;
{
*mprev = mblk->next;
/* Unhook from the free list. */
- marker_free_list = mblk->markers[0].u_free.chain;
+ marker_free_list = mblk->markers[0].m.u_free.chain;
lisp_free (mblk);
}
else
}
}
- /* Free all unmarked vectors */
- {
- register struct Lisp_Vector *vector = all_vectors, *prev = 0, *next;
- total_vector_size = 0;
-
- while (vector)
- if (!VECTOR_MARKED_P (vector))
- {
- if (prev)
- prev->header.next = vector->header.next;
- else
- all_vectors = vector->header.next.vector;
- next = vector->header.next.vector;
- lisp_free (vector);
- vector = next;
-
- }
- else
- {
- VECTOR_UNMARK (vector);
- if (vector->header.size & PSEUDOVECTOR_FLAG)
- total_vector_size += PSEUDOVECTOR_SIZE_MASK & vector->header.size;
- else
- total_vector_size += vector->header.size;
- prev = vector, vector = vector->header.next.vector;
- }
- }
+ sweep_vectors ();
#ifdef GC_CHECK_STRING_BYTES
if (!noninteractive)
which_symbols (Lisp_Object obj, EMACS_INT find_max)
{
struct symbol_block *sblk;
- int gc_count = inhibit_garbage_collection ();
+ ptrdiff_t gc_count = inhibit_garbage_collection ();
Lisp_Object found = Qnil;
if (! DEADP (obj))
{
for (sblk = symbol_block; sblk; sblk = sblk->next)
{
- struct Lisp_Symbol *sym = sblk->symbols;
+ union aligned_Lisp_Symbol *aligned_sym = sblk->symbols;
int bn;
- for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, sym++)
+ for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, aligned_sym++)
{
+ struct Lisp_Symbol *sym = &aligned_sym->s;
Lisp_Object val;
Lisp_Object tem;
Vdead = make_pure_string ("DEAD", 4, 4, 0);
#endif
- all_vectors = 0;
ignore_warnings = 1;
#ifdef DOUG_LEA_MALLOC
mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
init_marker ();
init_float ();
init_intervals ();
+ init_vectors ();
init_weak_hash_tables ();
#ifdef REL_ALLOC
syms_of_alloc (void)
{
DEFVAR_INT ("gc-cons-threshold", gc_cons_threshold,
- doc: /* *Number of bytes of consing between garbage collections.
+ doc: /* Number of bytes of consing between garbage collections.
Garbage collection can happen automatically once this many bytes have been
allocated since the last garbage collection. All data types count.
See also `gc-cons-percentage'. */);
DEFVAR_LISP ("gc-cons-percentage", Vgc_cons_percentage,
- doc: /* *Portion of the heap used for allocation.
+ doc: /* Portion of the heap used for allocation.
Garbage collection can happen automatically once this portion of the heap
has been allocated since the last garbage collection.
If this portion is smaller than `gc-cons-threshold', this is ignored. */);
doc: /* Number of string characters that have been consed so far. */);
DEFVAR_INT ("misc-objects-consed", misc_objects_consed,
- doc: /* Number of miscellaneous objects that have been consed so far. */);
+ doc: /* Number of miscellaneous objects that have been consed so far.
+These include markers and overlays, plus certain objects not visible
+to users. */);
DEFVAR_INT ("intervals-consed", intervals_consed,
doc: /* Number of intervals that have been consed so far. */);
not be able to allocate the memory to hold it. */
Vmemory_signal_data
= pure_cons (Qerror,
- pure_cons (make_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil));
+ pure_cons (build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil));
DEFVAR_LISP ("memory-full", Vmemory_full,
doc: /* Non-nil means Emacs cannot get much more Lisp memory. */);
HCoop / bpt / emacs.git / blobdiff