#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"
#endif
#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. */
EMACS_INT memory_full_cons_threshold;
-/* Nonzero during GC. */
+/* True during GC. */
-int gc_in_progress;
+bool gc_in_progress;
-/* Nonzero means abort if try to GC.
+/* True means abort if try to GC.
This is for code which is written on the assumption that
no GC will happen, so as to verify that assumption. */
-int abort_on_gc;
+bool abort_on_gc;
/* Number of live and free conses etc. */
#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 ptrdiff_t pure_bytes_used_before_overflow;
-/* Value is non-zero if P points into pure space. */
+/* True if P points into pure space. */
#define PURE_POINTER_P(P) \
((uintptr_t) (P) - (uintptr_t) purebeg <= pure_size)
-/* Index in pure at which next pure Lisp object will be allocated.. */
+/* Index in pure at which next pure Lisp object will be allocated.. */
static ptrdiff_t pure_bytes_used_lisp;
static ptrdiff_t stack_copy_size;
#endif
+static Lisp_Object Qconses;
+static Lisp_Object Qsymbols;
+static Lisp_Object Qmiscs;
+static Lisp_Object Qstrings;
+static Lisp_Object Qvectors;
+static Lisp_Object Qfloats;
+static Lisp_Object Qintervals;
+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);
and runtime slowdown. Minor but pointless. */
MEM_TYPE_VECTORLIKE,
/* Special type to denote vector blocks. */
- MEM_TYPE_VECTOR_BLOCK
+ MEM_TYPE_VECTOR_BLOCK,
+ /* Special type to denote reserved memory. */
+ MEM_TYPE_SPARE
};
static void *lisp_malloc (size_t, enum mem_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 *);
-static int live_string_p (struct mem_node *, void *);
-static int live_cons_p (struct mem_node *, void *);
-static int live_symbol_p (struct mem_node *, void *);
-static int live_float_p (struct mem_node *, void *);
-static int live_misc_p (struct mem_node *, void *);
+static bool live_vector_p (struct mem_node *, void *);
+static bool live_buffer_p (struct mem_node *, void *);
+static bool live_string_p (struct mem_node *, void *);
+static bool live_cons_p (struct mem_node *, void *);
+static bool live_symbol_p (struct mem_node *, void *);
+static bool live_float_p (struct mem_node *, void *);
+static bool live_misc_p (struct mem_node *, void *);
static void mark_maybe_object (Lisp_Object);
static void mark_memory (void *, void *);
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
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 *);
+#endif
#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
}
-/* 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 int 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)
mark_object (i->plist);
}
-
-/* Mark the interval tree rooted in TREE. Don't call this directly;
- use the macro MARK_INTERVAL_TREE instead. */
-
-static void
-mark_interval_tree (register INTERVAL tree)
-{
- /* No need to test if this tree has been marked already; this
- function is always called through the MARK_INTERVAL_TREE macro,
- which takes care of that. */
-
- traverse_intervals_noorder (tree, mark_interval, Qnil);
-}
-
-
/* Mark the interval tree rooted in I. */
-#define MARK_INTERVAL_TREE(i) \
- do { \
- if (!NULL_INTERVAL_P (i) && !i->gcmarkbit) \
- mark_interval_tree (i); \
+#define MARK_INTERVAL_TREE(i) \
+ do { \
+ if (i && !i->gcmarkbit) \
+ traverse_intervals_noorder (i, mark_interval, Qnil); \
} while (0)
-
-#define UNMARK_BALANCE_INTERVALS(i) \
- do { \
- if (! NULL_INTERVAL_P (i)) \
- (i) = balance_intervals (i); \
- } while (0)
-\f
/***********************************************************************
String Allocation
***********************************************************************/
if (!PURE_POINTER_P (s)
&& s->data
&& nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
- abort ();
+ emacs_abort ();
return nbytes;
}
/* Check validity of Lisp strings' string_bytes member. ALL_P
- non-zero means check all strings, otherwise check only most
+ means check all strings, otherwise check only most
recently allocated strings. Used for hunting a bug. */
static void
-check_string_bytes (int all_p)
+check_string_bytes (bool all_p)
{
if (all_p)
{
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
/* String is live; unmark it and its intervals. */
UNMARK_STRING (s);
- if (!NULL_INTERVAL_P (s->intervals))
- UNMARK_BALANCE_INTERVALS (s->intervals);
+ /* Do not use string_(set|get)_intervals here. */
+ s->intervals = balance_intervals (s->intervals);
++total_strings;
total_string_bytes += STRING_BYTES (s);
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. */
Lisp_Object
make_specified_string (const char *contents,
- ptrdiff_t nchars, ptrdiff_t nbytes, int multibyte)
+ ptrdiff_t nchars, ptrdiff_t nbytes, bool multibyte)
{
- register Lisp_Object val;
+ Lisp_Object val;
if (nchars < 0)
{
struct Lisp_String *s;
if (nchars < 0)
- abort ();
+ emacs_abort ();
if (!nbytes)
return empty_multibyte_string;
s = allocate_string ();
- s->intervals = NULL_INTERVAL;
+ s->intervals = NULL;
allocate_string_data (s, nchars, nbytes);
XSETSTRING (string, s);
string_chars_consed += nbytes;
{
register Lisp_Object val;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (float_free_list)
{
ptr->u.chain = cons_free_list;
#if GC_MARK_STACK
- CVAR (ptr, car) = Vdead;
+ ptr->car = Vdead;
#endif
cons_free_list = ptr;
consing_since_gc -= sizeof *ptr;
{
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;
}
for (block = vector_blocks; block; block = *bprev)
{
- int free_this_block = 0;
+ bool free_this_block = 0;
for (vector = (struct Lisp_Vector *) block->data;
VECTOR_IN_BLOCK (vector, block); vector = next)
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;
}
CHECK_STRING (name);
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (symbol_free_list)
MALLOC_UNBLOCK_INPUT;
p = XSYMBOL (val);
- SVAR (p, xname) = name;
- SVAR (p, plist) = Qnil;
+ set_symbol_name (val, name);
+ set_symbol_plist (val, Qnil);
p->redirect = SYMBOL_PLAINVAL;
SET_SYMBOL_VAL (p, Qunbound);
- SVAR (p, function) = Qunbound;
- p->next = NULL;
+ set_symbol_function (val, Qunbound);
+ set_symbol_next (val, NULL);
p->gcmarkbit = 0;
p->interned = SYMBOL_UNINTERNED;
p->constant = 0;
{
Lisp_Object val;
- /* eassert (!handling_signal); */
-
MALLOC_BLOCK_INPUT;
if (marker_free_list)
overlay = allocate_misc (Lisp_Misc_Overlay);
OVERLAY_START (overlay) = start;
OVERLAY_END (overlay) = end;
- OVERLAY_PLIST (overlay) = plist;
+ set_overlay_plist (overlay, plist);
XOVERLAY (overlay)->next = NULL;
return overlay;
}
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);
memory_full (size_t nbytes)
{
/* Do not go into hysterics merely because a large request failed. */
- int enough_free_memory = 0;
+ bool enough_free_memory = 0;
if (SPARE_MEMORY < nbytes)
{
void *p;
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
spare_memory[0] = malloc (SPARE_MEMORY);
if (spare_memory[1] == 0)
spare_memory[1] = lisp_align_malloc (sizeof (struct cons_block),
- MEM_TYPE_CONS);
+ MEM_TYPE_SPARE);
if (spare_memory[2] == 0)
spare_memory[2] = lisp_align_malloc (sizeof (struct cons_block),
- MEM_TYPE_CONS);
+ MEM_TYPE_SPARE);
if (spare_memory[3] == 0)
spare_memory[3] = lisp_align_malloc (sizeof (struct cons_block),
- MEM_TYPE_CONS);
+ MEM_TYPE_SPARE);
if (spare_memory[4] == 0)
spare_memory[4] = lisp_align_malloc (sizeof (struct cons_block),
- MEM_TYPE_CONS);
+ MEM_TYPE_SPARE);
if (spare_memory[5] == 0)
spare_memory[5] = lisp_malloc (sizeof (struct string_block),
- MEM_TYPE_STRING);
+ MEM_TYPE_SPARE);
if (spare_memory[6] == 0)
spare_memory[6] = lisp_malloc (sizeof (struct string_block),
- MEM_TYPE_STRING);
+ MEM_TYPE_SPARE);
if (spare_memory[0] && spare_memory[1] && spare_memory[5])
Vmemory_full = Qnil;
#endif
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 int
+static inline 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 int
+static inline bool
live_cons_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_CONS)
&& offset < (CONS_BLOCK_SIZE * sizeof b->conses[0])
&& (b != cons_block
|| offset / sizeof b->conses[0] < cons_block_index)
- && !EQ (CVAR ((struct Lisp_Cons *) p, car), Vdead));
+ && !EQ (((struct Lisp_Cons *) p)->car, Vdead));
}
else
return 0;
/* 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 int
+static inline bool
live_symbol_p (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_SYMBOL)
&& offset < (SYMBOL_BLOCK_SIZE * sizeof b->symbols[0])
&& (b != symbol_block
|| offset / sizeof b->symbols[0] < symbol_block_index)
- && !EQ (SVAR (((struct Lisp_Symbol *)p), function), Vdead));
+ && !EQ (((struct Lisp_Symbol *)p)->function, Vdead));
}
else
return 0;
/* 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 int
+static inline 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 int
+static inline 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 int
+static inline 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 int
+static inline bool
live_buffer_p (struct mem_node *m, void *p)
{
/* P must point to the start of the block, and the buffer
if (m != MEM_NIL)
{
- int mark_p = 0;
+ bool mark_p = 0;
switch (XTYPE (obj))
{
switch (m->type)
{
case MEM_TYPE_NON_LISP:
+ case MEM_TYPE_SPARE:
/* Nothing to do; not a pointer to Lisp memory. */
break;
break;
default:
- abort ();
+ emacs_abort ();
}
if (!NILP (obj))
#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
-static int setjmp_tested_p, longjmps_done;
+static bool setjmp_tested_p;
+static int longjmps_done;
#define SETJMP_WILL_LIKELY_WORK "\
\n\
{
char buf[10];
register int x;
- jmp_buf jbuf;
- int result = 0;
+ 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 int stack_grows_down_p = (char *) &j > (char *) stack_base;
+ volatile bool stack_grows_down_p = (char *) &j > (char *) stack_base;
#endif
/* This trick flushes the register windows so that all the state of
the process is contained in the stack. */
}
#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 */
if (pipe (fd) == 0)
{
- int valid = (emacs_write (fd[1], (char *) p, 16) == 16);
+ bool valid = emacs_write (fd[1], (char *) p, 16) == 16;
emacs_close (fd[1]);
emacs_close (fd[0]);
return valid;
#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
switch (m->type)
{
case MEM_TYPE_NON_LISP:
+ case MEM_TYPE_SPARE:
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);
/* Return a string allocated in pure space. DATA is a buffer holding
NCHARS characters, and NBYTES bytes of string data. MULTIBYTE
- non-zero means make the result string multibyte.
+ means make the result string multibyte.
Must get an error if pure storage is full, since if it cannot hold
a large string it may be able to hold conses that point to that
Lisp_Object
make_pure_string (const char *data,
- ptrdiff_t nchars, ptrdiff_t nbytes, int multibyte)
+ ptrdiff_t nchars, ptrdiff_t nbytes, bool multibyte)
{
Lisp_Object string;
struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String);
}
s->size = nchars;
s->size_byte = multibyte ? nbytes : -1;
- s->intervals = NULL_INTERVAL;
+ s->intervals = NULL;
XSETSTRING (string, s);
return string;
}
s->size = nchars;
s->size_byte = -1;
s->data = (unsigned char *) data;
- s->intervals = NULL_INTERVAL;
+ s->intervals = NULL;
XSETSTRING (string, s);
return string;
}
{
staticvec[staticidx++] = varaddress;
if (staticidx >= NSTATICS)
- abort ();
+ emacs_abort ();
}
\f
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
See Info node `(elisp)Garbage Collection'. */)
(void)
{
- register struct specbinding *bind;
- register struct buffer *nextb;
+ struct specbinding *bind;
+ struct buffer *nextb;
char stack_top_variable;
ptrdiff_t i;
- int message_p;
- Lisp_Object total[11];
+ bool message_p;
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)
}
unbind_to (count, Qnil);
+ {
+ Lisp_Object total[11];
+ int total_size = 10;
- total[0] = list4 (Qcons, make_number (sizeof (struct Lisp_Cons)),
- bounded_number (total_conses),
- bounded_number (total_free_conses));
+ total[0] = list4 (Qconses, 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[1] = list4 (Qsymbols, 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[2] = list4 (Qmiscs, 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[3] = list4 (Qstrings, 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[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[5] = list3 (Qvectors, 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[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[7] = list4 (Qfloats, 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[8] = list4 (Qintervals, 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[9] = list3 (Qbuffers, 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
+ total_size++;
+ total[10] = list4 (Qheap, make_number (1024),
+ bounded_number ((mallinfo ().uordblks + 1023) >> 10),
+ bounded_number ((mallinfo ().fordblks + 1023) >> 10));
#endif
- );
+ retval = Flist (total_size, total);
+ }
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
{
/* Compute average percentage of zombies. */
- double nlive =
- (total_conses + total_symbols + total_markers + total_strings
- + total_vectors + total_floats + total_intervals + total_buffers);
+ 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);
gcs_done++;
- return Flist (sizeof total / sizeof *total, total);
+ /* 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;
}
for (; ptr && !ptr->gcmarkbit; ptr = ptr->next)
{
ptr->gcmarkbit = 1;
- mark_object (MVAR (ptr, start));
- mark_object (MVAR (ptr, end));
- mark_object (MVAR (ptr, plist));
+ mark_object (ptr->start);
+ mark_object (ptr->end);
+ mark_object (ptr->plist);
}
}
/* ...but there are some buffer-specific things. */
- MARK_INTERVAL_TREE (BUF_INTERVALS (buffer));
+ MARK_INTERVAL_TREE (buffer_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
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)
{
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);
break;
CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
ptr->gcmarkbit = 1;
- mark_object (SVAR (ptr, function));
- mark_object (SVAR (ptr, plist));
+ mark_object (ptr->function);
+ mark_object (ptr->plist);
switch (ptr->redirect)
{
case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break;
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 (SVAR (ptr, xname))))
- MARK_STRING (XSTRING (SVAR (ptr, xname)));
- MARK_INTERVAL_TREE (STRING_INTERVALS (SVAR (ptr, xname)));
+ if (!PURE_POINTER_P (XSTRING (ptr->name)))
+ MARK_STRING (XSTRING (ptr->name));
+ MARK_INTERVAL_TREE (string_intervals (ptr->name));
ptr = ptr->next;
if (ptr)
break;
default:
- abort ();
+ emacs_abort ();
}
break;
CHECK_ALLOCATED_AND_LIVE (live_cons_p);
CONS_MARK (ptr);
/* If the cdr is nil, avoid recursion for the car. */
- if (EQ (CVAR (ptr, u.cdr), Qnil))
+ if (EQ (ptr->u.cdr, Qnil))
{
- obj = CVAR (ptr, car);
+ obj = ptr->car;
cdr_count = 0;
goto loop;
}
- mark_object (CVAR (ptr, car));
- obj = CVAR (ptr, u.cdr);
+ mark_object (ptr->car);
+ 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
/* Value is non-zero if OBJ will survive the current GC because it's
either marked or does not need to be marked to survive. */
-int
+bool
survives_gc_p (Lisp_Object obj)
{
- int survives_p;
+ bool survives_p;
switch (XTYPE (obj))
{
break;
default:
- abort ();
+ emacs_abort ();
}
return survives_p || PURE_POINTER_P ((void *) XPNTR (obj));
cblk->conses[pos].u.chain = cons_free_list;
cons_free_list = &cblk->conses[pos];
#if GC_MARK_STACK
- CVAR (cons_free_list, car) = Vdead;
+ cons_free_list->car = Vdead;
#endif
}
else
{
if (!iblk->intervals[i].gcmarkbit)
{
- SET_INTERVAL_PARENT (&iblk->intervals[i], interval_free_list);
+ set_interval_parent (&iblk->intervals[i], interval_free_list);
interval_free_list = &iblk->intervals[i];
this_free++;
}
/* Check if the symbol was created during loadup. In such a case
it might be pointed to by pure bytecode which we don't trace,
so we conservatively assume that it is live. */
- int pure_p = PURE_POINTER_P (XSTRING (sym->s.INTERNAL_FIELD (xname)));
+ bool pure_p = PURE_POINTER_P (XSTRING (sym->s.name));
if (!sym->s.gcmarkbit && !pure_p)
{
sym->s.next = symbol_free_list;
symbol_free_list = &sym->s;
#if GC_MARK_STACK
- SVAR (symbol_free_list, function) = Vdead;
+ symbol_free_list->function = Vdead;
#endif
++this_free;
}
{
++num_used;
if (!pure_p)
- UNMARK_STRING (XSTRING (sym->s.INTERNAL_FIELD (xname)));
+ UNMARK_STRING (XSTRING (sym->s.name));
sym->s.gcmarkbit = 0;
}
}
else
{
VECTOR_UNMARK (buffer);
- UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer));
+ /* 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;
}
XSETSYMBOL (tem, sym);
val = find_symbol_value (tem);
if (EQ (val, obj)
- || EQ (SVAR (sym, function), obj)
- || (!NILP (SVAR (sym, function))
- && COMPILEDP (SVAR (sym, function))
- && EQ (AREF (SVAR (sym, function), COMPILED_BYTECODE), obj))
+ || EQ (sym->function, obj)
+ || (!NILP (sym->function)
+ && COMPILEDP (sym->function)
+ && EQ (AREF (sym->function, COMPILED_BYTECODE), obj))
|| (!NILP (val)
&& COMPILEDP (val)
&& EQ (AREF (val, COMPILED_BYTECODE), obj)))
}
#ifdef ENABLE_CHECKING
-int suppress_checking;
+
+bool suppress_checking;
void
die (const char *msg, const char *file, int line)
{
fprintf (stderr, "\r\n%s:%d: Emacs fatal error: %s\r\n",
file, line, msg);
- 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;
}
doc: /* Non-nil means Emacs cannot get much more Lisp memory. */);
Vmemory_full = Qnil;
+ DEFSYM (Qconses, "conses");
+ DEFSYM (Qsymbols, "symbols");
+ DEFSYM (Qmiscs, "miscs");
+ DEFSYM (Qstrings, "strings");
+ DEFSYM (Qvectors, "vectors");
+ DEFSYM (Qfloats, "floats");
+ DEFSYM (Qintervals, "intervals");
+ DEFSYM (Qbuffers, "buffers");
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");
HCoop / bpt / emacs.git / blobdiff