Merge profiler branch

etc/NEWS

@@ -678,6 +678,11 @@ are deprecated and will be removed eventually.
 
 * Lisp changes in Emacs 24.3
 
+** New sampling-based Elisp profiler.
+Try M-x profiler-start ... M-x profiler-stop; and then M-x profiler-report.
+The sampling rate can be based on CPU time (only supported on some
+systems), or based on memory allocations.
+
 ** CL-style generalized variables are now in core Elisp.
 `setf' is autoloaded; `push' and `pop' accept generalized variables.
 

lisp/ChangeLog

+2012-09-26  Tomohiro Matsuyama  <tomo@cx4a.org>
+            Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* profiler.el: New file.
+
 2012-09-26  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* emacs-lisp/testcover.el (testcover-after): Add gv-expander.

src/ChangeLog

+2012-09-26  Tomohiro Matsuyama  <tomo@cx4a.org>
+            Stefan Monnier  <monnier@iro.umontreal.ca>
+            Juanma Barranquero  <lekktu@gmail.com>
+
+	* profiler.c: New file.
+	* Makefile.in (base_obj): Add profiler.o.
+	* makefile.w32-in (OBJ2, GLOBAL_SOURCES): Add profiler.c.
+	($(BLD)/profiler.$(O)): New target.
+	* emacs.c (main): Call syms_of_profiler.
+	* alloc.c (Qautomatic_gc): New constant.
+	(MALLOC_PROBE): New macro.
+	(xmalloc, xzalloc, xrealloc, lisp_malloc, lisp_align_malloc): Use it.
+	(total_bytes_of_live_objects): New function.
+	(Fgarbage_collect): Use it.  Record itself in backtrace_list.
+	Call malloc_probe for the memory profiler.
+	(syms_of_alloc): Define Qautomatic_gc.
+	* eval.c (eval_sub, Ffuncall): Reorder assignments to avoid
+	race condition.
+	(struct backtrace): Move definition...
+	* lisp.h (struct backtrace): ..here.
+	(Qautomatic_gc, profiler_memory_running): Declare vars.
+	(malloc_probe, syms_of_profiler): Declare functions.
+	* xdisp.c (Qautomatic_redisplay): New constant.
+	(redisplay_internal): Record itself in backtrace_list.
+	(syms_of_xdisp): Define Qautomatic_redisplay.
+
 2012-09-25  Juanma Barranquero  <lekktu@gmail.com>
 
 	* makefile.w32-in ($(BLD)/callproc.$(O)): Update dependencies.
@@ -291,8 +317,8 @@
 	(reinvoke_input_signal): Remove.  All uses replaced by
 	handle_async_input.
 	(quit_count): Now volatile, since a signal handler uses it.
-	(handle_interrupt): Now takes bool IN_SIGNAL_HANDLER as arg.  All
-	callers changed.  Block SIGINT only if not already blocked.
+	(handle_interrupt): Now takes bool IN_SIGNAL_HANDLER as arg.
+	All callers changed.  Block SIGINT only if not already blocked.
 	Clear sigmask reliably, even if Fsignal returns, which it can.
 	Omit unnecessary accesses to volatile var.
 	(quit_throw_to_read_char): No need to restore sigmask.
@@ -392,8 +418,8 @@
 	if it is defined.  Arguments and return value changed.
 	(valid_image_p, make_image): Callers changed.
 	(xbm_type, xpm_type, pbm_type, png_type, jpeg_type, tiff_type)
-	(gif_type, imagemagick_type, svg_type, gs_type): Add
-	initialization functions.
+	(gif_type, imagemagick_type, svg_type, gs_type):
+	Add initialization functions.
 	(Finit_image_library): Call lookup_image_type.
 	(CHECK_LIB_AVAILABLE): Macro deleted.
 	(lookup_image_type): Call define_image_type here, rather than via
@@ -415,8 +441,8 @@
 	* window.c (Fsplit_window_internal): Handle only Qt value of
 	Vwindow_combination_limit separately.
 	(Qtemp_buffer_resize): New symbol.
-	(Vwindow_combination_limit): New default value.  Rewrite
-	doc-string.
+	(Vwindow_combination_limit): New default value.
+	Rewrite doc-string.
 
 2012-09-22  Eli Zaretskii  <eliz@gnu.org>
 
@@ -515,7 +541,7 @@
 	(Fx_create_frame): Call x_set_offset to correctly interpret
 	top_pos in geometry.
 
