procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add GC bug investigation code

Browse source
This commit is contained in:
Daniel Colascione 2014-04-02 17:18:08 -07:00
parent 4fd68bf6cc
commit 01ae0fbf30
6 changed files with 152 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lisp/ChangeLog
View file

@ -1,3 +1,9 @@
2014-04-03 Daniel Colascione <dancol@dancol.org>
* subr.el (set-transient-map): Remove rms's workaround entirely;
use new `suspicious-object' subr to mark our lambda for closer
scrutiny during gc.
2014-04-02 Richard Stallman <rms@gnu.org>
* subr.el (set-transient-map): Comment out previous change.

51
lisp/subr.el
View file

@ -4292,33 +4292,34 @@ lookup sequence then continues."
;; Don't use letrec, because equal (in add/remove-hook) would get trapped
;; in a cycle.
(fset clearfun
(lambda ()
(with-demoted-errors "set-transient-map PCH: %S"
(unless (cond
((not (eq map (cadr overriding-terminal-local-map)))
;; There's presumably some other transient-map in
;; effect. Wait for that one to terminate before we
;; remove ourselves.
;; For example, if isearch and C-u both use transient
;; maps, then the lifetime of the C-u should be nested
;; within isearch's, so the pre-command-hook of
;; isearch should be suspended during the C-u one so
;; we don't exit isearch just because we hit 1 after
;; C-u and that 1 exits isearch whereas it doesn't
;; exit C-u.
t)
((null keep-pred) nil)
((eq t keep-pred)
(eq this-command
(lookup-key map (this-command-keys-vector))))
(t (funcall keep-pred)))
(internal-pop-keymap map 'overriding-terminal-local-map)
(remove-hook 'pre-command-hook clearfun)
(when on-exit (funcall on-exit))
;; Comment out the fset if you want to debug the GC bug.
(suspicious-object
(lambda ()
(with-demoted-errors "set-transient-map PCH: %S"
(unless (cond
((not (eq map (cadr overriding-terminal-local-map)))
;; There's presumably some other transient-map in
;; effect. Wait for that one to terminate before we
;; remove ourselves.
;; For example, if isearch and C-u both use transient
;; maps, then the lifetime of the C-u should be nested
;; within isearch's, so the pre-command-hook of
;; isearch should be suspended during the C-u one so
;; we don't exit isearch just because we hit 1 after
;; C-u and that 1 exits isearch whereas it doesn't
;; exit C-u.
t)
((null keep-pred) nil)
((eq t keep-pred)
(eq this-command
(lookup-key map (this-command-keys-vector))))
(t (funcall keep-pred)))
(internal-pop-keymap map 'overriding-terminal-local-map)
(remove-hook 'pre-command-hook clearfun)
(when on-exit (funcall on-exit))
;; Comment out the fset if you want to debug the GC bug.
;;; (fset clearfun nil)
;;; (set clearfun nil)
))))
)))))
(add-hook 'pre-command-hook clearfun)
(internal-push-keymap map 'overriding-terminal-local-map)))

7
src/ChangeLog
View file

@ -1,3 +1,10 @@
2014-04-03 Daniel Colascione <dancol@dancol.org>
* data.c (Ffset): Abort if we're trying to set a function call to
a dead lisp object.
* lisp.h (EARRAYSIZE): New macro.
2014-04-02 Martin Rudalics <rudalics@gmx.at>
* xterm.c (x_new_font): Don't calculate non-toolkit scrollbar

105
src/alloc.c
View file

@ -48,6 +48,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <verify.h>
#ifdef HAVE_EXECINFO_H
#include <execinfo.h> /* For backtrace */
#endif
#if (defined ENABLE_CHECKING \
&& defined HAVE_VALGRIND_VALGRIND_H \
&& !defined USE_VALGRIND)
@ -192,6 +196,36 @@ static ptrdiff_t pure_bytes_used_non_lisp;
const char *pending_malloc_warning;
#if 0 /* Normally, pointer sanity only on request... */
#ifdef ENABLE_CHECKING
#define SUSPICIOUS_OBJECT_CHECKING 1
#endif
#endif
/* ... but unconditionally use SUSPICIOUS_OBJECT_CHECKING while the GC
bug is unresolved. */
#define SUSPICIOUS_OBJECT_CHECKING 1
#ifdef SUSPICIOUS_OBJECT_CHECKING
struct suspicious_free_record {
void* suspicious_object;
#ifdef HAVE_EXECINFO_H
void* backtrace[128];
#endif
};
static void* suspicious_objects[32];
static int suspicious_object_index;
struct suspicious_free_record suspicious_free_history[64];
static int suspicious_free_history_index;
/* Find the first currently-monitored suspicious pointer in range
[begin,end) or NULL if no such pointer exists. */
static void* find_suspicious_object_in_range (void* begin, void* end);
static void detect_suspicious_free (void* ptr);
#else
#define find_suspicious_object_in_range(begin, end) NULL
#define detect_suspicious_free(ptr) (void)
#endif
/* Maximum amount of C stack to save when a GC happens. */
#ifndef MAX_SAVE_STACK
@ -2922,6 +2956,7 @@ vector_nbytes (struct Lisp_Vector *v)
static void
cleanup_vector (struct Lisp_Vector *vector)
{
detect_suspicious_free (vector);
if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT)
&& ((vector->header.size & PSEUDOVECTOR_SIZE_MASK)
== FONT_OBJECT_MAX))
@ -3081,6 +3116,9 @@ allocate_vectorlike (ptrdiff_t len)
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif
if (find_suspicious_object_in_range (p, (char*)p + nbytes))
emacs_abort ();
consing_since_gc += nbytes;
vector_cells_consed += len;
}
@ -3780,6 +3818,7 @@ refill_memory_reserve (void)
Vmemory_full = Qnil;
#endif
}
/************************************************************************
C Stack Marking
@ -6787,6 +6826,71 @@ which_symbols (Lisp_Object obj, EMACS_INT find_max)
return found;
}
#ifdef SUSPICIOUS_OBJECT_CHECKING
static void*
find_suspicious_object_in_range (void* begin, void* end)
{
char* begin_a = begin;
char* end_a = end;
int i;
for (i = 0; i < EARRAYSIZE (suspicious_objects); ++i) {
char* suspicious_object = suspicious_objects[i];
if (begin_a <= suspicious_object && suspicious_object < end_a)
return suspicious_object;
}
return NULL;
}
static void
detect_suspicious_free (void* ptr)
{
int i;
struct suspicious_free_record* rec;
eassert (ptr != NULL);
for (i = 0; i < EARRAYSIZE (suspicious_objects); ++i)
if (suspicious_objects[i] == ptr)
{
rec = &suspicious_free_history[suspicious_free_history_index++];
if (suspicious_free_history_index ==
EARRAYSIZE (suspicious_free_history))
{
suspicious_free_history_index = 0;
}
memset (rec, 0, sizeof (rec));
rec->suspicious_object = ptr;
#ifdef HAVE_EXECINFO_H
backtrace (&rec->backtrace[0], EARRAYSIZE (rec->backtrace));
#endif
suspicious_objects[i] = NULL;
}
}
#endif /* SUSPICIOUS_OBJECT_CHECKING */
DEFUN ("suspicious-object", Fsuspicious_object, Ssuspicious_object, 1, 1, 0,
doc: /* Return OBJ, maybe marking it for extra scrutiny.
If Emacs is compiled with suspicous object checking, capture
a stack trace when OBJ is freed in order to help track down
garbage collection bugs. Otherwise, do nothing and return OBJ. */)
(Lisp_Object obj)
{
#ifdef SUSPICIOUS_OBJECT_CHECKING
/* Right now, we care only about vectors. */
if (VECTORLIKEP (obj)) {
suspicious_objects[suspicious_object_index++] = XVECTOR (obj);
if (suspicious_object_index == EARRAYSIZE (suspicious_objects))
suspicious_object_index = 0;
}
#endif
return obj;
}
#ifdef ENABLE_CHECKING
bool suppress_checking;
@ -6957,6 +7061,7 @@ The time is in seconds as a floating point value. */);
defsubr (&Sgarbage_collect);
defsubr (&Smemory_limit);
defsubr (&Smemory_use_counts);
defsubr (&Ssuspicious_object);
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
defsubr (&Sgc_status);

5
src/data.c
View file

@ -727,6 +727,11 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
if (AUTOLOADP (function))
Fput (symbol, Qautoload, XCDR (function));
/* Convert to eassert or remove after GC bug is found. In the
meantime, check unconditionally, at a slight perf hit. */
if (valid_lisp_object_p (definition) < 1)
emacs_abort ();
set_symbol_function (symbol, definition);
return definition;

3
src/lisp.h
View file

@ -58,6 +58,9 @@ INLINE_HEADER_BEGIN
#define max(a, b) ((a) > (b) ? (a) : (b))
#define min(a, b) ((a) < (b) ? (a) : (b))
/* Find number of elements in array */
#define EARRAYSIZE(arr) (sizeof (arr) / sizeof ((arr)[0]))
/* EMACS_INT - signed integer wide enough to hold an Emacs value
EMACS_INT_MAX - maximum value of EMACS_INT; can be used in #if
pI - printf length modifier for EMACS_INT