#endif
#ifdef WINDOWSNT
#include "w32.h"
+#include "w32heap.h" /* for sbrk */
#endif
#ifdef DOUG_LEA_MALLOC
static Lisp_Object Qbuffers;
static Lisp_Object Qstring_bytes, Qvector_slots, Qheap;
static Lisp_Object Qgc_cons_threshold;
+Lisp_Object Qautomatic_gc;
Lisp_Object Qchar_table_extra_slots;
/* Hook run after GC has finished. */
static void mem_rotate_right (struct mem_node *);
static void mem_delete (struct mem_node *);
static void mem_delete_fixup (struct mem_node *);
-static inline struct mem_node *mem_find (void *);
+static struct mem_node *mem_find (void *);
#endif
/* Addresses of staticpro'd variables. Initialize it to a nonzero
value; otherwise some compilers put it into BSS. */
-#define NSTATICS 0x650
+#define NSTATICS 0x1000
static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
/* Index of next unused slot in staticvec. */
malloc_block_input (void)
{
if (block_input_in_memory_allocators)
- BLOCK_INPUT;
+ block_input ();
}
static void
malloc_unblock_input (void)
{
if (block_input_in_memory_allocators)
- UNBLOCK_INPUT;
+ unblock_input ();
}
# define MALLOC_BLOCK_INPUT malloc_block_input ()
# define MALLOC_UNBLOCK_INPUT malloc_unblock_input ()
# define MALLOC_UNBLOCK_INPUT ((void) 0)
#endif
+#define MALLOC_PROBE(size) \
+ do { \
+ if (profiler_memory_running) \
+ malloc_probe (size); \
+ } while (0)
+
+
/* Like malloc but check for no memory and block interrupt input.. */
void *
if (!val && size)
memory_full (size);
+ MALLOC_PROBE (size);
return val;
}
if (!val && size)
memory_full (size);
memset (val, 0, size);
+ MALLOC_PROBE (size);
return val;
}
if (!val && size)
memory_full (size);
+ MALLOC_PROBE (size);
return val;
}
MALLOC_UNBLOCK_INPUT;
if (!val && nbytes)
memory_full (nbytes);
+ MALLOC_PROBE (nbytes);
return val;
}
MALLOC_UNBLOCK_INPUT;
+ MALLOC_PROBE (nbytes);
+
eassert (0 == ((uintptr_t) val) % BLOCK_ALIGN);
return val;
}
ptrdiff_t i;
register struct Lisp_Vector *p;
- /* We used to purecopy everything here, if purify-flga was set. This worked
+ /* We used to purecopy everything here, if purify-flag was set. This worked
OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
dangerous, since make-byte-code is used during execution to build
closures, so any closure built during the preload phase would end up
/* Value is a pointer to the mem_node containing START. Value is
MEM_NIL if there is no node in the tree containing START. */
-static inline struct mem_node *
+static struct mem_node *
mem_find (void *start)
{
struct mem_node *p;
/* Value is non-zero if P is a pointer to a live Lisp string on
the heap. M is a pointer to the mem_block for P. */
-static inline bool
+static bool
live_string_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_STRING)
/* Value is non-zero if P is a pointer to a live Lisp cons on
the heap. M is a pointer to the mem_block for P. */
-static inline bool
+static bool
live_cons_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_CONS)
/* Value is non-zero if P is a pointer to a live Lisp symbol on
the heap. M is a pointer to the mem_block for P. */
-static inline bool
+static bool
live_symbol_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_SYMBOL)
/* Value is non-zero if P is a pointer to a live Lisp float on
the heap. M is a pointer to the mem_block for P. */
-static inline bool
+static bool
live_float_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_FLOAT)
/* Value is non-zero if P is a pointer to a live Lisp Misc on
the heap. M is a pointer to the mem_block for P. */
-static inline bool
+static bool
live_misc_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_MISC)
/* Value is non-zero if P is a pointer to a live vector-like object.
M is a pointer to the mem_block for P. */
-static inline bool
+static bool
live_vector_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_VECTOR_BLOCK)
/* Value is non-zero if P is a pointer to a live buffer. M is a
pointer to the mem_block for P. */
-static inline bool
+static bool
live_buffer_p (struct mem_node *m, void *p)
{
/* P must point to the start of the block, and the buffer
/* Mark OBJ if we can prove it's a Lisp_Object. */
-static inline void
+static void
mark_maybe_object (Lisp_Object obj)
{
void *po;
/* If P points to Lisp data, mark that as live if it isn't already
marked. */
-static inline void
+static void
mark_maybe_pointer (void *p)
{
struct mem_node *m;
{
staticvec[staticidx++] = varaddress;
if (staticidx >= NSTATICS)
- emacs_abort ();
+ fatal ("NSTATICS too small; try increasing and recompiling Emacs.");
}
\f
/* Used to avoid possible overflows when
converting from C to Lisp integers. */
-static inline Lisp_Object
+static Lisp_Object
bounded_number (EMACS_INT number)
{
return make_number (min (MOST_POSITIVE_FIXNUM, number));
}
+/* Calculate total bytes of live objects. */
+
+static size_t
+total_bytes_of_live_objects (void)
+{
+ size_t tot = 0;
+ tot += total_conses * sizeof (struct Lisp_Cons);
+ tot += total_symbols * sizeof (struct Lisp_Symbol);
+ tot += total_markers * sizeof (union Lisp_Misc);
+ 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);
+ return tot;
+}
+
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
ptrdiff_t count = SPECPDL_INDEX ();
EMACS_TIME start;
Lisp_Object retval = Qnil;
+ size_t tot_before = 0;
+ struct backtrace backtrace;
if (abort_on_gc)
emacs_abort ();
if (pure_bytes_used_before_overflow)
return Qnil;
+ /* Record this function, so it appears on the profiler's backtraces. */
+ backtrace.next = backtrace_list;
+ backtrace.function = Qautomatic_gc;
+ backtrace.args = &Qnil;
+ backtrace.nargs = 0;
+ backtrace.debug_on_exit = 0;
+ backtrace_list = &backtrace;
+
check_cons_list ();
/* Don't keep undo information around forever.
FOR_EACH_BUFFER (nextb)
compact_buffer (nextb);
+ if (profiler_memory_running)
+ tot_before = total_bytes_of_live_objects ();
+
start = current_emacs_time ();
/* In case user calls debug_print during GC,
if (garbage_collection_messages)
message1_nolog ("Garbage collecting...");
- BLOCK_INPUT;
+ block_input ();
shrink_regexp_cache ();
dump_zombies ();
#endif
- UNBLOCK_INPUT;
+ unblock_input ();
check_cons_list ();
gc_relative_threshold = 0;
if (FLOATP (Vgc_cons_percentage))
{ /* Set gc_cons_combined_threshold. */
- double tot = 0;
-
- tot += total_conses * sizeof (struct Lisp_Cons);
- tot += total_symbols * sizeof (struct Lisp_Symbol);
- tot += total_markers * sizeof (union Lisp_Misc);
- 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);
+ double tot = total_bytes_of_live_objects ();
tot *= XFLOAT_DATA (Vgc_cons_percentage);
if (0 < tot)
gcs_done++;
+ /* Collect profiling data. */
+ if (profiler_memory_running)
+ {
+ size_t swept = 0;
+ size_t tot_after = total_bytes_of_live_objects ();
+ if (tot_before > tot_after)
+ swept = tot_before - tot_after;
+ malloc_probe (swept);
+ }
+
+ backtrace_list = backtrace.next;
return retval;
}
}
/* Remove killed buffers or items whose car is a killed buffer from
- LIST, and mark other items. Return changed LIST, which is marked. */
+ LIST, and mark other items. Return changed LIST, which is marked. */
static Lisp_Object
mark_discard_killed_buffers (Lisp_Object list)
prev = &XCDR_AS_LVALUE (tail);
}
}
+ mark_object (tail);
return list;
}
pvectype = ((ptr->header.size & PVEC_TYPE_MASK)
>> PSEUDOVECTOR_SIZE_BITS);
else
- pvectype = 0;
+ pvectype = PVEC_NORMAL_VECTOR;
if (pvectype != PVEC_SUBR && pvectype != PVEC_BUFFER)
CHECK_LIVE (live_vector_p);
struct window *w = (struct window *) ptr;
bool leaf = NILP (w->hchild) && NILP (w->vchild);
- /* For live windows, Lisp code filters out killed buffers
- from both buffer lists. For dead windows, we do it here
- in attempt to help GC to reclaim killed buffers faster. */
- if (leaf && NILP (w->buffer))
- {
- wset_prev_buffers
- (w, mark_discard_killed_buffers (w->prev_buffers));
- wset_next_buffers
- (w, mark_discard_killed_buffers (w->next_buffers));
- }
-
mark_vectorlike (ptr);
+
/* Mark glyphs for leaf windows. Marking window
matrices is sufficient because frame matrices
use the same glyph memory. */
mark_glyph_matrix (w->current_matrix);
mark_glyph_matrix (w->desired_matrix);
}
+
+ /* Filter out killed buffers from both buffer lists
+ in attempt to help GC to reclaim killed buffers faster.
+ We can do it elsewhere for live windows, but this is the
+ best place to do it for dead windows. */
+ wset_prev_buffers
+ (w, mark_discard_killed_buffers (w->prev_buffers));
+ wset_next_buffers
+ (w, mark_discard_killed_buffers (w->next_buffers));
}
break;
/* Free all unmarked buffers */
{
- register struct buffer *buffer = all_buffers, *prev = 0, *next;
+ register struct buffer *buffer, **bprev = &all_buffers;
total_buffers = 0;
- while (buffer)
+ for (buffer = all_buffers; buffer; buffer = *bprev)
if (!VECTOR_MARKED_P (buffer))
{
- if (prev)
- prev->header.next = buffer->header.next;
- else
- all_buffers = buffer->header.next.buffer;
- next = buffer->header.next.buffer;
+ *bprev = buffer->header.next.buffer;
lisp_free (buffer);
- buffer = next;
}
else
{
/* Do not use buffer_(set|get)_intervals here. */
buffer->text->intervals = balance_intervals (buffer->text->intervals);
total_buffers++;
- prev = buffer, buffer = buffer->header.next.buffer;
+ bprev = &buffer->header.next.buffer;
}
}
{
fprintf (stderr, "\r\n%s:%d: Emacs fatal error: %s\r\n",
file, line, msg);
- fatal_error_backtrace (SIGABRT, INT_MAX);
+ terminate_due_to_signal (SIGABRT, INT_MAX);
}
#endif
\f
DEFSYM (Qstring_bytes, "string-bytes");
DEFSYM (Qvector_slots, "vector-slots");
DEFSYM (Qheap, "heap");
+ DEFSYM (Qautomatic_gc, "Automatic GC");
DEFSYM (Qgc_cons_threshold, "gc-cons-threshold");
DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots");
/* When compiled with GCC, GDB might say "No enum type named
pvec_type" if we don't have at least one symbol with that type, and
then xbacktrace could fail. Similarly for the other enums and
- their values. */
+ their values. Some non-GCC compilers don't like these constructs. */
+#ifdef __GNUC__
union
{
enum CHARTAB_SIZE_BITS CHARTAB_SIZE_BITS;
enum lsb_bits lsb_bits;
#endif
} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0};
+#endif /* __GNUC__ */
HCoop / bpt / emacs.git / blobdiff