-	* frame.c (read_integer, XParseGeometry): Moved from w32xfns.c.
+	* frame.c (read_integer, XParseGeometry): Move from w32xfns.c.
 	(Fx_parse_geometry): If there is a space in string, call
 	Qns_parse_geometry, otherwise do as on other terms (Bug#12368).
 
@@ -616,8 +642,8 @@
 
 2012-09-16  Martin Rudalics  <rudalics@gmx.at>
 
-	* window.c (Fwindow_parameter, Fset_window_parameter): Accept
-	any window as argument (Bug#12452).
+	* window.c (Fwindow_parameter, Fset_window_parameter):
+	Accept any window as argument (Bug#12452).
 
 2012-09-16  Jan Djärv  <jan.h.d@swipnet.se>
 
@@ -692,8 +718,8 @@
 2012-09-14  Dmitry Antipov  <dmantipov@yandex.ru>
 
 	Avoid out-of-range marker position (Bug#12426).
-	* insdel.c (replace_range, replace_range_2): Adjust
-	markers before overlays, as suggested by comments.
+	* insdel.c (replace_range, replace_range_2):
+	Adjust markers before overlays, as suggested by comments.
 	(insert_1_both, insert_from_buffer_1, adjust_after_replace):
 	Remove redundant check before calling offset_intervals.
 
@@ -992,8 +1018,8 @@
 	in the internal border.
 	(x_set_window_size): Remove static variables and their usage.
 	(ns_redraw_scroll_bars): Fix NSTRACE arg.
-	(ns_after_update_window_line, ns_draw_fringe_bitmap): Remove
-	fringe/internal border adjustment (Bug#11052).
+	(ns_after_update_window_line, ns_draw_fringe_bitmap):
+	Remove fringe/internal border adjustment (Bug#11052).
 	(ns_draw_fringe_bitmap): Make code more like other terms (xterm.c).
 	(ns_draw_window_cursor): Remove fringe/internal border adjustment.
 	(ns_fix_rect_ibw): Remove.
@@ -1210,8 +1236,8 @@
 	(init_signals) [FORWARD_SIGNAL_TO_MAIN_THREAD]: Initialize it;
 	code moved here from emacs.c's main function.
 	* sysdep.c, syssignal.h (handle_on_main_thread): New function,
-	replacing the old SIGNAL_THREAD_CHECK.  All uses changed.  This
-	lets callers save and restore errno properly.
+	replacing the old SIGNAL_THREAD_CHECK.  All uses changed.
+	This lets callers save and restore errno properly.
 
 2012-09-05  Dmitry Antipov  <dmantipov@yandex.ru>
 
@@ -1520,8 +1546,8 @@
 	* process.c: Include TERM_HEADER instead of listing all possible
 	window-system headers.
 
-	* nsterm.h: Remove declarations now in frame.h.  Define
-	FRAME_X_SCREEN, FRAME_X_VISUAL.
+	* nsterm.h: Remove declarations now in frame.h.
+	Define FRAME_X_SCREEN, FRAME_X_VISUAL.
 
 	* menu.c: Include TERM_HEADER instead of listing all possible
 	window-system headers.
@@ -1717,8 +1743,8 @@
 
 	* nsterm.h (NSPanel): New class variable dialog_return.
 
-	* nsmenu.m (initWithContentRect:styleMask:backing:defer:): Initialize
-	dialog_return.
+	* nsmenu.m (initWithContentRect:styleMask:backing:defer:):
+	Initialize dialog_return.
 	(windowShouldClose:): Use stop instead of stopModalWithCode.
 	(clicked:): Ditto, and also set dialog_return (Bug#12258).
 	(timeout_handler:): Use stop instead of abortModal.  Send a dummy

src/Makefile.in

@@ -339,6 +339,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
 	process.o gnutls.o callproc.o \
 	region-cache.o sound.o atimer.o \
 	doprnt.o intervals.o textprop.o composite.o xml.o \
+	profiler.o \
 	$(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
 	$(WINDOW_SYSTEM_OBJ)
 obj = $(base_obj) $(NS_OBJC_OBJ)

src/alloc.c

@@ -205,6 +205,7 @@ 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.  */
@@ -648,6 +649,13 @@ malloc_unblock_input (void)
 # 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 *
@@ -661,6 +669,7 @@ xmalloc (size_t size)
 
   if (!val && size)
     memory_full (size);
+  MALLOC_PROBE (size);
   return val;
 }
 
@@ -678,6 +687,7 @@ xzalloc (size_t size)
   if (!val && size)
     memory_full (size);
   memset (val, 0, size);
+  MALLOC_PROBE (size);
   return val;
 }
 
@@ -699,6 +709,7 @@ xrealloc (void *block, size_t size)
 
   if (!val && size)
     memory_full (size);
+  MALLOC_PROBE (size);
   return val;
 }
 
@@ -888,6 +899,7 @@ lisp_malloc (size_t nbytes, enum mem_type type)
   MALLOC_UNBLOCK_INPUT;
   if (!val && nbytes)
     memory_full (nbytes);
+  MALLOC_PROBE (nbytes);
   return val;
 }
 
@@ -1093,6 +1105,8 @@ lisp_align_malloc (size_t nbytes, enum mem_type type)
 
   MALLOC_UNBLOCK_INPUT;
 
+  MALLOC_PROBE (nbytes);
+
   eassert (0 == ((uintptr_t) val) % BLOCK_ALIGN);
   return val;
 }
@@ -5043,6 +5057,23 @@ 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
@@ -5068,6 +5099,8 @@ See Info node `(elisp)Garbage Collection'.  */)
   ptrdiff_t count = SPECPDL_INDEX ();
   EMACS_TIME start;
   Lisp_Object retval = Qnil;
+  size_t tot_before = 0;
+  struct backtrace backtrace;
 
   if (abort_on_gc)
     emacs_abort ();
@@ -5077,6 +5110,14 @@ See Info node `(elisp)Garbage Collection'.  */)
   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 = &Qautomatic_gc;
+  backtrace.nargs = 0;
+  backtrace.debug_on_exit = 0;
+  backtrace_list = &backtrace;
+
   check_cons_list ();
 
   /* Don't keep undo information around forever.
@@ -5084,6 +5125,9 @@ See Info node `(elisp)Garbage Collection'.  */)
   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,
@@ -5255,16 +5299,7 @@ See Info node `(elisp)Garbage Collection'.  */)
   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)
@@ -5367,6 +5402,17 @@ See Info node `(elisp)Garbage Collection'.  */)
 
   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;
 }
 
@@ -6527,6 +6573,7 @@ do hash-consing of the objects allocated to pure space.  */);
   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");

