More GC assertions
authorDaniel Colascione <dancol@dancol.org>
Tue, 8 Apr 2014 12:34:30 +0000 (05:34 -0700)
committerDaniel Colascione <dancol@dancol.org>
Tue, 8 Apr 2014 12:34:30 +0000 (05:34 -0700)
1  2 
src/ChangeLog
src/alloc.c

diff --combined src/ChangeLog
 -2014-04-03  Daniel Colascione  <dancol@dancol.org>
 -
 -      * alloc.c (sweep_symbols,mark_object): Assert that symbol function
 -      cells contain valid lisp objects.  (Modified version of patch from
 -      Dmitry).
 +2014-04-08  Daniel Colascione  <dancol@dancol.org>
  
 -2014-04-03  Daniel Colascione  <dancol@dancol.org>
++      * alloc.c (sweep_symbols, mark_object): Assert that symbol
++      function cells contain valid lisp objects.  (Modified version of
++      patch from Dmitry).
        * alloc.c (detect_suspicious_free): Split actual stack capturing
        out into new function for easier breakpoint setting.
        (note_suspicious_free): New function.
  
 -2014-04-03  Daniel Colascione  <dancol@dancol.org>
 -
 -      In all places below, change expressions of the form sizeof(arr) /
 -      sizeof(arr[0]) to EARRAYSIZE(arr).
 -
 -      * xterm.c (x_term_init): See above.
 -
 -      * xfns.c (best_xim_style): See above.
 -
 -      * xfaces.c (Fdump_colors): See above.
 +2014-04-07  Stefan Monnier  <monnier@iro.umontreal.ca>
  
 -      * w32fns.c (w32_default_color_map): See above.
 +      * lisp.h (struct Lisp_Symbol): New bitfield `pinned'.
  
 -      * w32.c:
 -      (init_environment): See above.
 -      (N_ENV_VARS): See above.
 +      * alloc.c: Keep track of symbols referenced from pure space (bug#17168).
 +      (symbol_block_pinned): New var.
 +      (Fmake_symbol): Initialize `pinned'.
 +      (purecopy): New function, extracted from Fpurecopy.  Mark symbols as
 +      pinned and signal an error for un-purifiable objects.
 +      (pure_cons): Use it.
 +      (Fpurecopy): Use it, except for objects that can't be purified.
 +      (mark_pinned_symbols): New function.
 +      (Fgarbage_collect): Use it.
 +      (gc_sweep): Remove hack made unnecessary.
  
 -      * unexcw.c (read_exe_header): See above.
 +2014-04-07  Glenn Morris  <rgm@gnu.org>
  
 -      * term.c (term_get_fkeys_1): See above.
 +      * keyboard.c (Fopen_dribble_file): Doc tweak.
  
 -      * sysdep.c (init_baud_rate): See above.
 +2014-04-07  Ken Brown  <kbrown@cornell.edu>
  
 -      * nsterm.m (ns_convert_key): See above.
 +      * Makefile.in (EMACS_MANIFEST): Update comment.  (Bug#17176)
  
 -      * nsfns.m (get_geometry_from_preferences): See above.
 +2014-04-07  Paul Eggert  <eggert@cs.ucla.edu>
  
 -      * msdos.c (dos_set_window_size): See above.
 -      (init_environment): See above.
 +      * alloc.c: Simplify by removing use of HAVE_EXECINFO_H.
 +      We have a substitute execinfo.h on hosts that lack it.
 +      (suspicious_free_history): Make it EXTERNALLY_VISIBLE so it
 +      isn't optimized away.
  
 -      * macfont.m (mac_font_get_glyph_for_cid): See above.
 -      (macfont_store_descriptor_attributes): See above.
 -      (macfont_create_attributes_with_spec): See above.
 -      (mac_ctfont_get_glyph_for_cid): See above.
 +2014-04-05  Paul Eggert  <eggert@cs.ucla.edu>
  
 -      * keyboard.c (command_loop_1): See above.
 -      (read_menu_command): See above.
 -      (make_lispy_event): See above.
 -      (NUM_MOD_NAMES): See above.
 -      (read_key_sequence_vs): See above.
 -      (Fcurrent_input_mode): See above.
 -      (syms_of_keyboard): See above.
 +      Prefer 'ARRAYELTS (x)' to 'sizeof x / sizeof *x'.
 +      * alloc.c (memory_full):
 +      * charset.c (syms_of_charset):
 +      * doc.c (Fsnarf_documentation):
 +      * emacs.c (main):
 +      * font.c (BUILD_STYLE_TABLE):
 +      * keyboard.c (make_lispy_event):
 +      * profiler.c (setup_cpu_timer):
 +      * xgselect.c (xg_select):
 +      * xterm.c (record_event, STORE_KEYSYM_FOR_DEBUG):
 +      Use ARRAYELTS.
 +      * font.c (FONT_PROPERTY_TABLE_SIZE): Remove.
 +      Replace the only use with ARRAYELTS (font_property_table).
 +      * xfaces.c (DIM): Remove.  All uses replaced by ARRAYELTS.
  
 -      * image.c (xpm_str_to_color_key): See above.
 -
 -      * fringe.c (MAX_STANDARD_FRINGE_BITMAPS): See above.
 -
 -      * frame.c (x_set_frame_parameters): See above.
 -
 -      * fileio.c (Ffile_selinux_context): See above.
 -
 -      * emacs.c (sort_args): See above.
 -
 -      * dosfns.c ():
 -      (msdos_stdcolor_name): See above.
 -
 -      * dired.c (file_attributes): See above.
 +2014-04-03  Daniel Colascione  <dancol@dancol.org>
  
 -      * chartab.c:
 -      (uniprop_decoder_count,uniprop_encode_count): See above.
 +      * xterm.c (x_term_init):
 +      * xfns.c (best_xim_style):
 +      * xfaces.c (Fdump_colors):
 +      * w32fns.c (w32_default_color_map):
 +      * w32.c (init_environment, N_ENV_VARS):
 +      * unexcw.c (read_exe_header):
 +      * term.c (term_get_fkeys_1):
 +      * sysdep.c (init_baud_rate):
 +      * nsterm.m (ns_convert_key):
 +      * nsfns.m (get_geometry_from_preferences):
 +      * msdos.c (dos_set_window_size, init_environment):
 +      * macfont.m (mac_font_get_glyph_for_cid)
 +      (macfont_store_descriptor_attributes)
 +      (macfont_create_attributes_with_spec, mac_ctfont_get_glyph_for_cid):
 +      * keyboard.c (command_loop_1, read_menu_command, make_lispy_event)
 +      (NUM_MOD_NAMES, read_key_sequence_vs, Fcurrent_input_mode)
 +      (syms_of_keyboard):
 +      * image.c (xpm_str_to_color_key):
 +      * fringe.c (MAX_STANDARD_FRINGE_BITMAPS):
 +      * frame.c (x_set_frame_parameters):
 +      * fileio.c (Ffile_selinux_context):
 +      * emacs.c (sort_args):
 +      * dosfns.c (msdos_stdcolor_name):
 +      * dired.c (file_attributes):
 +      * chartab.c (uniprop_decoder_count, uniprop_encode_count):
 +      Change expressions of the form sizeof(arr) / sizeof(arr[0])
 +      to ARRAYELTS (arr).
  
  2014-04-02  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.
 +      * lisp.h (ARRAYELTS): New macro.
  
        * alloc.c: Include execinfo.h if available.
        (SUSPICIOUS_OBJECT_CHECKING): New macro; define unconditionally.
        (suspicious_free_record): New structure.
 -      (suspicious_objects,suspicious_object_index)
 -      (suspicious_free_history, suspicious_free_history_index): New
 -      variables.
 -      (find_suspicious_object_in_range,detect_suspicious_free)
 +      (suspicious_objects, suspicious_object_index)
 +      (suspicious_free_history, suspicious_free_history_index):
 +      New variables.
 +      (find_suspicious_object_in_range, detect_suspicious_free)
        (Fsuspicious_object): New functions.
        (cleanup_vector): Call find_suspicious_object_in_range.
  
        Split gc_sweep into discrete functions for legibility and better
        stack traces.
  
 -      * alloc.c (sweep_strings,sweep_vectors): Add NO_INLINE
 +      * alloc.c (sweep_strings, sweep_vectors): Add NO_INLINE
        (sweep_vectors): Fix typo in comment.
 -      (sweep_conses,sweep_floats,sweep_intervals)
 -      (sweep_symbols,sweep_misc,sweep_buffers): New functions.
 +      (sweep_conses, sweep_floats, sweep_intervals)
 +      (sweep_symbols, sweep_misc, sweep_buffers): New functions.
        (gc_sweep): Call new functions, to which existing functionality is
        moved.
        * fns.c (sweep_weak_hash_tables): Add NO_INLINE.
  
        * alloc.c (lisp_align_malloc, allocate_string_data)
        (allocate_vectorlike): Allow mmap allocation of lisp objects.
 -      (pointers_fit_in_lispobj_p,mmap_lisp_allowed_p): New functions.
 +      (pointers_fit_in_lispobj_p, mmap_lisp_allowed_p): New functions.
  
  2014-03-21  Eli Zaretskii  <eliz@gnu.org>
  
        * frame.c (delete_frame): Block/unblock input to overcome race
        condition (Bug#15475).
  
 -2013-09-29  Andreas Politz  <politza@hochschule-trier.de>  (tiny change)
 +2013-09-29  Andreas Politz  <politza@hochschule-trier.de>
  
        * frame.c (delete_frame): Record selected frame only after
        calling Qdelete_frame_functions (Bug#15477).
diff --combined src/alloc.c
@@@ -47,7 -47,10 +47,7 @@@ along with GNU Emacs.  If not, see <htt
  #endif /* HAVE_WINDOW_SYSTEM */
  
  #include <verify.h>
 -
 -#ifdef HAVE_EXECINFO_H
 -#include <execinfo.h>           /* For backtrace */
 -#endif
 +#include <execinfo.h>           /* For backtrace.  */
  
  #if (defined ENABLE_CHECKING                  \
       && defined HAVE_VALGRIND_VALGRIND_H      \
@@@ -204,22 -207,23 +204,22 @@@ const char *pending_malloc_warning
  #define SUSPICIOUS_OBJECT_CHECKING 1
  
  #ifdef SUSPICIOUS_OBJECT_CHECKING
 -struct suspicious_free_record {
 -  void* suspicious_object;
 -#ifdef HAVE_EXECINFO_H
 -  void* backtrace[128];
 -#endif
 +struct suspicious_free_record
 +{
 +  void *suspicious_object;
 +  void *backtrace[128];
  };
 -static voidsuspicious_objects[32];
 +static void *suspicious_objects[32];
  static int suspicious_object_index;
 -struct suspicious_free_record suspicious_free_history[64];
 +struct suspicious_free_record suspicious_free_history[64] EXTERNALLY_VISIBLE;
  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 (voidptr);
 +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)
 +# 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.  */
@@@ -3112,7 -3116,7 +3112,7 @@@ allocate_vectorlike (ptrdiff_t len
          mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
  #endif
  
 -      if (find_suspicious_object_in_range (p, (char*)p + nbytes))
 +      if (find_suspicious_object_in_range (p, (char *) p + nbytes))
          emacs_abort ();
  
        consing_since_gc += nbytes;
@@@ -3357,13 -3361,6 +3357,13 @@@ struct symbol_bloc
  
  static struct symbol_block *symbol_block;
  static int symbol_block_index = SYMBOL_BLOCK_SIZE;
 +/* Pointer to the first symbol_block that contains pinned symbols.
 +   Tests for 24.4 showed that at dump-time, Emacs contains about 15K symbols,
 +   10K of which are pinned (and all but 250 of them are interned in obarray),
 +   whereas a "typical session" has in the order of 30K symbols.
 +   `symbol_block_pinned' lets mark_pinned_symbols scan only 15K symbols rather
 +   than 30K to find the 10K symbols we need to mark.  */
 +static struct symbol_block *symbol_block_pinned;
  
  /* List of free symbols.  */
  
@@@ -3416,11 -3413,10 +3416,11 @@@ Its value is void, and its function def
    SET_SYMBOL_VAL (p, Qunbound);
    set_symbol_function (val, Qnil);
    set_symbol_next (val, NULL);
 -  p->gcmarkbit = 0;
 +  p->gcmarkbit = false;
    p->interned = SYMBOL_UNINTERNED;
    p->constant = 0;
 -  p->declared_special = 0;
 +  p->declared_special = false;
 +  p->pinned = false;
    consing_since_gc += sizeof (struct Lisp_Symbol);
    symbols_consed++;
    total_free_symbols--;
@@@ -3769,7 -3765,7 +3769,7 @@@ memory_full (size_t nbytes
        memory_full_cons_threshold = sizeof (struct cons_block);
  
        /* The first time we get here, free the spare memory.  */
 -      for (i = 0; i < sizeof (spare_memory) / sizeof (char *); i++)
 +      for (i = 0; i < ARRAYELTS (spare_memory); i++)
        if (spare_memory[i])
          {
            if (i == 0)
@@@ -3822,6 -3818,7 +3822,6 @@@ refill_memory_reserve (void
      Vmemory_full = Qnil;
  #endif
  }
 -
  \f
  /************************************************************************
                           C Stack Marking
@@@ -5222,8 -5219,6 +5222,8 @@@ make_pure_c_string (const char *data, p
    return string;
  }
  
 +static Lisp_Object purecopy (Lisp_Object obj);
 +
  /* Return a cons allocated from pure space.  Give it pure copies
     of CAR as car and CDR as cdr.  */
  
@@@ -5233,8 -5228,8 +5233,8 @@@ pure_cons (Lisp_Object car, Lisp_Objec
    Lisp_Object new;
    struct Lisp_Cons *p = pure_alloc (sizeof *p, Lisp_Cons);
    XSETCONS (new, p);
 -  XSETCAR (new, Fpurecopy (car));
 -  XSETCDR (new, Fpurecopy (cdr));
 +  XSETCAR (new, purecopy (car));
 +  XSETCDR (new, purecopy (cdr));
    return new;
  }
  
@@@ -5275,19 -5270,9 +5275,19 @@@ Does not copy symbols.  Copies strings 
  {
    if (NILP (Vpurify_flag))
      return obj;
 -
 -  if (PURE_POINTER_P (XPNTR (obj)))
 +  else if (MARKERP (obj) || OVERLAYP (obj)
 +         || HASH_TABLE_P (obj) || SYMBOLP (obj))
 +    /* Can't purify those.  */
      return obj;
 +  else
 +    return purecopy (obj);
 +}
 +
 +static Lisp_Object
 +purecopy (Lisp_Object obj)
 +{
 +  if (PURE_POINTER_P (XPNTR (obj)) || INTEGERP (obj) || SUBRP (obj))
 +    return obj;    /* Already pure.  */
  
    if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing.  */
      {
        size &= PSEUDOVECTOR_SIZE_MASK;
        vec = XVECTOR (make_pure_vector (size));
        for (i = 0; i < size; i++)
 -      vec->contents[i] = Fpurecopy (AREF (obj, i));
 +      vec->contents[i] = purecopy (AREF (obj, i));
        if (COMPILEDP (obj))
        {
          XSETPVECTYPE (vec, PVEC_COMPILED);
        else
        XSETVECTOR (obj, vec);
      }
 -  else if (MARKERP (obj))
 -    error ("Attempt to copy a marker to pure storage");
 +  else if (SYMBOLP (obj))
 +    {
 +      if (!XSYMBOL (obj)->pinned)
 +      { /* We can't purify them, but they appear in many pure objects.
 +           Mark them as `pinned' so we know to mark them at every GC cycle.  */
 +        XSYMBOL (obj)->pinned = true;
 +        symbol_block_pinned = symbol_block;
 +      }
 +      return obj;
 +    }
    else
 -    /* Not purified, don't hash-cons.  */
 -    return obj;
 +    {
 +      Lisp_Object args[2];
 +      args[0] = build_pure_c_string ("Don't know how to purify: %S");
 +      args[1] = obj;
 +      Fsignal (Qerror, (Fcons (Fformat (2, args), Qnil)));
 +    }
  
    if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing.  */
      Fputhash (obj, obj, Vpurify_flag);
@@@ -5503,24 -5476,6 +5503,24 @@@ compact_undo_list (Lisp_Object list
    return list;
  }
  
 +static void
 +mark_pinned_symbols (void)
 +{
 +  struct symbol_block *sblk;
 +  int lim = (symbol_block_pinned == symbol_block
 +           ? symbol_block_index : SYMBOL_BLOCK_SIZE);
 +
 +  for (sblk = symbol_block_pinned; sblk; sblk = sblk->next)
 +    {
 +      union aligned_Lisp_Symbol *sym = sblk->symbols, *end = sym + lim;
 +      for (; sym < end; ++sym)
 +      if (sym->s.pinned)
 +        mark_object (make_lisp_ptr (&sym->s, Lisp_Symbol));
 +
 +      lim = SYMBOL_BLOCK_SIZE;
 +    }
 +}
 +
  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
@@@ -5623,7 -5578,6 +5623,7 @@@ See Info node `(elisp)Garbage Collectio
    for (i = 0; i < staticidx; i++)
      mark_object (*staticvec[i]);
  
 +  mark_pinned_symbols ();
    mark_specpdl ();
    mark_terminals ();
    mark_kboards ();
@@@ -6220,6 -6174,8 +6220,8 @@@ mark_object (Lisp_Object arg
          break;
        CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
        ptr->gcmarkbit = 1;
+       /* Attempt to catch bogus objects.  */
+         eassert (valid_lisp_object_p (ptr->function) >= 1);
        mark_object (ptr->function);
        mark_object (ptr->plist);
        switch (ptr->redirect)
@@@ -6625,7 -6581,12 +6627,7 @@@ sweep_symbols (void
  
        for (; sym < end; ++sym)
          {
 -          /* 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.  */
 -          bool pure_p = PURE_POINTER_P (XSTRING (sym->s.name));
 -
 -          if (!sym->s.gcmarkbit && !pure_p)
 +          if (!sym->s.gcmarkbit)
              {
                if (sym->s.redirect == SYMBOL_LOCALIZED)
                  xfree (SYMBOL_BLV (&sym->s));
            else
              {
                ++num_used;
 -              if (!pure_p)
 -                eassert (!STRING_MARKED_P (XSTRING (sym->s.name)));
                sym->s.gcmarkbit = 0;
+               /* Attempt to catch bogus objects.  */
+               eassert (valid_lisp_object_p (sym->s.function) >= 1);
              }
          }
  
@@@ -6867,19 -6832,18 +6871,19 @@@ which_symbols (Lisp_Object obj, EMACS_I
  
  #ifdef SUSPICIOUS_OBJECT_CHECKING
  
 -static void*
 -find_suspicious_object_in_range (void* begin, void* end)
 +static void *
 +find_suspicious_object_in_range (void *begin, void *end)
  {
 -  charbegin_a = begin;
 -  charend_a = 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;
 -  }
 +  for (i = 0; i < ARRAYELTS (suspicious_objects); ++i)
 +    {
 +      char *suspicious_object = suspicious_objects[i];
 +      if (begin_a <= suspicious_object && suspicious_object < end_a)
 +      return suspicious_object;
 +    }
  
    return NULL;
  }
@@@ -6898,17 -6862,18 +6902,17 @@@ note_suspicious_free (void* ptr
  
    memset (rec, 0, sizeof (*rec));
    rec->suspicious_object = ptr;
 -#ifdef HAVE_EXECINFO_H
    backtrace (&rec->backtrace[0], EARRAYSIZE (rec->backtrace));
 -#endif
  }
  
  static void
  detect_suspicious_free (void* ptr)
  {
    int i;
 +
    eassert (ptr != NULL);
  
 -  for (i = 0; i < EARRAYSIZE (suspicious_objects); ++i)
 +  for (i = 0; i < ARRAYELTS (suspicious_objects); ++i)
      if (suspicious_objects[i] == ptr)
        {
          note_suspicious_free (ptr);
@@@ -6927,12 -6892,11 +6931,12 @@@ garbage collection bugs.  Otherwise, d
  {
  #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;
 -  }
 +  if (VECTORLIKEP (obj))
 +    {
 +      suspicious_objects[suspicious_object_index++] = XVECTOR (obj);
 +      if (suspicious_object_index == ARRAYELTS (suspicious_objects))
 +      suspicious_object_index = 0;
 +    }
  #endif
    return obj;
  }