On Mon, Oct 17, 2005 at 04:30:58AM -0500, Ben Wing wrote:
So far, it seems that everyone's profiling on the Lisp level.
But C
level profiling could give much better results. Has anyone successfully
used Gprof or the VC++ tools for doing C-level profiling? When i tried
in the past, i got stuck; things crashed and i couldn't get them to
work. Any success stories and instructions telling what exactly to do?
In my startup measurements[1] I profiled at the C level first, but the
C part time was negligible. I didn't use gprof or any other tool
because in my experience they don't really show what you want to see.
Just for your curiosity, here is the hack I use. Quite useful though:
Index: lisp/faces.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/faces.el,v
retrieving revision 1.35
diff -u -r1.35 faces.el
--- lisp/faces.el 2005/03/31 11:28:44 1.35
+++ lisp/faces.el 2005/10/17 10:03:08
@@ -885,7 +885,7 @@
;; I don't understand its purpose. Undocumented hacks like this,
;; clearly added after-the-fact, don't deserve to live. DOCUMENT
;; THIS SHIT!
-
+ (tick "ffp start")
(flet
(
@@ -1005,6 +1005,7 @@
;; end of flets
)
+ (tick "ffp flets")
;; the function itself
@@ -1025,9 +1026,10 @@
(face-property-instance face win-prop domain))))
;; first do the frobbing
+ (tick "ffp let")
(setq face (get-face face))
(map-over-locales locale)
-
+ (tick "ffp map-over-locales")
(when do-later-stages
(if (global-locale locale) (setq locale 'global))
@@ -1078,12 +1080,15 @@
(if (eq devtype-spec 'tty) '(tty)))
))))
(setq do-something t)))))
+ (tick "ffp part 2")
(when do-something
- (map-over-locales (or (global-locale locale) locale))))
+ (map-over-locales (or (global-locale locale) locale)))
+ (tick "ffp map-over-locales 2")
+ )
;; then do the third stage -- check for whether we have to do
;; the inheritance trick.
-
+ (tick "ffp part 3")
(when (and check-differences
(let ((new-instance
(face-property-instance face win-prop domain)))
@@ -1697,32 +1702,40 @@
(defun init-global-faces (device)
(let ((Face-frob-property-device-considered-current device))
+ (tick "igf start")
;; Look for global face resources.
(loop for face in (face-list) do
(init-face-from-resources face 'global))
+ (tick "igf init-face-from-resources*n")
;; Further frobbing.
(and (featurep 'x) (declare-fboundp (x-init-global-faces)))
(and (featurep 'gtk) (declare-fboundp (gtk-init-global-faces)))
(and (featurep 'mswindows) (declare-fboundp (mswindows-init-global-faces)))
+ (tick "igf x-init-global-faces")
;; for bold and the like, make the global specification be bold etc.
;; if the user didn't already specify a value. These will also be
;; frobbed further in init-other-random-faces.
(unless (face-font 'bold 'global)
(make-face-bold 'bold 'global))
+ (tick "igf make bold")
;;
(unless (face-font 'italic 'global)
(make-face-italic 'italic 'global))
+ (tick "igf make italic")
;;
(unless (face-font 'bold-italic 'global)
(make-face-bold-italic 'bold-italic 'global)
(unless (face-font 'bold-italic 'global)
(copy-face 'bold 'bold-italic)
(make-face-italic 'bold-italic)))
+ (tick "igf make bold italic")
(when (face-equal 'bold 'bold-italic device)
(copy-face 'italic 'bold-italic)
- (make-face-bold 'bold-italic))))
+ (make-face-bold 'bold-italic))
+ (tick "igf remake bold italic")
+ ))
;; These warnings are there for a reason. Just specify your fonts
Index: lisp/startup.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/startup.el,v
retrieving revision 1.55
diff -u -r1.55 startup.el
--- lisp/startup.el 2005/05/05 16:55:41 1.55
+++ lisp/startup.el 2005/10/17 10:03:10
@@ -505,6 +505,7 @@
(defun normal-top-level ()
(if command-line-processed
(message "Back to top level.")
+ (tick "normal-top-level start")
(setq command-line-processed t)
;; Do this first for maximum likelihood of catching errors. The main
;; purpose of this is so that debug-on-error can be set to catch errors
@@ -520,19 +521,23 @@
(setq default-directory (file-name-as-directory value))))
(setq default-directory (abbreviate-file-name default-directory))
(initialize-xemacs-paths)
+ (tick "normal-top-level initialize-xemacs-paths")
(startup-set-invocation-environment)
+ (tick "normal-top-level startup-set-invocation-environment")
(startup-setup-paths (cond (inhibit-all-packages t)
(inhibit-early-packages '(early))
(t nil))
nil)
(startup-setup-paths-warning)
+ (tick "normal-top-level startup-setup-paths")
;; Either we need to inhibit messages from do_autoloads, or this
;; should go into (command-line) after the initialization of the
;; frame?
(startup-load-autoloads)
+ (tick "normal-top-level startup-load-autoloads")
(let (error-data)
;; if noninteractive, an error will kill us. by catching and
;; resignalling, we don't accomplish much, but do make it difficult
@@ -551,6 +556,7 @@
(command-line)
;; catch non-error signals, especially quit
(t (setq error-data data))))
+ (tick "normal-top-level command-line")
;; Do this again, in case the init file defined more abbreviations.
(setq default-directory (abbreviate-file-name default-directory))
;; Specify the file for recording all the auto save files of
@@ -563,18 +569,22 @@
(emacs-pid)
(system-name)))))
(run-hooks 'emacs-startup-hook)
+ (tick "normal-top-level emacs-startup-hook")
(and term-setup-hook
(run-hooks 'term-setup-hook))
+ (tick "normal-top-level term-setup-hook")
(setq term-setup-hook nil)
;; ;; Modify the initial frame based on what the init file puts into
;; ;; ...-frame-alist.
(frame-notice-user-settings)
+ (tick "normal-top-level frame-notice-user-settings")
;; ;;####FSFmacs junk
;; ;; Now we know the user's default font, so add it to the menu.
;; (if (fboundp 'font-menu-add-default)
;; (font-menu-add-default))
(when window-setup-hook
(run-hooks 'window-setup-hook))
+ (tick "normal-top-level window-setup-hook")
(setq window-setup-hook nil)
(if error-data
;; re-signal, and don't allow continuation as that will probably
@@ -689,6 +699,7 @@
(let ((debugger 'early-error-handler)
(debug-on-error t))
+ (tick "cl start")
;; Process magic command-line switches like -q and -u. Do this
;; before creating the first frame because some of these switches
;; may affect that. I think it's ok to do this before establishing
@@ -703,16 +714,19 @@
(when (featurep 'toolbar)
(init-toolbar-location))
+ (tick "cl init-toolbar-location")
;; Setup coding systems and Unicode support--needs to be before X11
;; initialisation in case of keysyms of the form UABCD.
(when (featurep 'mule)
(declare-fboundp (init-mule-at-startup)))
+ (tick "cl init-mule-at-startup")
(if (featurep 'toolbar)
(if (featurep 'infodock)
(require 'id-x-toolbar)
(init-toolbar)))
+ (tick "cl init-toolbar")
;; Run the window system's init function. tty is considered to be
;; a type of window system for this purpose. This creates the
;; initial (non stdio) device.
@@ -721,14 +735,19 @@
(symbol-name initial-window-system)
"-win"))))
+ (tick (concat "cl init-"
+ (symbol-name initial-window-system)
+ "-win"))
;; When not in batch mode, this creates the first visible frame,
;; and deletes the stdio device.
(frame-initialize))
+ (tick "cl frame-initialize")
;; Reinitialize faces if necessary. This function changes face if
;; it is created during auto-autoloads loading. Otherwise, it
;; does nothing.
(startup-initialize-custom-faces)
+ (tick "cl startup-initialize-custom-faces")
;; A couple of other things need to be initted.
;; (RMS writes about internally using hooks for this, in reference
@@ -741,6 +760,7 @@
;; In this case, I completely agree. --ben
(if (featurep 'menubar)
(init-menubar-at-startup))
+ (tick "cl init-menubar-at-startup")
;;
;; We have normality, I repeat, we have normality. Anything you still
;; can't cope with is therefore your own problem. (And we don't need
@@ -749,6 +769,7 @@
;;; Load init files.
(load-init-file)
+ (tick "cl load-init-file")
(with-current-buffer (get-buffer "*scratch*")
(erase-buffer)
Index: lisp/x-init.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-init.el,v
retrieving revision 1.15
diff -u -r1.15 x-init.el
--- lisp/x-init.el 2005/06/26 18:04:50 1.15
+++ lisp/x-init.el 2005/10/17 10:03:10
@@ -303,8 +303,11 @@
"Initialize X Windows at startup. Don't call this."
(when (not x-win-initted)
(defvar x-app-defaults-directory)
+ (tick "ixw start")
(init-pre-x-win)
+ (tick "ixw init-pre-x-win")
(if (featurep 'mule) (init-mule-x-win))
+ (tick "ixw init-mule-x-win")
;; Open the X display when this file is loaded
;; (Note that the first frame is created later.)
@@ -315,7 +318,9 @@
(null x-app-defaults-directory))
(setq x-app-defaults-directory
(locate-data-directory "app-defaults")))
+ (tick "ixw app-default")
(make-x-device nil)
+ (tick "ixw make-x-device")
(setq command-line-args-left (cdr x-initial-argv-list))
(setq x-win-initted t)))
Index: src/cmdloop.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/cmdloop.c,v
retrieving revision 1.23
diff -u -r1.23 cmdloop.c
--- src/cmdloop.c 2005/01/29 09:15:59 1.23
+++ src/cmdloop.c 2005/10/17 10:03:11
@@ -28,6 +28,8 @@
from event-stream.c, but it doesn't really. Perhaps this file
should just be merged into event-stream.c, given its shortness. */
+extern void tick(const char *);
+
#include <config.h>
#include "lisp.h"
@@ -219,8 +221,11 @@
{
/* This function can GC */
/* On entry to the outer level, run the startup file */
- if (!NILP (Vtop_level))
+ if (!NILP (Vtop_level)) {
+ tick("t_l_1");
condition_case_1 (Qerror, Feval, Vtop_level, cmd_error, Qnil);
+ tick("Vtop_level");
+ }
#if 1
else
{
@@ -281,9 +286,12 @@
DOESNT_RETURN
initial_command_loop (Lisp_Object load_me)
{
+ tick("enter i_c_l");
/* This function can GC */
- if (!NILP (load_me))
+ if (!NILP (load_me)) {
Vtop_level = list2 (Qload, load_me);
+ tick("load_me list2");
+ }
/* First deal with startup and command-line arguments. A throw
to 'top-level gets us back here directly (does this ever happen?).
@@ -291,6 +299,7 @@
line arguments have been processed, the user's initialization
file has been read in, and the first frame has been created. */
internal_catch (Qtop_level, top_level_1, Qnil, 0, 0, 0);
+ tick("top_level_1");
/* If an error occurred during startup and the initial console
wasn't created, then die now (the error was already printed out
@@ -539,6 +548,8 @@
int was_locked = in_single_console_state ();
GCPRO2 (event, old_loop);
+ tick("enter c-l-1");
+
/* cancel_echoing (); */
/* This magically makes single character keyboard macros work just
like the real thing. This is slightly bogus, but it's in here for
@@ -596,8 +607,11 @@
unbind_to (count);
}
+ tick("loop begin");
Fnext_event (event, Qnil);
+ tick("next event");
Fdispatch_event (event);
+ tick("dispatch event");
if (!was_locked)
any_console_state ();
@@ -612,6 +626,19 @@
#endif
}
+DEFUN ("tick", Ftick, 1, 1, 0, /*
+Tick
+*/
+ (tickstring))
+{
+ char buf[4096];
+ CHECK_STRING (tickstring);
+ memcpy(buf, XSTRING_DATA(tickstring), XSTRING_LENGTH(tickstring));
+ buf[XSTRING_LENGTH(tickstring)] = 0;
+ tick(buf);
+ return Qnil;
+}
+
/**********************************************************************/
/* Initialization */
@@ -631,6 +658,7 @@
#endif
DEFSUBR (Freally_early_error_handler);
DEFSUBR (Fcommand_loop_1);
+ DEFSUBR (Ftick);
}
void
Index: src/device.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/device.c,v
retrieving revision 1.34
diff -u -r1.34 device.c
--- src/device.c 2005/04/08 23:11:22 1.34
+++ src/device.c 2005/10/17 10:03:12
@@ -27,6 +27,8 @@
device-system-metric stuff added 1998? by Kirill Katsnelson.
*/
+extern void tick(const char *);
+
#include <config.h>
#include "lisp.h"
@@ -401,12 +403,16 @@
static void
init_global_resources (struct device *d)
{
+ tick("igr start");
init_global_faces (d);
+ tick("igr init_global_faces");
#ifdef HAVE_SCROLLBARS
init_global_scrollbars (d);
+ tick("igr init_global_scrollbars");
#endif
#ifdef HAVE_TOOLBARS
init_global_toolbars (d);
+ tick("igr init_global_toolbars");
#endif
}
@@ -619,17 +625,23 @@
specify different global resources (there's a property on each X
server's root window that holds some resources); tough luck for the
moment. */
- int first = NILP (get_default_device (type));
+ int first;
+
+ tick("md start");
+
+ first = NILP (get_default_device (type));
GCPRO3 (device, console, name);
conmeths = decode_console_type (type, ERROR_ME_NOT);
if (!conmeths)
invalid_constant ("Invalid device type", type);
+ tick("md decode_console_type");
device = Ffind_device (connection, type);
if (!NILP (device))
RETURN_UNGCPRO (device);
+ tick("md find-device");
name = Fplist_get (props, Qname, Qnil);
@@ -644,9 +656,13 @@
record_unwind_protect (delete_deviceless_console, console);
+ tick("md rup");
+
con = XCONSOLE (console);
d = allocate_device (console);
+ tick("md allocate_device");
device = wrap_device (d);
+ tick("md wrap_device");
d->devmeths = con->conmeths;
d->devtype = get_console_variant (type);
@@ -659,19 +675,25 @@
MAYBE_DEVMETH (d, init_device, (d, props));
+ tick("md init_device?");
+
/* Do it this way so that the device list is in order of creation */
con->device_list = nconc2 (con->device_list, Fcons (device, Qnil));
if (NILP (get_default_device (type)))
set_default_device (type, device);
+ tick("md set_default_device");
+
note_object_created (device);
+ tick("md note_object_created");
RESET_CHANGED_SET_FLAGS;
if (NILP (Vdefault_device) || DEVICE_STREAM_P (XDEVICE (Vdefault_device)))
Vdefault_device = device;
init_device_sound (d);
+ tick("md init_device_sound");
/* If this is the first device on the console, make it the selected one. */
if (NILP (CONSOLE_SELECTED_DEVICE (con)))
@@ -684,15 +706,21 @@
tag; this fails for tags such as `default', if we haven't set up the
tags yet. */
setup_device_initial_specifier_tags (d);
+ tick("md setup_device_initial_specifier_tags");
if (!EQ (type, Qstream))
{
- if (first)
+ if (first) {
init_global_resources (d);
+ tick("md init_global_resources");
+ }
init_device_resources (d);
+ tick("md init_device_resources");
}
+ tick("md init_resources");
MAYBE_DEVMETH (d, finish_init_device, (d, props));
+ tick("md finish_init_device");
UNGCPRO;
unbind_to (speccount);
Index: src/emacs.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/emacs.c,v
retrieving revision 1.158
diff -u -r1.158 emacs.c
--- src/emacs.c 2005/10/04 17:51:24 1.158
+++ src/emacs.c 2005/10/17 10:03:14
@@ -465,6 +465,22 @@
/* For PATH_EXEC */
#include <paths.h>
+#include <sys/time.h>
+static struct timeval tv_ref;
+static void tinit()
+{
+ gettimeofday(&tv_ref, 0);
+}
+
+void tick(const char *msg)
+{
+ struct timeval tv;
+ gettimeofday(&tv, 0);
+ int te = (tv.tv_sec-tv_ref.tv_sec)*1000000+(tv.tv_usec-tv_ref.tv_usec);
+ fprintf(stderr, "TIMING: %s : %5d.%03d\n", msg, te/1000000, (te/1000) %
1000);
+ tv_ref = tv;
+}
+
#if defined (HEAP_IN_DATA) && !defined (PDUMP)
void report_sheap_usage (int die_if_pure_storage_exceeded);
#endif
@@ -895,6 +911,7 @@
#ifdef NeXT
extern int malloc_cookie;
#endif
+ tinit();
#if (!defined (SYSTEM_MALLOC) && !defined (HAVE_LIBMCHECK) \
&& !defined (DOUG_LEA_MALLOC))
@@ -1306,7 +1323,7 @@
In the comments below, "dump time" or "dumping" == raw-temacs.
"run time" == run-temacs or post-dump.
*/
-
+ tick("params");
/* First, do really basic environment initialization -- catching signals
and the like. These functions have no dependence on any part of
the Lisp engine and need to be done both at dump time and at run time. */
@@ -1374,7 +1391,7 @@
int inhibit_site_modules_save = inhibit_site_modules;
initialized = pdump_load (argv[0]);
-
+ tick("pdump load");
/* Now unstomp everything */
noninteractive1 = noninteractive;
inhibit_early_packages = inhibit_early_packages_save;
@@ -2559,6 +2576,7 @@
init_device_tty ();
#endif
init_console_stream (restart); /* Create the first console */
+ tick("post init");
/* try to get the actual pathname of the exec file we are running */
if (!restart)
@@ -2619,7 +2637,7 @@
#endif /* QUANTIFY */
initialized = 1;
-
+ tick("ready");
/* This never returns. */
initial_command_loop (load_me);
/* NOTREACHED */