src/emacs.c

@@ -1419,6 +1419,8 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
       syms_of_ntterm ();
 #endif /* WINDOWSNT */
 
+      syms_of_profiler ();
+
       keys_of_casefiddle ();
       keys_of_cmds ();
       keys_of_buffer ();

src/eval.c

@@ -31,17 +31,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "xterm.h"
 #endif
 
-struct backtrace
-{
-  struct backtrace *next;
-  Lisp_Object *function;
-  Lisp_Object *args;	/* Points to vector of args.  */
-  ptrdiff_t nargs;	/* Length of vector.  */
-  /* Nonzero means call value of debugger when done with this operation.  */
-  unsigned int debug_on_exit : 1;
-};
-
-static struct backtrace *backtrace_list;
+struct backtrace *backtrace_list;
 
 #if !BYTE_MARK_STACK
 static
@@ -2055,11 +2045,11 @@ eval_sub (Lisp_Object form)
   original_args = XCDR (form);
 
   backtrace.next = backtrace_list;
-  backtrace_list = &backtrace;
   backtrace.function = &original_fun; /* This also protects them from gc.  */
   backtrace.args = &original_args;
   backtrace.nargs = UNEVALLED;
   backtrace.debug_on_exit = 0;
+  backtrace_list = &backtrace;
 
   if (debug_on_next_call)
     do_debug_on_call (Qt);
@@ -2730,11 +2720,11 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
     }
 
   backtrace.next = backtrace_list;
-  backtrace_list = &backtrace;
   backtrace.function = &args[0];
   backtrace.args = &args[1];	/* This also GCPROs them.  */
   backtrace.nargs = nargs - 1;
   backtrace.debug_on_exit = 0;
+  backtrace_list = &backtrace;
 
   /* Call GC after setting up the backtrace, so the latter GCPROs the args.  */
   maybe_gc ();

src/lisp.h

@@ -2031,6 +2031,18 @@ extern ptrdiff_t specpdl_size;
 
 #define SPECPDL_INDEX()	(specpdl_ptr - specpdl)
 
+struct backtrace
+{
+  struct backtrace *next;
+  Lisp_Object *function;
+  Lisp_Object *args;	/* Points to vector of args.  */
+  ptrdiff_t nargs;	/* Length of vector.  */
+  /* Nonzero means call value of debugger when done with this operation.  */
+  unsigned int debug_on_exit : 1;
+};
+
+extern struct backtrace *backtrace_list;
+
 /* Everything needed to describe an active condition case.
 
    Members are volatile if their values need to survive _longjmp when
@@ -2916,6 +2928,7 @@ build_string (const char *str)
 
 extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
 extern void make_byte_code (struct Lisp_Vector *);
+extern Lisp_Object Qautomatic_gc;
 extern Lisp_Object Qchar_table_extra_slots;
 extern struct Lisp_Vector *allocate_vector (EMACS_INT);
 extern struct Lisp_Vector *allocate_pseudovector (int memlen, int lisplen, int tag);
@@ -3534,6 +3547,13 @@ extern int have_menus_p (void);
 void syms_of_dbusbind (void);
 #endif
 
+
+/* Defined in profiler.c.  */
+extern bool profiler_memory_running;
+extern void malloc_probe (size_t);
+extern void syms_of_profiler (void);
+
+
 #ifdef DOS_NT
 /* Defined in msdos.c, w32.c.  */
 extern char *emacs_root_dir (void);

