#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;
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;
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 (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.
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
static EMACS_INT total_vectors;
-/* Number of bytes used by live and free vectors. */
+/* Total size of live and free vectors, in Lisp_Object units. */
-static EMACS_INT total_vector_bytes, total_free_vector_bytes;
+static EMACS_INT total_vector_slots, total_free_vector_slots;
/* Get a new 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. */
struct vector_block *block = vector_blocks, **bprev = &vector_blocks;
struct Lisp_Vector *vector, *next, **vprev = &large_vectors;
- total_vectors = total_vector_bytes = total_free_vector_bytes = 0;
+ total_vectors = total_vector_slots = total_free_vector_slots = 0;
memset (vector_free_lists, 0, sizeof (vector_free_lists));
/* Looking through vector blocks. */
{
VECTOR_UNMARK (vector);
total_vectors++;
- total_vector_bytes += vector->header.next.nbytes;
+ total_vector_slots += vector->header.next.nbytes / word_size;
next = ADVANCE (vector, vector->header.next.nbytes);
}
else
pseudovector type grows beyond VBLOCK_BYTES_MAX. */
eassert (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BOOL_VECTOR));
- total_vector_bytes
+ total_vector_slots
+= (bool_header_size
+ ((b->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR));
+ / BOOL_VECTOR_BITS_PER_CHAR)) / word_size;
}
else
- total_vector_bytes += (header_size
- + vector->header.size * word_size);
+ 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;
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:
- ((CONS INTERNAL-SIZE USED-CONSES FREE-CONSES)
- (SYMBOL INTERNAL-SIZE USED-SYMBOLS FREE-SYMBOLS)
- (MISC INTERNAL-SIZE USED-MISCS FREE-MISCS)
- (STRING INTERNAL-SIZE USED-STRINGS USED-STRING-BYTES FREE-STRING)
- (VECTOR INTERNAL-SIZE USED-VECTORS USED-VECTOR-BYTES FREE-VECTOR-BYTES)
- (FLOAT INTERNAL-SIZE USED-FLOATS FREE-FLOATS)
- (INTERVAL INTERNAL-SIZE USED-INTERVALS FREE-INTERVALS)
- (BUFFER INTERNAL-SIZE USED-BUFFERS))
+`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'. */)
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;
/* Don't keep undo information around forever.
Do this early on, so it is no problem if the user quits. */
- 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 (! 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);
t1 = current_emacs_time ();
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. */
- for_each_buffer (nextb)
+ 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
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_symbols * sizeof (struct Lisp_Symbol);
tot += total_markers * sizeof (union Lisp_Misc);
tot += total_string_bytes;
- tot += total_vector_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);
bounded_number (total_markers),
bounded_number (total_free_markers));
- total[3] = list5 (Qstring, make_number (sizeof (struct Lisp_String)),
+ total[3] = list4 (Qstring, make_number (sizeof (struct Lisp_String)),
bounded_number (total_strings),
- bounded_number (total_string_bytes),
bounded_number (total_free_strings));
- total[4] = list5 (Qvector, make_number (sizeof (struct Lisp_Vector)),
- bounded_number (total_vectors),
- bounded_number (total_vector_bytes),
- bounded_number (total_free_vector_bytes));
+ total[4] = list3 (Qstring_bytes, make_number (1),
+ bounded_number (total_string_bytes));
- total[5] = list4 (Qfloat, make_number (sizeof (struct Lisp_Float)),
+ 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[6] = list4 (Qinterval, make_number (sizeof (struct interval)),
+ total[8] = list4 (Qinterval, make_number (sizeof (struct interval)),
bounded_number (total_intervals),
bounded_number (total_free_intervals));
- total[7] = list3 (Qbuffer, make_number (sizeof (struct buffer)),
+ 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. */
if (po != &buffer_defaults && po != &buffer_local_symbols)
{
struct buffer *b;
- for_each_buffer (b)
+ FOR_EACH_BUFFER (b)
if (b == po)
break;
if (b == NULL)
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,
- bounded_number
- ((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), bounded_number ((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] = bounded_number (cons_cells_consed);
- consed[1] = bounded_number (floats_consed);
- consed[2] = bounded_number (vector_cells_consed);
- consed[3] = bounded_number (symbols_consed);
- consed[4] = bounded_number (string_chars_consed);
- consed[5] = bounded_number (misc_objects_consed);
- consed[6] = bounded_number (intervals_consed);
- consed[7] = bounded_number (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
}
+
+/* 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