#include <pthread.h>
#endif
-/* This file is part of the core Lisp implementation, and thus must
- deal with the real data structures. If the Lisp implementation is
- replaced, this file likely will not be used. */
-
-#undef HIDE_LISP_IMPLEMENTATION
#include "lisp.h"
#include "process.h"
#include "intervals.h"
#define VECTOR_UNMARK(V) ((V)->header.size &= ~ARRAY_MARK_FLAG)
#define VECTOR_MARKED_P(V) (((V)->header.size & ARRAY_MARK_FLAG) != 0)
-/* Value is the number of bytes of S, a pointer to a struct Lisp_String.
- Be careful during GC, because S->size contains the mark bit for
- strings. */
+/* Default value of gc_cons_threshold (see below). */
-#define GC_STRING_BYTES(S) (STRING_BYTES (S))
+#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, total_free_vector_bytes;
+static EMACS_INT total_free_floats, total_floats;
/* Points to memory space allocated as "spare", to be freed if we run
out of memory. We keep one large block, four cons-blocks, and
static ptrdiff_t stack_copy_size;
#endif
+static Lisp_Object Qstring_bytes, Qvector_slots, Qheap;
static Lisp_Object Qgc_cons_threshold;
Lisp_Object Qchar_table_extra_slots;
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. */
hold a size_t value and (2) the header size is a multiple of the
alignment that Emacs needs for C types and for USE_LSB_TAG. */
#define XMALLOC_BASE_ALIGNMENT \
- offsetof ( \
- struct { \
- union { long double d; intmax_t i; void *p; } u; \
- char c; \
- }, \
- c)
+ alignof (union { long double d; intmax_t i; void *p; })
#if USE_LSB_TAG
# define XMALLOC_HEADER_ALIGNMENT \
/* 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
STRING_BYTES_BOUND, nor can it be so long that the size_t
arithmetic in allocate_string_data would overflow while it is
calculating a value to be passed to malloc. */
-#define STRING_BYTES_MAX \
- min (STRING_BYTES_BOUND, \
- ((SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD \
- - GC_STRING_EXTRA \
- - offsetof (struct sblock, first_data) \
- - SDATA_DATA_OFFSET) \
- & ~(sizeof (EMACS_INT) - 1)))
+static ptrdiff_t const STRING_BYTES_MAX =
+ min (STRING_BYTES_BOUND,
+ ((SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD
+ - GC_STRING_EXTRA
+ - offsetof (struct sblock, first_data)
+ - SDATA_DATA_OFFSET)
+ & ~(sizeof (EMACS_INT) - 1)));
/* Initialize string allocation. Called from init_alloc_once. */
static int check_string_bytes_count;
-#define CHECK_STRING_BYTES(S) STRING_BYTES (S)
-
-
-/* Like GC_STRING_BYTES, but with debugging check. */
+/* Like STRING_BYTES, but with debugging check. Can be
+ called during GC, so pay attention to the mark bit. */
ptrdiff_t
string_bytes (struct Lisp_String *s)
/* Check that the string size recorded in the string is the
same as the one recorded in the sdata structure. */
- if (from->string)
- CHECK_STRING_BYTES (from->string);
-
- if (from->string)
- nbytes = GC_STRING_BYTES (from->string);
- else
- nbytes = SDATA_NBYTES (from);
-
- nbytes = SDATA_SIZE (nbytes);
+ nbytes = SDATA_SIZE (from->string ? string_bytes (from->string)
+ : SDATA_NBYTES (from));
from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
}
}
{
struct Lisp_String *s = b->first_data.string;
if (s)
- CHECK_STRING_BYTES (s);
+ string_bytes (s);
}
for (b = oldest_sblock; b; b = b->next)
check_sblock (current_sblock);
}
+#else /* not GC_CHECK_STRING_BYTES */
+
+#define check_string_bytes(all) ((void) 0)
+
#endif /* GC_CHECK_STRING_BYTES */
#ifdef GC_CHECK_STRING_FREE_LIST
if (s->data)
{
old_data = SDATA_OF_STRING (s);
- old_nbytes = GC_STRING_BYTES (s);
+ old_nbytes = STRING_BYTES (s);
}
else
old_data = NULL;
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
{
how large that is. Reset the sdata's string
back-pointer so that we know it's free. */
#ifdef GC_CHECK_STRING_BYTES
- if (GC_STRING_BYTES (s) != SDATA_NBYTES (data))
+ if (string_bytes (s) != SDATA_NBYTES (data))
abort ();
#else
- data->u.nbytes = GC_STRING_BYTES (s);
+ data->u.nbytes = STRING_BYTES (s);
#endif
data->string = NULL;
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
ptrdiff_t nbytes;
+ struct Lisp_String *s = from->string;
#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. */
- if (from->string
- && GC_STRING_BYTES (from->string) != SDATA_NBYTES (from))
+ if (s && string_bytes (s) != SDATA_NBYTES (from))
abort ();
#endif /* GC_CHECK_STRING_BYTES */
- if (from->string)
- nbytes = GC_STRING_BYTES (from->string);
- else
- nbytes = SDATA_NBYTES (from);
-
- if (nbytes > LARGE_STRING_BYTES)
- abort ();
+ nbytes = s ? STRING_BYTES (s) : SDATA_NBYTES (from);
+ eassert (nbytes <= LARGE_STRING_BYTES);
nbytes = SDATA_SIZE (nbytes);
from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
abort ();
#endif
- /* FROM->string non-null means it's alive. Copy its data. */
- if (from->string)
+ /* Non-NULL S means it's alive. Copy its data. */
+ if (s)
{
/* If TB is full, proceed with the next sblock. */
to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
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);
length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;
- /* 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);
/* 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;
ptr->car = Vdead;
#endif
cons_free_list = ptr;
+ consing_since_gc -= sizeof *ptr;
total_free_conses++;
}
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 (val = Qnil, i = count - 1; i >= 0; 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.
#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 (sizeof (Lisp_Object),
+ roundup_size = COMMON_MULTIPLE (word_size,
USE_LSB_TAG ? 1 << GCTYPEBITS : 1)
};
/* Size of the largest vector allocated from block. */
#define VBLOCK_BYTES_MAX \
- vroundup ((VECTOR_BLOCK_BYTES / 2) - sizeof (Lisp_Object))
+ 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. */
eassert ((index) < VECTOR_MAX_FREE_LIST_INDEX); \
(v)->header.next.vector = vector_free_lists[index]; \
vector_free_lists[index] = (v); \
- total_free_vector_bytes += (nbytes); \
+ total_free_vector_slots += (nbytes) / word_size; \
} while (0)
struct vector_block
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 *
vector = vector_free_lists[index];
vector_free_lists[index] = vector->header.next.vector;
vector->header.next.nbytes = nbytes;
- total_free_vector_bytes -= nbytes;
+ total_free_vector_slots -= nbytes / word_size;
return vector;
}
vector = vector_free_lists[index];
vector_free_lists[index] = vector->header.next.vector;
vector->header.next.nbytes = nbytes;
- total_free_vector_bytes -= 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. */
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) \
struct vector_block *block = vector_blocks, **bprev = &vector_blocks;
struct Lisp_Vector *vector, *next, **vprev = &large_vectors;
- total_free_vector_bytes = total_vector_size = 0;
+ total_vectors = total_vector_slots = total_free_vector_slots = 0;
memset (vector_free_lists, 0, sizeof (vector_free_lists));
/* Looking through vector blocks. */
if (VECTOR_MARKED_P (vector))
{
VECTOR_UNMARK (vector);
- total_vector_size += VECTOR_SIZE (vector);
+ total_vectors++;
+ total_vector_slots += vector->header.next.nbytes / word_size;
next = ADVANCE (vector, vector->header.next.nbytes);
}
else
if (VECTOR_MARKED_P (vector))
{
VECTOR_UNMARK (vector);
- total_vector_size += VECTOR_SIZE (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
static union Lisp_Misc *marker_free_list;
-/* 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;
--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;
/* Every character is at least one byte. */
eassert (charpos <= bytepos);
- obj = allocate_misc ();
- XMISCTYPE (obj) = Lisp_Misc_Marker;
+ obj = allocate_misc (Lisp_Misc_Marker);
m = XMARKER (obj);
m->buffer = buf;
m->charpos = charpos;
must not have been killed. */
return (m->type == MEM_TYPE_BUFFER
&& p == m->start
- && !NILP (((struct buffer *) p)->BUFFER_INTERNAL_FIELD (name)));
+ && !NILP (((struct buffer *) p)->INTERNAL_FIELD (name)));
}
#endif /* GC_MARK_STACK || defined GC_MALLOC_CHECK */
}
-/* Alignment of pointer values. Use offsetof, as it sometimes returns
+/* Alignment of pointer values. Use alignof, 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 GC_POINTER_ALIGNMENT alignof (void *)
/* 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
#if USE_LSB_TAG
size_t alignment = (1 << GCTYPEBITS);
#else
- size_t alignment = sizeof (EMACS_INT);
+ size_t alignment = alignof (EMACS_INT);
/* Give Lisp_Floats an extra alignment. */
if (type == Lisp_Float)
- {
-#if defined __GNUC__ && __GNUC__ >= 2
- alignment = __alignof (struct Lisp_Float);
-#else
- alignment = sizeof (struct Lisp_Float);
-#endif
- }
+ alignment = alignof (struct Lisp_Float);
#endif
again:
{
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);
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];
+ Lisp_Object total[11];
ptrdiff_t count = SPECPDL_INDEX ();
- EMACS_TIME t1;
+ EMACS_TIME start;
if (abort_on_gc)
abort ();
if (pure_bytes_used_before_overflow)
return Qnil;
- CHECK_CONS_LIST ();
+ check_cons_list ();
/* 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;
- }
- }
-
- t1 = current_emacs_time ();
+ start = current_emacs_time ();
/* In case user calls debug_print during GC,
don't let that cause a recursive GC. */
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->INTERNAL_FIELD (undo_list), Qt))
+ {
+ Lisp_Object tail, prev;
+ tail = nextb->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->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->INTERNAL_FIELD (undo_list));
+ }
gc_sweep ();
UNBLOCK_INPUT;
- CHECK_CONS_LIST ();
+ 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
{
/* Compute average percentage of zombies. */
- double nlive = 0;
-
- for (i = 0; i < 7; ++i)
- if (CONSP (total[i]))
- nlive += XFASTINT (XCAR (total[i]));
+ double nlive =
+ (total_conses + total_symbols + total_markers + total_strings
+ + total_vectors + total_floats + total_intervals + total_buffers);
avg_live = (avg_live * ngcs + nlive) / (ngcs + 1);
max_live = max (nlive, max_live);
avg_zombies = (avg_zombies * ngcs + nzombies) / (ngcs + 1);
max_zombies = max (nzombies, max_zombies);
++ngcs;
- }
+ }
#endif
if (!NILP (Vpost_gc_hook))
/* Accumulate statistics. */
if (FLOATP (Vgc_elapsed))
{
- EMACS_TIME t2 = current_emacs_time ();
- EMACS_TIME t3 = sub_emacs_time (t2, t1);
+ EMACS_TIME since_start = sub_emacs_time (current_emacs_time (), start);
Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed)
- + EMACS_TIME_TO_DOUBLE (t3));
+ + EMACS_TIME_TO_DOUBLE (since_start));
}
gcs_done++;
#endif /* not GC_CHECK_MARKED_OBJECTS */
- switch (SWITCH_ENUM_CAST (XTYPE (obj)))
+ switch (XTYPE (obj))
{
case Lisp_String:
{
#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. */
- CHECK_STRING_BYTES (ptr);
+ string_bytes (ptr);
#endif /* GC_CHECK_STRING_BYTES */
}
break;
#ifdef GC_CHECK_MARKED_OBJECTS
if (po != &buffer_defaults && po != &buffer_local_symbols)
{
- struct buffer *b = all_buffers;
- for (; b && b != po; b = b->header.next.buffer)
- ;
+ struct buffer *b;
+ FOR_EACH_BUFFER (b)
+ if (b == po)
+ break;
if (b == NULL)
abort ();
}
sweep_weak_hash_tables ();
sweep_strings ();
-#ifdef GC_CHECK_STRING_BYTES
- if (!noninteractive)
- check_string_bytes (1);
-#endif
+ check_string_bytes (!noninteractive);
/* Put all unmarked conses on free list */
{
{
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;
}
}
sweep_vectors ();
-
-#ifdef GC_CHECK_STRING_BYTES
- if (!noninteractive)
- check_string_bytes (1);
-#endif
+ check_string_bytes (!noninteractive);
}
return end;
}
-DEFUN ("memory-free", Fmemory_free, Smemory_free, 0, 0, 0,
- doc: /* Return a list (E H) of two measures of free memory.
-E counts free lists maintained by Emacs itself. H counts the heap,
-freed by Emacs but not released to the operating system; this is zero
-if heap statistics are not available. Both counters are in units of
-1024 bytes, rounded up. */)
- (void)
-{
- /* Make the return value first, so that its storage is accounted for. */
- Lisp_Object val = Fmake_list (make_number (2), make_number (0));
-
- XSETCAR (val,
- (make_number
- (min (MOST_POSITIVE_FIXNUM,
- ((total_free_conses * sizeof (struct Lisp_Cons)
- + total_free_markers * sizeof (union Lisp_Misc)
- + total_free_symbols * sizeof (struct Lisp_Symbol)
- + total_free_floats * sizeof (struct Lisp_Float)
- + total_free_intervals * sizeof (struct interval)
- + total_free_strings * sizeof (struct Lisp_String)
- + total_free_vector_bytes
- + 1023)
- >> 10)))));
-
-#ifdef DOUG_LEA_MALLOC
- XSETCAR (XCDR (val),
- make_number (min (MOST_POSITIVE_FIXNUM,
- (mallinfo ().fordblks + 1023) >> 10)));
-#endif
- return val;
-}
-
DEFUN ("memory-use-counts", Fmemory_use_counts, Smemory_use_counts, 0, 0, 0,
doc: /* Return a list of counters that measure how much consing there has been.
Each of these counters increments for a certain kind of object.
(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
#endif
refill_memory_reserve ();
- gc_cons_threshold = 100000 * sizeof (Lisp_Object);
+ 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 (build_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 (&Spurecopy);
defsubr (&Sgarbage_collect);
defsubr (&Smemory_limit);
- defsubr (&Smemory_free);
defsubr (&Smemory_use_counts);
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
defsubr (&Sgc_status);
#endif
}
+
+/* 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 CHARTAB_SIZE_BITS CHARTAB_SIZE_BITS;
+ enum CHAR_TABLE_STANDARD_SLOTS CHAR_TABLE_STANDARD_SLOTS;
+ enum char_bits char_bits;
+ enum CHECK_LISP_OBJECT_TYPE CHECK_LISP_OBJECT_TYPE;
+ enum DEFAULT_HASH_SIZE DEFAULT_HASH_SIZE;
+ enum enum_USE_LSB_TAG enum_USE_LSB_TAG;
+ enum FLOAT_TO_STRING_BUFSIZE FLOAT_TO_STRING_BUFSIZE;
+ enum Lisp_Bits Lisp_Bits;
+ enum Lisp_Compiled Lisp_Compiled;
+ enum maxargs maxargs;
+ enum MAX_ALLOCA MAX_ALLOCA;
+ enum More_Lisp_Bits More_Lisp_Bits;
+ enum pvec_type pvec_type;
+#if USE_LSB_TAG
+ enum lsb_bits lsb_bits;
+#endif
+} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0};