src/makefile.w32-in

@@ -125,6 +125,7 @@ OBJ2 =  $(BLD)/sysdep.$(O)		\
 	$(BLD)/terminal.$(O)            \
 	$(BLD)/menu.$(O)		\
 	$(BLD)/xml.$(O)			\
+	$(BLD)/profiler.$(O)		\
 	$(BLD)/w32term.$(O)		\
 	$(BLD)/w32xfns.$(O)		\
 	$(BLD)/w32fns.$(O)		\
@@ -222,7 +223,7 @@ GLOBAL_SOURCES =   dosfns.c msdos.c \
 	process.c callproc.c unexw32.c \
 	region-cache.c sound.c atimer.c \
 	doprnt.c intervals.c textprop.c composite.c \
-	gnutls.c xml.c
+	gnutls.c xml.c profiler.c
 SOME_MACHINE_OBJECTS = dosfns.o msdos.o \
 	xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o dbusbind.o
 obj = $(GLOBAL_SOURCES:.c=.o)
@@ -973,6 +974,11 @@ $(BLD)/xml.$(O) : \
 	$(CONFIG_H) \
 	$(LISP_H)
 
+$(BLD)/profiler.$(O) : \
+	$(SRC)/profiler.c \
+	$(CONFIG_H) \
+	$(LISP_H)
+
 $(BLD)/image.$(O) : \
 	$(SRC)/image.c \
 	$(SRC)/blockinput.h \

src/xdisp.c

@@ -333,10 +333,10 @@ static Lisp_Object Qinhibit_eval_during_redisplay;
 static Lisp_Object Qbuffer_position, Qposition, Qobject;
 static Lisp_Object Qright_to_left, Qleft_to_right;
 
-/* Cursor shapes */
+/* Cursor shapes.  */
 Lisp_Object Qbar, Qhbar, Qbox, Qhollow;
 
-/* Pointer shapes */
+/* Pointer shapes.  */
 static Lisp_Object Qarrow, Qhand;
 Lisp_Object Qtext;
 
@@ -347,6 +347,7 @@ static Lisp_Object Qfontification_functions;
 
 static Lisp_Object Qwrap_prefix;
 static Lisp_Object Qline_prefix;
+static Lisp_Object Qautomatic_redisplay;
 
 /* Non-nil means don't actually do any redisplay.  */
 
@@ -12929,12 +12930,13 @@ redisplay_internal (void)
   struct frame *sf;
   int polling_stopped_here = 0;
   Lisp_Object old_frame = selected_frame;
+  struct backtrace backtrace;
 
   /* Non-zero means redisplay has to consider all windows on all
      frames.  Zero means, only selected_window is considered.  */
   int consider_all_windows_p;
 
-  /* Non-zero means redisplay has to redisplay the miniwindow */
+  /* Non-zero means redisplay has to redisplay the miniwindow.  */
   int update_miniwindow_p = 0;
 
   TRACE ((stderr, "redisplay_internal %d\n", redisplaying_p));
@@ -12971,6 +12973,14 @@ redisplay_internal (void)
   redisplaying_p = 1;
   specbind (Qinhibit_free_realized_faces, Qnil);
 
+  /* Record this function, so it appears on the profiler's backtraces.  */
+  backtrace.next = backtrace_list;
+  backtrace.function = &Qautomatic_redisplay;
+  backtrace.args = &Qautomatic_redisplay;
+  backtrace.nargs = 0;
+  backtrace.debug_on_exit = 0;
+  backtrace_list = &backtrace;
+
   {
     Lisp_Object tail, frame;
 
@@ -13668,6 +13678,7 @@ redisplay_internal (void)
 #endif /* HAVE_WINDOW_SYSTEM */
 
  end_of_redisplay:
+  backtrace_list = backtrace.next;
   unbind_to (count, Qnil);
   RESUME_POLLING;
 }
@@ -28683,6 +28694,7 @@ syms_of_xdisp (void)
   staticpro (&Vmessage_stack);
 
   DEFSYM (Qinhibit_redisplay, "inhibit-redisplay");
+  DEFSYM (Qautomatic_redisplay, "Automatic Redisplay");
 
   message_dolog_marker1 = Fmake_marker ();
   staticpro (&message_dolog_marker1);
@@ -29349,7 +29361,7 @@ init_xdisp (void)
    the following three functions in w32fns.c.  */
 #ifndef WINDOWSNT
 
-/* Platform-independent portion of hourglass implementation. */
+/* Platform-independent portion of hourglass implementation.  */
 
 /* Cancel a currently active hourglass timer, and start a new one.  */
 void