[Emacs-diffs] trunk r116931: Add GC bug investigation code

[Daniel Colascione]

------------------------------------------------------------
revno: 116931
revision-id: address@hidden
parent: address@hidden
committer: Daniel Colascione <address@hidden>
branch nick: debug
timestamp: Wed 2014-04-02 17:18:08 -0700
message:
  Add GC bug investigation code
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/subr.el                   subr.el-20091113204419-o5vbwnq5f7feedwu-151
  src/ChangeLog                  changelog-20091113204419-o5vbwnq5f7feedwu-1438
  src/alloc.c                    alloc.c-20091113204419-o5vbwnq5f7feedwu-252
  src/data.c                     data.c-20091113204419-o5vbwnq5f7feedwu-251
  src/lisp.h                     lisp.h-20091113204419-o5vbwnq5f7feedwu-253

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-04-02 17:21:34 +0000
+++ b/lisp/ChangeLog    2014-04-03 00:18:08 +0000
@@ -1,3 +1,9 @@
+2014-04-03  Daniel Colascione  <address@hidden>
+
+       * 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  <address@hidden>
 
        * subr.el (set-transient-map): Comment out previous change.

=== modified file 'lisp/subr.el'
--- a/lisp/subr.el      2014-04-02 17:21:34 +0000
+++ b/lisp/subr.el      2014-04-03 00:18:08 +0000
@@ -4292,33 +4292,34 @@
     ;; 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)))
 

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2014-04-02 16:17:08 +0000
+++ b/src/ChangeLog     2014-04-03 00:18:08 +0000
@@ -1,3 +1,10 @@
+2014-04-03  Daniel Colascione  <address@hidden>
+
+       * 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  <address@hidden>
 
        * xterm.c (x_new_font): Don't calculate non-toolkit scrollbar

=== modified file 'src/alloc.c'
--- a/src/alloc.c       2014-03-23 21:58:19 +0000
+++ b/src/alloc.c       2014-04-03 00:18:08 +0000
@@ -48,6 +48,10 @@
 
 #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 @@
 
 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 @@
 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 @@
         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 @@
     Vmemory_full = Qnil;
 #endif
 }
+
 
 /************************************************************************
                           C Stack Marking
@@ -6787,6 +6826,71 @@
    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 @@
   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);

=== modified file 'src/data.c'
--- a/src/data.c        2014-02-20 07:38:47 +0000
+++ b/src/data.c        2014-04-03 00:18:08 +0000
@@ -727,6 +727,11 @@
   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;

=== modified file 'src/lisp.h'
--- a/src/lisp.h        2014-03-27 22:52:14 +0000
+++ b/src/lisp.h        2014-04-03 00:18:08 +0000
@@ -58,6 +58,9 @@
 #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