#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 <unistd.h>
#ifndef HAVE_UNISTD_H
-extern POINTER_TYPE *sbrk ();
+extern void *sbrk ();
#endif
#include <fcntl.h>
#define GC_STRING_BYTES(S) (STRING_BYTES (S))
+/* Default value of gc_cons_threshold (see below). */
+
+#define GC_DEFAULT_THRESHOLD (100000 * sizeof (Lisp_Object))
+
/* Global variables. */
struct emacs_globals globals;
/* Number of live and free conses etc. */
-static EMACS_INT total_conses, total_markers, total_symbols, total_vector_size;
+static EMACS_INT total_conses, total_markers, total_symbols, total_buffers;
static EMACS_INT total_free_conses, total_free_markers, total_free_symbols;
static EMACS_INT total_free_floats, total_floats;
/* 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 ptrdiff_t stack_copy_size;
#endif
-/* Non-zero means ignore malloc warnings. Set during initialization.
- Currently not used. */
-
-static int ignore_warnings;
-
+static Lisp_Object Qstring_bytes, Qvector_slots, Qheap;
static Lisp_Object Qgc_cons_threshold;
Lisp_Object Qchar_table_extra_slots;
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 *);
static void free_misc (Lisp_Object);
extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE;
+/* Handy constants for vectorlike objects. */
+enum
+ {
+ header_size = offsetof (struct Lisp_Vector, contents),
+ bool_header_size = offsetof (struct Lisp_Bool_Vector, data),
+ word_size = sizeof (Lisp_Object)
+ };
+
/* 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. */
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_malloc (size_t, enum mem_type);
+static void *lisp_malloc (size_t, enum mem_type);
#if GC_MARK_STACK || defined 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 *);
/* 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 int staticidx;
-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);
/* 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. */
}
static void
-lisp_align_free (POINTER_TYPE *block)
+lisp_align_free (void *block)
{
struct ablock *ablock = block;
struct ablocks *abase = ABLOCK_ABASE (ablock);
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
__malloc_extra_blocks = malloc_hysteresis;
#endif
- value = (void *) malloc (size);
+ value = malloc (size);
#ifdef GC_MALLOC_CHECK
{
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;
/* Index in interval_block above of the next unused interval
structure. */
-static int interval_block_index;
+static int interval_block_index = INTERVAL_BLOCK_SIZE;
/* Number of free and live intervals. */
static INTERVAL interval_free_list;
-
-/* Initialize interval allocation. */
-
-static void
-init_intervals (void)
-{
- interval_block = NULL;
- interval_block_index = INTERVAL_BLOCK_SIZE;
- interval_free_list = 0;
-}
-
-
/* Return a new interval. */
INTERVAL
{
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;
interval_block_index = 0;
+ total_free_intervals += INTERVAL_BLOCK_SIZE;
}
val = &interval_block->intervals[interval_block_index++];
}
consing_since_gc += sizeof (struct interval);
intervals_consed++;
+ total_free_intervals--;
RESET_INTERVAL (val);
val->gcmarkbit = 0;
return val;
}
-/* Mark Lisp objects in interval I. */
+/* Mark Lisp objects in interval I. */
static void
mark_interval (register INTERVAL i, Lisp_Object dummy)
{
- eassert (!i->gcmarkbit); /* Intervals are never shared. */
+ /* Intervals should never be shared. So, if extra internal checking is
+ enabled, GC aborts if it seems to have visited an interval twice. */
+ eassert (!i->gcmarkbit);
i->gcmarkbit = 1;
mark_object (i->plist);
}
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
-/* Convert the pointer-sized word P to EMACS_INT while preserving its
- type and ptr fields. */
-static Lisp_Object
-widen_to_Lisp_Object (void *p)
-{
- intptr_t i = (intptr_t) p;
-#ifdef USE_LISP_UNION_TYPE
- Lisp_Object obj;
- obj.i = i;
- return obj;
-#else
- return i;
-#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
/* Number of bytes used by live strings. */
-static EMACS_INT total_string_size;
+static EMACS_INT total_string_bytes;
/* Given a pointer to a Lisp_String S which is on the free-list
string_free_list, return a pointer to its successor in the
#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 */
static void
init_strings (void)
{
- total_strings = total_free_strings = total_string_size = 0;
- oldest_sblock = current_sblock = large_sblocks = NULL;
- string_blocks = NULL;
- string_free_list = NULL;
empty_unibyte_string = make_pure_string ("", 0, 0, 0);
empty_multibyte_string = make_pure_string ("", 0, 0, 1);
}
/* 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;
{
struct sdata *data, *old_data;
struct sblock *b;
- EMACS_INT needed, old_nbytes;
+ ptrdiff_t needed, old_nbytes;
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);
+ if (s->data)
+ {
+ old_data = SDATA_OF_STRING (s);
+ old_nbytes = GC_STRING_BYTES (s);
+ }
+ else
+ old_data = NULL;
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;
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. */
+ /* Note that Faset may call to this function when S has already data
+ assigned. In this case, mark data as free by setting it's string
+ back-pointer to null, and record the size of the data in it. */
if (old_data)
{
SDATA_NBYTES (old_data) = old_nbytes;
string_free_list = NULL;
total_strings = total_free_strings = 0;
- total_string_size = 0;
+ total_string_bytes = 0;
/* Scan strings_blocks, free Lisp_Strings that aren't marked. */
for (b = string_blocks; b; b = next)
UNMARK_BALANCE_INTERVALS (s->intervals);
++total_strings;
- total_string_size += STRING_BYTES (s);
+ total_string_bytes += STRING_BYTES (s);
}
else
{
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;
+ int extra_bool_elts = ((bool_header_size - header_size + word_size - 1)
+ / word_size);
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. */
- val = Fmake_vector (make_number (length_in_elts + 1), Qnil);
+ 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);
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);
/* Clear any extraneous bits in the last byte. */
p->data[length_in_chars - 1]
- &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
+ &= (1 << ((XFASTINT (length) - 1) % BOOL_VECTOR_BITS_PER_CHAR + 1)) - 1;
}
return val;
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
/***********************************************************************
/* Index of first unused Lisp_Float in the current float_block. */
-static int float_block_index;
+static int float_block_index = FLOAT_BLOCK_SIZE;
/* Free-list of Lisp_Floats. */
static struct Lisp_Float *float_free_list;
-
-/* Initialize float allocation. */
-
-static void
-init_float (void)
-{
- float_block = NULL;
- float_block_index = FLOAT_BLOCK_SIZE; /* Force alloc of new float_block. */
- float_free_list = 0;
-}
-
-
/* Return a new float object with value FLOAT_VALUE. */
Lisp_Object
{
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;
float_block_index = 0;
+ total_free_floats += FLOAT_BLOCK_SIZE;
}
XSETFLOAT (val, &float_block->floats[float_block_index]);
float_block_index++;
eassert (!FLOAT_MARKED_P (XFLOAT (val)));
consing_since_gc += sizeof (struct Lisp_Float);
floats_consed++;
+ total_free_floats--;
return val;
}
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) \
/* Index of first unused Lisp_Cons in the current block. */
-static int cons_block_index;
+static int cons_block_index = CONS_BLOCK_SIZE;
/* Free-list of Lisp_Cons structures. */
static struct Lisp_Cons *cons_free_list;
-
-/* Initialize cons allocation. */
-
-static void
-init_cons (void)
-{
- cons_block = NULL;
- cons_block_index = CONS_BLOCK_SIZE; /* Force alloc of new cons_block. */
- cons_free_list = 0;
-}
-
-
/* Explicitly free a cons cell by putting it on the free-list. */
void
ptr->car = Vdead;
#endif
cons_free_list = ptr;
+ consing_since_gc -= sizeof *ptr;
+ total_free_conses++;
}
DEFUN ("cons", Fcons, Scons, 2, 2, 0,
{
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;
cons_block_index = 0;
+ total_free_conses += CONS_BLOCK_SIZE;
}
XSETCONS (val, &cons_block->conses[cons_block_index]);
cons_block_index++;
XSETCDR (val, cdr);
eassert (!CONS_MARKED_P (XCONS (val)));
consing_since_gc += sizeof (struct Lisp_Cons);
+ total_free_conses--;
cons_cells_consed++;
return val;
}
Fcons (arg5, Qnil)))));
}
+/* Make a list of COUNT Lisp_Objects, where ARG is the
+ first one. Allocate conses from pure space if TYPE
+ is CONSTYPE_PURE, or allocate as usual if type is CONSTYPE_HEAP. */
+
+Lisp_Object
+listn (enum constype type, ptrdiff_t count, Lisp_Object arg, ...)
+{
+ va_list ap;
+ ptrdiff_t i;
+ Lisp_Object val, *objp;
+
+ /* Change to SAFE_ALLOCA if you hit this eassert. */
+ eassert (count <= MAX_ALLOCA / sizeof (Lisp_Object));
+
+ objp = alloca (count * sizeof (Lisp_Object));
+ objp[0] = arg;
+ va_start (ap, arg);
+ for (i = 1; i < count; i++)
+ objp[i] = va_arg (ap, Lisp_Object);
+ va_end (ap);
+
+ for (i = 0, val = Qnil; i < count; i++)
+ {
+ if (type == CONSTYPE_PURE)
+ val = pure_cons (objp[i], val);
+ else if (type == CONSTYPE_HEAP)
+ val = Fcons (objp[i], val);
+ else
+ abort ();
+ }
+ return val;
+}
DEFUN ("list", Flist, Slist, 0, MANY, 0,
doc: /* Return a newly created list with specified arguments as elements.
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. */
+/* Align allocation request sizes to be a multiple of ROUNDUP_SIZE. */
enum
{
- header_size = offsetof (struct Lisp_Vector, contents),
- word_size = sizeof (Lisp_Object)
+ roundup_size = COMMON_MULTIPLE (word_size,
+ 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) - word_size)
+
+/* 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); \
+ total_free_vector_slots += (nbytes) / word_size; \
+ } 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. */
+
+Lisp_Object zero_vector;
+
+/* Number of live vectors. */
+
+static EMACS_INT total_vectors;
+
+/* Total size of live and free vectors, in Lisp_Object units. */
+
+static EMACS_INT total_vector_slots, total_free_vector_slots;
+
+/* 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 = make_pure_vector (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;
+ total_free_vector_slots -= nbytes / word_size;
+ 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;
+ 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);
+ 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;
+ }
+
+/* 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_vectors = total_vector_slots = total_free_vector_slots = 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_vectors++;
+ total_vector_slots += vector->header.next.nbytes / word_size;
+ 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_vectors++;
+ if (vector->header.size & PSEUDOVECTOR_FLAG)
+ {
+ struct Lisp_Bool_Vector *b = (struct Lisp_Bool_Vector *) vector;
+
+ /* All non-bool pseudovectors are small enough to be allocated
+ from vector blocks. This code should be redesigned if some
+ pseudovector type grows beyond VBLOCK_BYTES_MAX. */
+ eassert (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BOOL_VECTOR));
+
+ total_vector_slots
+ += (bool_header_size
+ + ((b->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
+ / BOOL_VECTOR_BITS_PER_CHAR)) / word_size;
+ }
+ else
+ total_vector_slots
+ += header_size / word_size + vector->header.size;
+ 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 = XVECTOR (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;
}
union aligned_Lisp_Symbol
{
struct Lisp_Symbol s;
-#ifdef USE_LSB_TAG
+#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 (union aligned_Lisp_Symbol))
structure in it. */
static struct symbol_block *symbol_block;
-static int symbol_block_index;
+static int symbol_block_index = SYMBOL_BLOCK_SIZE;
/* List of free symbols. */
static struct Lisp_Symbol *symbol_free_list;
-
-/* Initialize symbol allocation. */
-
-static void
-init_symbol (void)
-{
- symbol_block = NULL;
- symbol_block_index = SYMBOL_BLOCK_SIZE;
- symbol_free_list = 0;
-}
-
-
DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
doc: /* Return a newly allocated uninterned symbol whose name is NAME.
Its value and function definition are void, and its property list is nil. */)
{
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;
+ total_free_symbols += SYMBOL_BLOCK_SIZE;
}
XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index].s);
symbol_block_index++;
p->declared_special = 0;
consing_since_gc += sizeof (struct Lisp_Symbol);
symbols_consed++;
+ total_free_symbols--;
return val;
}
union aligned_Lisp_Misc
{
union Lisp_Misc m;
-#ifdef USE_LSB_TAG
+#if USE_LSB_TAG
unsigned char c[(sizeof (union Lisp_Misc) + (1 << GCTYPEBITS) - 1)
& -(1 << GCTYPEBITS)];
#endif
};
static struct marker_block *marker_block;
-static int marker_block_index;
+static int marker_block_index = MARKER_BLOCK_SIZE;
static union Lisp_Misc *marker_free_list;
-static void
-init_marker (void)
-{
- marker_block = NULL;
- marker_block_index = MARKER_BLOCK_SIZE;
- marker_free_list = 0;
-}
-
-/* Return a newly allocated Lisp_Misc object, with no substructure. */
+/* Return a newly allocated Lisp_Misc object of specified TYPE. */
-Lisp_Object
-allocate_misc (void)
+static Lisp_Object
+allocate_misc (enum Lisp_Misc_Type type)
{
Lisp_Object val;
{
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;
consing_since_gc += sizeof (union Lisp_Misc);
misc_objects_consed++;
+ XMISCTYPE (val) = type;
XMISCANY (val)->gcmarkbit = 0;
return val;
}
XMISCTYPE (misc) = Lisp_Misc_Free;
XMISC (misc)->u_free.chain = marker_free_list;
marker_free_list = XMISC (misc);
-
+ consing_since_gc -= sizeof (union Lisp_Misc);
total_free_markers++;
}
register Lisp_Object val;
register struct Lisp_Save_Value *p;
- val = allocate_misc ();
- XMISCTYPE (val) = Lisp_Misc_Save_Value;
+ val = allocate_misc (Lisp_Misc_Save_Value);
p = XSAVE_VALUE (val);
p->pointer = pointer;
p->integer = integer;
return val;
}
+/* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */
+
+Lisp_Object
+build_overlay (Lisp_Object start, Lisp_Object end, Lisp_Object plist)
+{
+ register Lisp_Object overlay;
+
+ overlay = allocate_misc (Lisp_Misc_Overlay);
+ OVERLAY_START (overlay) = start;
+ OVERLAY_END (overlay) = end;
+ OVERLAY_PLIST (overlay) = plist;
+ XOVERLAY (overlay)->next = NULL;
+ return overlay;
+}
+
DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
doc: /* Return a newly allocated marker which does not point at any place. */)
(void)
register Lisp_Object val;
register struct Lisp_Marker *p;
- val = allocate_misc ();
- XMISCTYPE (val) = Lisp_Misc_Marker;
+ val = allocate_misc (Lisp_Misc_Marker);
p = XMARKER (val);
p->buffer = 0;
p->bytepos = 0;
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 (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;
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 defined USE_LSB_TAG || UINTPTR_MAX >> VALBITS != 0
-# if !defined USE_LSB_TAG && UINTPTR_MAX >> VALBITS >> GCTYPEBITS != 0
+#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. */
static void
mark_memory (void *start, void *end)
+#if defined (__clang__) && defined (__has_feature)
+#if __has_feature(address_sanitizer)
+ /* Do not allow -faddress-sanitizer to check this function, since it
+ crosses the function stack boundary, and thus would yield many
+ false positives. */
+ __attribute__((no_address_safety_analysis))
+#endif
+#endif
{
void **pp;
int i;
void *p = *(void **) ((char *) pp + i);
mark_maybe_pointer (p);
if (POINTERS_MIGHT_HIDE_IN_OBJECTS)
- mark_maybe_object (widen_to_Lisp_Object (p));
+ mark_maybe_object (XIL ((intptr_t) p));
}
}
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;
- size_t size = (offsetof (struct Lisp_Vector, contents)
- + len * sizeof (Lisp_Object));
+ size_t size = header_size + len * word_size;
p = (struct Lisp_Vector *) pure_alloc (size, Lisp_Vectorlike);
XSETVECTOR (new, 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;
}
+/* Used to avoid possible overflows when
+ converting from C to Lisp integers. */
+
+static inline Lisp_Object
+bounded_number (EMACS_INT number)
+{
+ return make_number (min (MOST_POSITIVE_FIXNUM, number));
+}
DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
doc: /* Reclaim storage for Lisp objects no longer needed.
Garbage collection happens automatically if you cons more than
`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-MISCS . FREE-MISCS) USED-STRING-CHARS USED-VECTOR-SLOTS
- (USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS)
- (USED-STRINGS . FREE-STRINGS))
+`garbage-collect' normally returns a list with info on amount of space in use,
+where each entry has the form (NAME SIZE USED FREE), where:
+- NAME is a symbol describing the kind of objects this entry represents,
+- SIZE is the number of bytes used by each one,
+- USED is the number of those objects that were found live in the heap,
+- FREE is the number of those objects that are not live but that Emacs
+ keeps around for future allocations (maybe because it does not know how
+ to return them to the OS).
However, if there was overflow in pure space, `garbage-collect'
returns nil, because real GC can't be done.
See Info node `(elisp)Garbage Collection'. */)
(void)
{
register struct specbinding *bind;
+ register struct buffer *nextb;
char stack_top_variable;
ptrdiff_t i;
int message_p;
- Lisp_Object total[8];
- int count = SPECPDL_INDEX ();
- EMACS_TIME t1, t2, t3;
+ Lisp_Object total[11];
+ ptrdiff_t count = SPECPDL_INDEX ();
+ EMACS_TIME t1;
if (abort_on_gc)
abort ();
/* Don't keep undo information around forever.
Do this early on, so it is no problem if the user quits. */
- {
- register struct buffer *nextb = all_buffers;
-
- while (nextb)
- {
- /* If a buffer's undo list is Qt, that means that undo is
- turned off in that buffer. Calling truncate_undo_list on
- Qt tends to return NULL, which effectively turns undo back on.
- So don't call truncate_undo_list if undo_list is Qt. */
- if (! 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 (nextb->base_buffer == 0 && !NILP (nextb->BUFFER_INTERNAL_FIELD (name))
- && ! nextb->text->inhibit_shrinking)
- {
- /* If a buffer's gap size is more than 10% of the buffer
- size, or larger than 2000 bytes, then shrink it
- accordingly. Keep a minimum size of 20 bytes. */
- int size = min (2000, max (20, (nextb->text->z_byte / 10)));
-
- if (nextb->text->gap_size > size)
- {
- struct buffer *save_current = current_buffer;
- current_buffer = nextb;
- make_gap (-(nextb->text->gap_size - size));
- current_buffer = save_current;
- }
- }
+ FOR_EACH_BUFFER (nextb)
+ compact_buffer (nextb);
- nextb = nextb->header.next.buffer;
- }
- }
-
- EMACS_GET_TIME (t1);
+ t1 = current_emacs_time ();
/* In case user calls debug_print during GC,
don't let that cause a recursive GC. */
{
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);
gc_in_progress = 1;
- /* clear_marks (); */
-
/* Mark all the special slots that serve as the roots of accessibility. */
for (i = 0; i < staticidx; i++)
Look thru every buffer's undo list
for elements that update markers that were not marked,
and delete them. */
- {
- register struct buffer *nextb = all_buffers;
-
- while (nextb)
- {
- /* If a buffer's undo list is Qt, that means that undo is
- turned off in that buffer. Calling truncate_undo_list on
- Qt tends to return NULL, which effectively turns undo back on.
- So don't call truncate_undo_list if undo_list is Qt. */
- if (! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
- {
- Lisp_Object tail, prev;
- tail = nextb->BUFFER_INTERNAL_FIELD (undo_list);
- prev = Qnil;
- while (CONSP (tail))
- {
- if (CONSP (XCAR (tail))
- && MARKERP (XCAR (XCAR (tail)))
- && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
- {
- if (NILP (prev))
- nextb->BUFFER_INTERNAL_FIELD (undo_list) = tail = XCDR (tail);
- else
- {
- tail = XCDR (tail);
- XSETCDR (prev, tail);
- }
- }
- else
- {
- prev = tail;
- tail = XCDR (tail);
- }
- }
- }
- /* Now that we have stripped the elements that need not be in the
- undo_list any more, we can finally mark the list. */
- mark_object (nextb->BUFFER_INTERNAL_FIELD (undo_list));
-
- nextb = nextb->header.next.buffer;
- }
- }
+ FOR_EACH_BUFFER (nextb)
+ {
+ /* If a buffer's undo list is Qt, that means that undo is
+ turned off in that buffer. Calling truncate_undo_list on
+ Qt tends to return NULL, which effectively turns undo back on.
+ So don't call truncate_undo_list if undo_list is Qt. */
+ if (! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt))
+ {
+ Lisp_Object tail, prev;
+ tail = nextb->BUFFER_INTERNAL_FIELD (undo_list);
+ prev = Qnil;
+ while (CONSP (tail))
+ {
+ if (CONSP (XCAR (tail))
+ && MARKERP (XCAR (XCAR (tail)))
+ && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
+ {
+ if (NILP (prev))
+ nextb->BUFFER_INTERNAL_FIELD (undo_list) = tail = XCDR (tail);
+ else
+ {
+ tail = XCDR (tail);
+ XSETCDR (prev, tail);
+ }
+ }
+ else
+ {
+ prev = tail;
+ tail = XCDR (tail);
+ }
+ }
+ }
+ /* Now that we have stripped the elements that need not be in the
+ undo_list any more, we can finally mark the list. */
+ mark_object (nextb->BUFFER_INTERNAL_FIELD (undo_list));
+ }
gc_sweep ();
CHECK_CONS_LIST ();
- /* clear_marks (); */
gc_in_progress = 0;
consing_since_gc = 0;
- if (gc_cons_threshold < 10000)
- gc_cons_threshold = 10000;
+ if (gc_cons_threshold < GC_DEFAULT_THRESHOLD / 10)
+ gc_cons_threshold = GC_DEFAULT_THRESHOLD / 10;
gc_relative_threshold = 0;
if (FLOATP (Vgc_cons_percentage))
tot += total_conses * sizeof (struct Lisp_Cons);
tot += total_symbols * sizeof (struct Lisp_Symbol);
tot += total_markers * sizeof (union Lisp_Misc);
- tot += total_string_size;
- tot += total_vector_size * sizeof (Lisp_Object);
+ tot += total_string_bytes;
+ tot += total_vector_slots * word_size;
tot += total_floats * sizeof (struct Lisp_Float);
tot += total_intervals * sizeof (struct interval);
tot += total_strings * sizeof (struct Lisp_String);
unbind_to (count, Qnil);
- total[0] = Fcons (make_number (total_conses),
- make_number (total_free_conses));
- total[1] = Fcons (make_number (total_symbols),
- make_number (total_free_symbols));
- total[2] = Fcons (make_number (total_markers),
- make_number (total_free_markers));
- total[3] = make_number (total_string_size);
- total[4] = make_number (total_vector_size);
- total[5] = Fcons (make_number (total_floats),
- make_number (total_free_floats));
- total[6] = Fcons (make_number (total_intervals),
- make_number (total_free_intervals));
- total[7] = Fcons (make_number (total_strings),
- make_number (total_free_strings));
+ total[0] = list4 (Qcons, make_number (sizeof (struct Lisp_Cons)),
+ bounded_number (total_conses),
+ bounded_number (total_free_conses));
+
+ total[1] = list4 (Qsymbol, make_number (sizeof (struct Lisp_Symbol)),
+ bounded_number (total_symbols),
+ bounded_number (total_free_symbols));
+
+ total[2] = list4 (Qmisc, make_number (sizeof (union Lisp_Misc)),
+ bounded_number (total_markers),
+ bounded_number (total_free_markers));
+
+ total[3] = list4 (Qstring, make_number (sizeof (struct Lisp_String)),
+ bounded_number (total_strings),
+ bounded_number (total_free_strings));
+
+ total[4] = list3 (Qstring_bytes, make_number (1),
+ bounded_number (total_string_bytes));
+
+ total[5] = list3 (Qvector, make_number (sizeof (struct Lisp_Vector)),
+ bounded_number (total_vectors));
+
+ total[6] = list4 (Qvector_slots, make_number (word_size),
+ bounded_number (total_vector_slots),
+ bounded_number (total_free_vector_slots));
+
+ total[7] = list4 (Qfloat, make_number (sizeof (struct Lisp_Float)),
+ bounded_number (total_floats),
+ bounded_number (total_free_floats));
+
+ total[8] = list4 (Qinterval, make_number (sizeof (struct interval)),
+ bounded_number (total_intervals),
+ bounded_number (total_free_intervals));
+
+ total[9] = list3 (Qbuffer, make_number (sizeof (struct buffer)),
+ bounded_number (total_buffers));
+
+ total[10] = list4 (Qheap, make_number (1024),
+#ifdef DOUG_LEA_MALLOC
+ bounded_number ((mallinfo ().uordblks + 1023) >> 10),
+ bounded_number ((mallinfo ().fordblks + 1023) >> 10)
+#else
+ Qnil, Qnil
+#endif
+ );
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
{
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_TIME t2 = current_emacs_time ();
+ EMACS_TIME t3 = sub_emacs_time (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;
+ FOR_EACH_BUFFER (b)
+ if (b == po)
+ break;
+ 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 Fgarbage_collect. */
{
register struct buffer *buffer = all_buffers, *prev = 0, *next;
+ total_buffers = 0;
while (buffer)
if (!VECTOR_MARKED_P (buffer))
{
{
VECTOR_UNMARK (buffer);
UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer));
+ total_buffers++;
prev = buffer, buffer = buffer->header.next.buffer;
}
}
- /* 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)
(but the contents of a buffer's text do not count here). */)
(void)
{
- Lisp_Object consed[8];
-
- consed[0] = make_number (min (MOST_POSITIVE_FIXNUM, cons_cells_consed));
- consed[1] = make_number (min (MOST_POSITIVE_FIXNUM, floats_consed));
- consed[2] = make_number (min (MOST_POSITIVE_FIXNUM, vector_cells_consed));
- consed[3] = make_number (min (MOST_POSITIVE_FIXNUM, symbols_consed));
- consed[4] = make_number (min (MOST_POSITIVE_FIXNUM, string_chars_consed));
- consed[5] = make_number (min (MOST_POSITIVE_FIXNUM, misc_objects_consed));
- consed[6] = make_number (min (MOST_POSITIVE_FIXNUM, intervals_consed));
- consed[7] = make_number (min (MOST_POSITIVE_FIXNUM, strings_consed));
-
- return Flist (8, consed);
+ return listn (CONSTYPE_HEAP, 8,
+ bounded_number (cons_cells_consed),
+ bounded_number (floats_consed),
+ bounded_number (vector_cells_consed),
+ bounded_number (symbols_consed),
+ bounded_number (string_chars_consed),
+ bounded_number (misc_objects_consed),
+ bounded_number (intervals_consed),
+ bounded_number (strings_consed));
}
/* Find at most FIND_MAX symbols which have OBJ as their value or
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))
/* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
purebeg = PUREBEG;
pure_size = PURESIZE;
- pure_bytes_used = 0;
- pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0;
- pure_bytes_used_before_overflow = 0;
-
- /* Initialize the list of free aligned blocks. */
- free_ablock = NULL;
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
mem_init ();
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 */
mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); /* max. number of mmap'ed areas */
#endif
init_strings ();
- init_cons ();
- init_symbol ();
- init_marker ();
- init_float ();
- init_intervals ();
- init_weak_hash_tables ();
+ init_vectors ();
#ifdef REL_ALLOC
malloc_hysteresis = 32;
#endif
refill_memory_reserve ();
-
- ignore_warnings = 0;
- gcprolist = 0;
- byte_stack_list = 0;
- staticidx = 0;
- consing_since_gc = 0;
- gc_cons_threshold = 100000 * sizeof (Lisp_Object);
- gc_relative_threshold = 0;
+ gc_cons_threshold = GC_DEFAULT_THRESHOLD;
}
void
/* We build this in advance because if we wait until we need it, we might
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));
+ = listn (CONSTYPE_PURE, 2, Qerror,
+ build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"));
DEFVAR_LISP ("memory-full", Vmemory_full,
doc: /* Non-nil means Emacs cannot get much more Lisp memory. */);
Vmemory_full = Qnil;
+ DEFSYM (Qstring_bytes, "string-bytes");
+ DEFSYM (Qvector_slots, "vector-slots");
+ DEFSYM (Qheap, "heap");
+
DEFSYM (Qgc_cons_threshold, "gc-cons-threshold");
DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots");
defsubr (&Sgc_status);
#endif
}
+
+/* Make some symbols visible to GDB. This section is last, so that
+ the #undef lines don't mess up later code. */
+
+/* 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. */
+union
+{
+ enum CHECK_LISP_OBJECT_TYPE CHECK_LISP_OBJECT_TYPE;
+ enum enum_USE_LSB_TAG enum_USE_LSB_TAG;
+ enum Lisp_Bits Lisp_Bits;
+ enum More_Lisp_Bits More_Lisp_Bits;
+ enum pvec_type pvec_type;
+} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0};
+
+/* These symbols cannot be done as enums, since values might not be
+ in 'int' range. Each symbol X has a corresponding X_VAL symbol,
+ verified to have the correct value. */
+
+#define ARRAY_MARK_FLAG_VAL PTRDIFF_MIN
+#define PSEUDOVECTOR_FLAG_VAL (PTRDIFF_MAX - PTRDIFF_MAX / 2)
+#define VALMASK_VAL (USE_LSB_TAG ? -1 << GCTYPEBITS : VAL_MAX)
+
+verify (ARRAY_MARK_FLAG_VAL == ARRAY_MARK_FLAG);
+verify (PSEUDOVECTOR_FLAG_VAL == PSEUDOVECTOR_FLAG);
+verify (VALMASK_VAL == VALMASK);
+
+#undef ARRAY_MARK_FLAG
+#undef PSEUDOVECTOR_FLAG
+#undef VALMASK
+
+ptrdiff_t const EXTERNALLY_VISIBLE
+ ARRAY_MARK_FLAG = ARRAY_MARK_FLAG_VAL,
+ PSEUDOVECTOR_FLAG = PSEUDOVECTOR_FLAG_VAL;
+
+EMACS_INT const EXTERNALLY_VISIBLE
+ VALMASK = VALMASK_VAL;
HCoop / bpt / emacs.git / blobdiff