#include <stdio.h>
#include <limits.h> /* For CHAR_BIT. */
-#include <setjmp.h>
-#include <signal.h>
+#ifdef ENABLE_CHECKING
+#include <signal.h> /* For SIGABRT. */
+#endif
#ifdef HAVE_PTHREAD
#include <pthread.h>
#include "keyboard.h"
#include "frame.h"
#include "blockinput.h"
-#include "syssignal.h"
#include "termhooks.h" /* For struct terminal. */
-#include <setjmp.h>
+
#include <verify.h>
/* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects.
#include <fcntl.h>
+#ifdef USE_GTK
+# include "gtkutil.h"
+#endif
#ifdef WINDOWSNT
#include "w32.h"
+#include "w32heap.h" /* for sbrk */
#endif
#ifdef DOUG_LEA_MALLOC
#define MMAP_MAX_AREAS 100000000
-#else /* not DOUG_LEA_MALLOC */
-
-/* The following come from gmalloc.c. */
-
-extern size_t _bytes_used;
-extern size_t __malloc_extra_blocks;
-extern void *_malloc_internal (size_t);
-extern void _free_internal (void *);
-
#endif /* not DOUG_LEA_MALLOC */
-#if ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT
-#ifdef HAVE_PTHREAD
-
-/* When GTK uses the file chooser dialog, different backends can be loaded
- dynamically. One such a backend is the Gnome VFS backend that gets loaded
- if you run Gnome. That backend creates several threads and also allocates
- memory with malloc.
-
- Also, gconf and gsettings may create several threads.
-
- If Emacs sets malloc hooks (! SYSTEM_MALLOC) and the emacs_blocked_*
- functions below are called from malloc, there is a chance that one
- of these threads preempts the Emacs main thread and the hook variables
- end up in an inconsistent state. So we have a mutex to prevent that (note
- that the backend handles concurrent access to malloc within its own threads
- but Emacs code running in the main thread is not included in that control).
-
- When UNBLOCK_INPUT is called, reinvoke_input_signal may be called. If this
- happens in one of the backend threads we will have two threads that tries
- to run Emacs code at once, and the code is not prepared for that.
- To prevent that, we only call BLOCK/UNBLOCK from the main thread. */
-
-static pthread_mutex_t alloc_mutex;
-
-#define BLOCK_INPUT_ALLOC \
- do \
- { \
- if (pthread_equal (pthread_self (), main_thread)) \
- BLOCK_INPUT; \
- pthread_mutex_lock (&alloc_mutex); \
- } \
- while (0)
-#define UNBLOCK_INPUT_ALLOC \
- do \
- { \
- pthread_mutex_unlock (&alloc_mutex); \
- if (pthread_equal (pthread_self (), main_thread)) \
- UNBLOCK_INPUT; \
- } \
- while (0)
-
-#else /* ! defined HAVE_PTHREAD */
-
-#define BLOCK_INPUT_ALLOC BLOCK_INPUT
-#define UNBLOCK_INPUT_ALLOC UNBLOCK_INPUT
-
-#endif /* ! defined HAVE_PTHREAD */
-#endif /* ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT */
-
/* Mark, unmark, query mark bit of a Lisp string. S must be a pointer
to a struct Lisp_String. */
#define SPARE_MEMORY (1 << 14)
-/* Number of extra blocks malloc should get when it needs more core. */
-
-static int malloc_hysteresis;
-
/* Initialize it to a nonzero value to force it into data space
(rather than bss space). That way unexec will remap it into text
space (pure), on some systems. We have not implemented the
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 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 mark_buffer (struct buffer *);
#if !defined REL_ALLOC || defined SYSTEM_MALLOC
static void refill_memory_reserve (void);
static void mem_init (void);
static struct mem_node *mem_insert (void *, void *, enum mem_type);
static void mem_insert_fixup (struct mem_node *);
-#endif
static void mem_rotate_left (struct mem_node *);
static void mem_rotate_right (struct mem_node *);
static void mem_delete (struct mem_node *);
static void mem_delete_fixup (struct mem_node *);
-static inline struct mem_node *mem_find (void *);
+static struct mem_node *mem_find (void *);
+#endif
#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
/* 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. */
}
-/* The call depth in overrun_check functions. For example, this might happen:
- xmalloc()
- overrun_check_malloc()
- -> malloc -> (via hook)_-> emacs_blocked_malloc
- -> overrun_check_malloc
- call malloc (hooks are NULL, so real malloc is called).
- malloc returns 10000.
- add overhead, return 10016.
- <- (back in overrun_check_malloc)
- add overhead again, return 10032
- xmalloc returns 10032.
-
- (time passes).
-
- xfree(10032)
- overrun_check_free(10032)
- decrease overhead
- free(10016) <- crash, because 10000 is the original pointer. */
-
-static ptrdiff_t check_depth;
-
/* Like malloc, but wraps allocated block with header and trailer. */
static void *
overrun_check_malloc (size_t size)
{
register unsigned char *val;
- int overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_OVERHEAD : 0;
- if (SIZE_MAX - overhead < size)
- abort ();
+ if (SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD < size)
+ emacs_abort ();
- val = malloc (size + overhead);
- if (val && check_depth == 1)
+ val = malloc (size + XMALLOC_OVERRUN_CHECK_OVERHEAD);
+ if (val)
{
memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
memcpy (val + size, xmalloc_overrun_check_trailer,
XMALLOC_OVERRUN_CHECK_SIZE);
}
- --check_depth;
return val;
}
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;
- if (SIZE_MAX - overhead < size)
- abort ();
+ if (SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD < size)
+ emacs_abort ();
if (val
- && check_depth == 1
&& memcmp (xmalloc_overrun_check_header,
val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE,
XMALLOC_OVERRUN_CHECK_SIZE) == 0)
size_t osize = xmalloc_get_size (val);
if (memcmp (xmalloc_overrun_check_trailer, val + osize,
XMALLOC_OVERRUN_CHECK_SIZE))
- abort ();
+ emacs_abort ();
memset (val + osize, 0, XMALLOC_OVERRUN_CHECK_SIZE);
val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE);
}
- val = realloc (val, size + overhead);
+ val = realloc (val, size + XMALLOC_OVERRUN_CHECK_OVERHEAD);
- if (val && check_depth == 1)
+ if (val)
{
memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
memcpy (val + size, xmalloc_overrun_check_trailer,
XMALLOC_OVERRUN_CHECK_SIZE);
}
- --check_depth;
return val;
}
{
unsigned char *val = (unsigned char *) block;
- ++check_depth;
if (val
- && check_depth == 1
&& memcmp (xmalloc_overrun_check_header,
val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE,
XMALLOC_OVERRUN_CHECK_SIZE) == 0)
size_t osize = xmalloc_get_size (val);
if (memcmp (xmalloc_overrun_check_trailer, val + osize,
XMALLOC_OVERRUN_CHECK_SIZE))
- abort ();
+ emacs_abort ();
#ifdef XMALLOC_CLEAR_FREE_MEMORY
val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
memset (val, 0xff, osize + XMALLOC_OVERRUN_CHECK_OVERHEAD);
}
free (val);
- --check_depth;
}
#undef malloc
#define free overrun_check_free
#endif
-#ifdef SYNC_INPUT
-/* When using SYNC_INPUT, we don't call malloc from a signal handler, so
- there's no need to block input around malloc. */
-#define MALLOC_BLOCK_INPUT ((void)0)
-#define MALLOC_UNBLOCK_INPUT ((void)0)
+/* If compiled with XMALLOC_BLOCK_INPUT_CHECK, define a symbol
+ BLOCK_INPUT_IN_MEMORY_ALLOCATORS that is visible to the debugger.
+ If that variable is set, block input while in one of Emacs's memory
+ allocation functions. There should be no need for this debugging
+ option, since signal handlers do not allocate memory, but Emacs
+ formerly allocated memory in signal handlers and this compile-time
+ option remains as a way to help debug the issue should it rear its
+ ugly head again. */
+#ifdef XMALLOC_BLOCK_INPUT_CHECK
+bool block_input_in_memory_allocators EXTERNALLY_VISIBLE;
+static void
+malloc_block_input (void)
+{
+ if (block_input_in_memory_allocators)
+ block_input ();
+}
+static void
+malloc_unblock_input (void)
+{
+ if (block_input_in_memory_allocators)
+ unblock_input ();
+}
+# define MALLOC_BLOCK_INPUT malloc_block_input ()
+# define MALLOC_UNBLOCK_INPUT malloc_unblock_input ()
#else
-#define MALLOC_BLOCK_INPUT BLOCK_INPUT
-#define MALLOC_UNBLOCK_INPUT UNBLOCK_INPUT
+# define MALLOC_BLOCK_INPUT ((void) 0)
+# 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;
}
free (block);
MALLOC_UNBLOCK_INPUT;
/* We don't call refill_memory_reserve here
- because that duplicates doing so in emacs_blocked_free
- and the criterion should go there. */
+ because in practice the call in r_alloc_free seems to suffice. */
}
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;
}
}
\f
-#ifndef SYSTEM_MALLOC
-
-/* Arranging to disable input signals while we're in malloc.
-
- This only works with GNU malloc. To help out systems which can't
- use GNU malloc, all the calls to malloc, realloc, and free
- elsewhere in the code should be inside a BLOCK_INPUT/UNBLOCK_INPUT
- pair; unfortunately, we have no idea what C library functions
- might call malloc, so we can't really protect them unless you're
- using GNU malloc. Fortunately, most of the major operating systems
- can use GNU malloc. */
-
-#ifndef SYNC_INPUT
-/* When using SYNC_INPUT, we don't call malloc from a signal handler, so
- there's no need to block input around malloc. */
-
-#ifndef DOUG_LEA_MALLOC
-extern void * (*__malloc_hook) (size_t, const void *);
-extern void * (*__realloc_hook) (void *, size_t, const void *);
-extern void (*__free_hook) (void *, const void *);
-/* Else declared in malloc.h, perhaps with an extra arg. */
-#endif /* DOUG_LEA_MALLOC */
-static void * (*old_malloc_hook) (size_t, const void *);
-static void * (*old_realloc_hook) (void *, size_t, const void*);
-static void (*old_free_hook) (void*, const void*);
-
-#ifdef DOUG_LEA_MALLOC
-# define BYTES_USED (mallinfo ().uordblks)
-#else
-# define BYTES_USED _bytes_used
-#endif
-
-#ifdef GC_MALLOC_CHECK
-static bool dont_register_blocks;
-#endif
-
-static size_t bytes_used_when_reconsidered;
-
-/* Value of _bytes_used, when spare_memory was freed. */
-
-static size_t bytes_used_when_full;
-
-/* This function is used as the hook for free to call. */
-
-static void
-emacs_blocked_free (void *ptr, const void *ptr2)
-{
- BLOCK_INPUT_ALLOC;
-
-#ifdef GC_MALLOC_CHECK
- if (ptr)
- {
- struct mem_node *m;
-
- m = mem_find (ptr);
- if (m == MEM_NIL || m->start != ptr)
- {
- fprintf (stderr,
- "Freeing `%p' which wasn't allocated with malloc\n", ptr);
- abort ();
- }
- else
- {
- /* fprintf (stderr, "free %p...%p (%p)\n", m->start, m->end, ptr); */
- mem_delete (m);
- }
- }
-#endif /* GC_MALLOC_CHECK */
-
- __free_hook = old_free_hook;
- free (ptr);
-
- /* If we released our reserve (due to running out of memory),
- and we have a fair amount free once again,
- try to set aside another reserve in case we run out once more. */
- if (! NILP (Vmemory_full)
- /* Verify there is enough space that even with the malloc
- hysteresis this call won't run out again.
- The code here is correct as long as SPARE_MEMORY
- is substantially larger than the block size malloc uses. */
- && (bytes_used_when_full
- > ((bytes_used_when_reconsidered = BYTES_USED)
- + max (malloc_hysteresis, 4) * SPARE_MEMORY)))
- refill_memory_reserve ();
-
- __free_hook = emacs_blocked_free;
- UNBLOCK_INPUT_ALLOC;
-}
-
-
-/* This function is the malloc hook that Emacs uses. */
-
-static void *
-emacs_blocked_malloc (size_t size, const void *ptr)
-{
- void *value;
-
- BLOCK_INPUT_ALLOC;
- __malloc_hook = old_malloc_hook;
-#ifdef DOUG_LEA_MALLOC
- /* Segfaults on my system. --lorentey */
- /* mallopt (M_TOP_PAD, malloc_hysteresis * 4096); */
-#else
- __malloc_extra_blocks = malloc_hysteresis;
-#endif
-
- value = malloc (size);
-
-#ifdef GC_MALLOC_CHECK
- {
- struct mem_node *m = mem_find (value);
- if (m != MEM_NIL)
- {
- fprintf (stderr, "Malloc returned %p which is already in use\n",
- value);
- fprintf (stderr, "Region in use is %p...%p, %td bytes, type %d\n",
- m->start, m->end, (char *) m->end - (char *) m->start,
- m->type);
- abort ();
- }
-
- if (!dont_register_blocks)
- {
- mem_insert (value, (char *) value + max (1, size), allocated_mem_type);
- allocated_mem_type = MEM_TYPE_NON_LISP;
- }
- }
-#endif /* GC_MALLOC_CHECK */
-
- __malloc_hook = emacs_blocked_malloc;
- UNBLOCK_INPUT_ALLOC;
-
- /* fprintf (stderr, "%p malloc\n", value); */
- return value;
-}
-
-
-/* This function is the realloc hook that Emacs uses. */
-
-static void *
-emacs_blocked_realloc (void *ptr, size_t size, const void *ptr2)
-{
- void *value;
-
- BLOCK_INPUT_ALLOC;
- __realloc_hook = old_realloc_hook;
-
-#ifdef GC_MALLOC_CHECK
- if (ptr)
- {
- struct mem_node *m = mem_find (ptr);
- if (m == MEM_NIL || m->start != ptr)
- {
- fprintf (stderr,
- "Realloc of %p which wasn't allocated with malloc\n",
- ptr);
- abort ();
- }
-
- mem_delete (m);
- }
-
- /* fprintf (stderr, "%p -> realloc\n", ptr); */
-
- /* Prevent malloc from registering blocks. */
- dont_register_blocks = 1;
-#endif /* GC_MALLOC_CHECK */
-
- value = realloc (ptr, size);
-
-#ifdef GC_MALLOC_CHECK
- dont_register_blocks = 0;
-
- {
- struct mem_node *m = mem_find (value);
- if (m != MEM_NIL)
- {
- fprintf (stderr, "Realloc returns memory that is already in use\n");
- abort ();
- }
-
- /* Can't handle zero size regions in the red-black tree. */
- mem_insert (value, (char *) value + max (size, 1), MEM_TYPE_NON_LISP);
- }
-
- /* fprintf (stderr, "%p <- realloc\n", value); */
-#endif /* GC_MALLOC_CHECK */
-
- __realloc_hook = emacs_blocked_realloc;
- UNBLOCK_INPUT_ALLOC;
-
- return value;
-}
-
-
-#ifdef HAVE_PTHREAD
-/* Called from Fdump_emacs so that when the dumped Emacs starts, it has a
- normal malloc. Some thread implementations need this as they call
- malloc before main. The pthread_self call in BLOCK_INPUT_ALLOC then
- calls malloc because it is the first call, and we have an endless loop. */
-
-void
-reset_malloc_hooks (void)
-{
- __free_hook = old_free_hook;
- __malloc_hook = old_malloc_hook;
- __realloc_hook = old_realloc_hook;
-}
-#endif /* HAVE_PTHREAD */
-
-
-/* Called from main to set up malloc to use our hooks. */
-
-void
-uninterrupt_malloc (void)
-{
-#ifdef HAVE_PTHREAD
-#ifdef DOUG_LEA_MALLOC
- pthread_mutexattr_t attr;
-
- /* GLIBC has a faster way to do this, but let's keep it portable.
- This is according to the Single UNIX Specification. */
- pthread_mutexattr_init (&attr);
- pthread_mutexattr_settype (&attr, PTHREAD_MUTEX_RECURSIVE);
- pthread_mutex_init (&alloc_mutex, &attr);
-#else /* !DOUG_LEA_MALLOC */
- /* Some systems such as Solaris 2.6 don't have a recursive mutex,
- and the bundled gmalloc.c doesn't require it. */
- pthread_mutex_init (&alloc_mutex, NULL);
-#endif /* !DOUG_LEA_MALLOC */
-#endif /* HAVE_PTHREAD */
-
- if (__free_hook != emacs_blocked_free)
- old_free_hook = __free_hook;
- __free_hook = emacs_blocked_free;
-
- if (__malloc_hook != emacs_blocked_malloc)
- old_malloc_hook = __malloc_hook;
- __malloc_hook = emacs_blocked_malloc;
-
- if (__realloc_hook != emacs_blocked_realloc)
- old_realloc_hook = __realloc_hook;
- __realloc_hook = emacs_blocked_realloc;
-}
-
-#endif /* not SYNC_INPUT */
-#endif /* not SYSTEM_MALLOC */
-
-
-\f
/***********************************************************************
Interval Allocation
***********************************************************************/
{
INTERVAL val;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (interval_free_list)
if (!PURE_POINTER_P (s)
&& s->data
&& nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
- abort ();
+ emacs_abort ();
return nbytes;
}
while (s != NULL)
{
if ((uintptr_t) s < 1024)
- abort ();
+ emacs_abort ();
s = NEXT_FREE_LISP_STRING (s);
}
}
{
struct Lisp_String *s;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
/* If the free-list is empty, allocate a new string_block, and
back-pointer so that we know it's free. */
#ifdef GC_CHECK_STRING_BYTES
if (string_bytes (s) != SDATA_NBYTES (data))
- abort ();
+ emacs_abort ();
#else
data->u.nbytes = STRING_BYTES (s);
#endif
/* Check that the string size recorded in the string is the
same as the one recorded in the sdata structure. */
if (s && string_bytes (s) != SDATA_NBYTES (from))
- abort ();
+ emacs_abort ();
#endif /* GC_CHECK_STRING_BYTES */
nbytes = s ? STRING_BYTES (s) : SDATA_NBYTES (from);
if (memcmp (string_overrun_cookie,
(char *) from_end - GC_STRING_OVERRUN_COOKIE_SIZE,
GC_STRING_OVERRUN_COOKIE_SIZE))
- abort ();
+ emacs_abort ();
#endif
/* Non-NULL S means it's alive. Copy its data. */
struct Lisp_String *s;
if (nchars < 0)
- abort ();
+ emacs_abort ();
if (!nbytes)
return empty_multibyte_string;
{
register Lisp_Object val;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (float_free_list)
{
register Lisp_Object val;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (cons_free_list)
else if (type == CONSTYPE_HEAP)
val = Fcons (objp[i], val);
else
- abort ();
+ emacs_abort ();
}
return val;
}
MALLOC_BLOCK_INPUT;
- /* This gets triggered by code which I haven't bothered to fix. --Stef */
- /* eassert (!handling_signal); */
-
if (len == 0)
p = XVECTOR (zero_vector);
else
XSETPVECTYPESIZE (b, PVEC_BUFFER, (offsetof (struct buffer, own_text)
- header_size) / word_size);
- /* Note that the fields of B are not initialized. */
+ /* Put B on the chain of all buffers including killed ones. */
+ b->header.next.buffer = all_buffers;
+ all_buffers = b;
+ /* Note that the rest fields of B are not initialized. */
return b;
}
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
CHECK_STRING (name);
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (symbol_free_list)
{
Lisp_Object val;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (marker_free_list)
struct Lisp_Marker *m;
/* No dead buffers here. */
- eassert (!NILP (BVAR (buf, name)));
+ eassert (BUFFER_LIVE_P (buf));
/* Every character is at least one byte. */
eassert (charpos <= bytepos);
lisp_free (spare_memory[i]);
spare_memory[i] = 0;
}
-
- /* Record the space now used. When it decreases substantially,
- we can refill the memory reserve. */
-#if !defined SYSTEM_MALLOC && !defined SYNC_INPUT
- bytes_used_when_full = BYTES_USED;
-#endif
}
/* This used to call error, but if we've run out of memory, we could
/* 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;
while (c != MEM_NIL)
{
if (start >= c->start && start < c->end)
- abort ();
+ emacs_abort ();
parent = c;
c = start < c->start ? c->left : c->right;
}
/* Create a new node. */
#ifdef GC_MALLOC_CHECK
- x = _malloc_internal (sizeof *x);
+ x = malloc (sizeof *x);
if (x == NULL)
- abort ();
+ emacs_abort ();
#else
x = xmalloc (sizeof *x);
#endif
mem_delete_fixup (x);
#ifdef GC_MALLOC_CHECK
- _free_internal (y);
+ free (y);
#else
xfree (y);
#endif
/* 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;
break;
default:
- abort ();
+ emacs_abort ();
}
if (!NILP (obj))
{
char buf[10];
register int x;
- jmp_buf jbuf;
+ sys_jmp_buf jbuf;
/* Arrange for X to be put in a register. */
sprintf (buf, "1");
x = strlen (buf);
x = 2 * x - 1;
- setjmp (jbuf);
+ sys_setjmp (jbuf);
if (longjmps_done == 1)
{
/* Came here after the longjmp at the end of the function.
++longjmps_done;
x = 2;
if (longjmps_done == 1)
- longjmp (jbuf, 1);
+ sys_longjmp (jbuf, 1);
}
#endif /* not GC_SAVE_REGISTERS_ON_STACK && not GC_SETJMP_WORKS */
if (!survives_gc_p (p->var[i]))
/* FIXME: It's not necessarily a bug. It might just be that the
GCPRO is unnecessary or should release the object sooner. */
- abort ();
+ emacs_abort ();
}
#elif GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
/* jmp_buf may not be aligned enough on darwin-ppc64 */
union aligned_jmpbuf {
Lisp_Object o;
- jmp_buf j;
+ sys_jmp_buf j;
} j;
volatile bool stack_grows_down_p = (char *) &j > (char *) stack_base;
#endif
}
#endif /* GC_SETJMP_WORKS */
- setjmp (j.j);
+ sys_setjmp (j.j);
end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j;
#endif /* not GC_SAVE_REGISTERS_ON_STACK */
#endif /* not HAVE___BUILTIN_UNWIND_INIT */
#endif
}
-/* Return 1 if OBJ is a valid lisp object.
+/* Return 2 if OBJ is a killed or special buffer object.
+ Return 1 if OBJ is a valid lisp object.
Return 0 if OBJ is NOT a valid lisp object.
Return -1 if we cannot validate OBJ.
This function can be quite slow,
if (PURE_POINTER_P (p))
return 1;
+ if (p == &buffer_defaults || p == &buffer_local_symbols)
+ return 2;
+
#if !GC_MARK_STACK
return valid_pointer_p (p);
#else
return 0;
case MEM_TYPE_BUFFER:
- return live_buffer_p (m, p);
+ return live_buffer_p (m, p) ? 1 : 2;
case MEM_TYPE_CONS:
return live_cons_p (m, p);
{
staticvec[staticidx++] = varaddress;
if (staticidx >= NSTATICS)
- 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)
- abort ();
+ emacs_abort ();
/* Can't GC if pure storage overflowed because we can't determine
if something is a pure object or not. */
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 ();
/* Mark all the special slots that serve as the roots of accessibility. */
+ mark_buffer (&buffer_defaults);
+ mark_buffer (&buffer_local_symbols);
+
for (i = 0; i < staticidx; i++)
mark_object (*staticvec[i]);
}
mark_terminals ();
mark_kboards ();
- mark_ttys ();
#ifdef USE_GTK
- {
- extern void xg_mark_data (void);
- xg_mark_data ();
- }
+ xg_mark_data ();
#endif
#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
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;
}
mark_buffer (buffer->base_buffer);
}
+/* Remove killed buffers or items whose car is a killed buffer from
+ LIST, and mark other items. Return changed LIST, which is marked. */
+
+static Lisp_Object
+mark_discard_killed_buffers (Lisp_Object list)
+{
+ Lisp_Object tail, *prev = &list;
+
+ for (tail = list; CONSP (tail) && !CONS_MARKED_P (XCONS (tail));
+ tail = XCDR (tail))
+ {
+ Lisp_Object tem = XCAR (tail);
+ if (CONSP (tem))
+ tem = XCAR (tem);
+ if (BUFFERP (tem) && !BUFFER_LIVE_P (XBUFFER (tem)))
+ *prev = XCDR (tail);
+ else
+ {
+ CONS_MARK (XCONS (tail));
+ mark_object (XCAR (tail));
+ prev = &XCDR_AS_LVALUE (tail);
+ }
+ }
+ mark_object (tail);
+ return list;
+}
+
/* Determine type of generic Lisp_Object and mark it accordingly. */
void
do { \
m = mem_find (po); \
if (m == MEM_NIL) \
- abort (); \
+ emacs_abort (); \
} while (0)
/* Check that the object pointed to by PO is live, using predicate
#define CHECK_LIVE(LIVEP) \
do { \
if (!LIVEP (m, po)) \
- abort (); \
+ emacs_abort (); \
} while (0)
/* Check both of the above conditions. */
#ifdef GC_CHECK_MARKED_OBJECTS
m = mem_find (po);
- if (m == MEM_NIL && !SUBRP (obj)
- && po != &buffer_defaults
- && po != &buffer_local_symbols)
- abort ();
+ if (m == MEM_NIL && !SUBRP (obj))
+ emacs_abort ();
#endif /* GC_CHECK_MARKED_OBJECTS */
if (ptr->header.size & PSEUDOVECTOR_FLAG)
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);
{
case PVEC_BUFFER:
#ifdef GC_CHECK_MARKED_OBJECTS
- if (po != &buffer_defaults && po != &buffer_local_symbols)
- {
- struct buffer *b;
- FOR_EACH_BUFFER (b)
- if (b == po)
- break;
- if (b == NULL)
- abort ();
- }
+ {
+ struct buffer *b;
+ FOR_EACH_BUFFER (b)
+ if (b == po)
+ break;
+ if (b == NULL)
+ emacs_abort ();
+ }
#endif /* GC_CHECK_MARKED_OBJECTS */
mark_buffer ((struct buffer *) ptr);
break;
break;
case PVEC_FRAME:
- {
- mark_vectorlike (ptr);
- mark_face_cache (((struct frame *) ptr)->face_cache);
- }
+ mark_vectorlike (ptr);
+ mark_face_cache (((struct frame *) ptr)->face_cache);
break;
case PVEC_WINDOW:
{
struct window *w = (struct window *) ptr;
+ bool leaf = NILP (w->hchild) && NILP (w->vchild);
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)
+ if (leaf && w->current_matrix)
{
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;
break;
case PVEC_FREE:
- abort ();
+ emacs_abort ();
default:
mark_vectorlike (ptr);
case SYMBOL_LOCALIZED:
{
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (ptr);
- /* If the value is forwarded to a buffer or keyboard field,
- these are marked when we see the corresponding object.
- And if it's forwarded to a C variable, either it's not
- a Lisp_Object var, or it's staticpro'd already. */
+ Lisp_Object where = blv->where;
+ /* If the value is set up for a killed buffer or deleted
+ frame, restore it's global binding. If the value is
+ forwarded to a C variable, either it's not a Lisp_Object
+ var, or it's staticpro'd already. */
+ if ((BUFFERP (where) && !BUFFER_LIVE_P (XBUFFER (where)))
+ || (FRAMEP (where) && !FRAME_LIVE_P (XFRAME (where))))
+ swap_in_global_binding (ptr);
mark_object (blv->where);
mark_object (blv->valcell);
mark_object (blv->defcell);
And if it's forwarded to a C variable, either it's not
a Lisp_Object var, or it's staticpro'd already. */
break;
- default: abort ();
+ default: emacs_abort ();
}
if (!PURE_POINTER_P (XSTRING (ptr->name)))
MARK_STRING (XSTRING (ptr->name));
break;
default:
- abort ();
+ emacs_abort ();
}
break;
obj = ptr->u.cdr;
cdr_count++;
if (cdr_count == mark_object_loop_halt)
- abort ();
+ emacs_abort ();
goto loop;
}
break;
default:
- abort ();
+ emacs_abort ();
}
#undef CHECK_LIVE
break;
default:
- abort ();
+ emacs_abort ();
}
return survives_p || PURE_POINTER_P ((void *) XPNTR (obj));
/* 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;
}
}
#ifdef ENABLE_CHECKING
-# include <execinfo.h>
-
bool suppress_checking;
void
die (const char *msg, const char *file, int line)
{
- enum { NPOINTERS_MAX = 500 };
- void *buffer[NPOINTERS_MAX];
- int npointers;
fprintf (stderr, "\r\n%s:%d: Emacs fatal error: %s\r\n",
file, line, msg);
- npointers = backtrace (buffer, NPOINTERS_MAX);
- backtrace_symbols_fd (buffer, npointers, STDERR_FILENO);
- abort ();
+ terminate_due_to_signal (SIGABRT, INT_MAX);
}
#endif
\f
init_strings ();
init_vectors ();
-#ifdef REL_ALLOC
- malloc_hysteresis = 32;
-#else
- malloc_hysteresis = 0;
-#endif
-
refill_memory_reserve ();
gc_cons_threshold = GC_DEFAULT_THRESHOLD;
}
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