bug#6420: Some enhancements to debugging

[Lennart Borgman <lennart.borgman@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 539 bytes --]

Here are some patches to make debugging easier.

The first patch adds thread id to the output when running on w32. That
is very important information when you try to debug system calls and
thread usage. (w32proc-debprint-thread-0.diff)

The second patch adds a way to print output to the debugger from lisp.
(gdb-deb-print-0.diff)

The third patch lets you output tracing of functions to the debugger
too. This patch also have some convenience things like making the
function at point default for function name.
(trace-to-debugger-0.diff)

[-- Attachment #2: w32proc-debprint-thread-0.diff --]
[-- Type: text/x-patch, Size: 1189 bytes --]

=== modified file 'src/w32proc.c'
--- trunk/src/w32proc.c	2010-06-04 14:13:35 +0000
+++ patched/src/w32proc.c	2010-06-14 05:53:50 +0000
@@ -121,9 +121,17 @@
 {
   char buf[1024];
   va_list args;
+  char *buf_pos = buf;
+
+  /* On NT add thread id */
+#ifdef WINDOWSNT
+  DWORD thread_id = GetCurrentThreadId ();
+  sprintf (buf_pos, "[Th%04x]  ", thread_id);
+  buf_pos = buf_pos + 10;
+#endif
 
   va_start (args, fmt);
-  vsprintf (buf, fmt, args);
+  vsprintf (buf_pos, fmt, args);
   va_end (args);
   OutputDebugString (buf);
 }
@@ -304,8 +312,16 @@
 	 read-ahead has completed, whether successfully or not. */
       if (!SetEvent (cp->char_avail))
         {
-	  DebPrint (("reader_thread.SetEvent failed with %lu for fd %ld\n",
-		     GetLastError (), cp->fd));
+	  DebPrint (("reader_thread.SetEvent failed with %lu for fd %ld, pid %ld\n",
+		     GetLastError (), cp->fd, cp->pid));
+          /* It fails a couple of times with
+
+               warning: reader_thread.SetEvent failed with 6 for fd -1
+
+             where 6 is
+
+               ERROR_INVALID_HANDLE 6 (0x6) The handle is invalid.
+          */
 	  return 1;
 	}
 


[-- Attachment #3: gdb-deb-print-0.diff --]
[-- Type: text/x-patch, Size: 1545 bytes --]

=== modified file 'src/print.c'
--- trunk/src/print.c	2010-04-20 01:50:52 +0000
+++ patched/src/print.c	2010-06-14 02:41:47 +0000
@@ -996,6 +996,42 @@
 	     );
 }
 
+DEFUN ("gdb-deb-print", Fgdb_deb_print, Sgdb_deb_print, 1, MANY, 0,
+       doc: /* Display a message in the debugger.
+Does nothing unless Emacs is compiled with debugging support.
+
+The first argument is a format control string, and the rest are data
+to be formatted under control of the string.  See `format' for
+details.
+
+If the message is longer than 1000 chars it will be split in several
+lines.
+
+usage: (gdb-deb-print FORMAT-STRING &rest ARGS)  */)
+     (nargs, args)
+     int nargs;
+     Lisp_Object *args;
+{
+#ifdef EMACSDEBUG
+  Lisp_Object val;
+  struct gcpro gcpro1;
+  val = Fformat (nargs, args);
+  Lisp_Object max_len = make_number (1000);
+  Lisp_Object len;
+  Lisp_Object subval;
+  while (XINT( Flength(val)) > 0)
+    {
+      len = make_number (min (XINT (Flength (val)), XINT (max_len)));
+      subval = Fsubstring (val, make_number (0), len);
+      val = Fsubstring (val, len, Qnil);
+      GCPRO1 (subval);
+      DebPrint ((SDATA (subval)));
+      UNGCPRO;
+    }
+#endif
+  return Qnil;
+}
+
 \f
 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
        1, 1, 0,
@@ -2452,6 +2493,7 @@
 
   defsubr (&Sprin1);
   defsubr (&Sprin1_to_string);
+  defsubr (&Sgdb_deb_print);
   defsubr (&Serror_message_string);
   defsubr (&Sprinc);
   defsubr (&Sprint);


[-- Attachment #4: trace-to-debugger-0.diff --]
[-- Type: text/x-patch, Size: 2922 bytes --]

=== modified file 'lisp/emacs-lisp/trace.el'
--- trunk/lisp/emacs-lisp/trace.el	2010-03-22 16:50:29 +0000
+++ patched/lisp/emacs-lisp/trace.el	2010-06-14 06:09:20 +0000
@@ -207,6 +207,11 @@
 	  ;; do this so we'll see strings:
 	  (let ((print-circle t)) (prin1-to-string value))))
 
+(defcustom trace-output-also-to-debugger t
+  "Output trace messages also to debugger if non-nil."
+  :type 'boolean
+  :group 'trace)
+
 (defun trace-make-advice (function buffer background)
   ;; Builds the piece of advice to be added to FUNCTION's advice info
   ;; so that it will generate the proper trace output in BUFFER
@@ -223,7 +228,14 @@
            ,(unless background '(display-buffer trace-buffer))
 	   (goto-char (point-max))
 	   ;; Insert a separator from previous trace output:
-	   (if (= trace-level 1) (insert trace-separator))
+	   (when (= trace-level 1)
+             (when trace-output-also-to-debugger
+               (gdb-deb-print trace-separator))
+             (insert trace-separator))
+           (when trace-output-also-to-debugger
+             (gdb-deb-print
+              (trace-entry-message
+               ',function trace-level ad-arg-bindings)))
 	   (insert
 	    (trace-entry-message
 	     ',function trace-level ad-arg-bindings))))
@@ -232,6 +244,10 @@
 	 (with-current-buffer trace-buffer
 	   ,(unless background '(display-buffer trace-buffer))
 	   (goto-char (point-max))
+           (when trace-output-also-to-debugger
+             (gdb-deb-print
+              (trace-exit-message
+               ',function trace-level ad-return-value)))
 	   (insert
 	    (trace-exit-message
 	     ',function trace-level ad-return-value))))))))
@@ -258,7 +274,13 @@
 display oriented stuff, use `trace-function-background' instead."
   (interactive
    (list
-    (intern (completing-read "Trace function: " obarray 'fboundp t))
+    (intern
+     (let ((fn (function-called-at-point)))
+       (completing-read (if fn
+                            (format "Trace function (default %s: " fn)
+                          "Trace function: ")
+                        obarray 'fboundp t nil nil
+                        (and fn (symbol-name fn)))))
     (read-buffer "Output to buffer: " trace-buffer)))
   (trace-function-internal function buffer nil))
 
@@ -276,7 +298,12 @@
   (interactive
    (list
     (intern
-     (completing-read "Trace function in background: " obarray 'fboundp t))
+     (let ((fn (function-called-at-point)))
+       (completing-read (if fn
+                            (format "Trace function in background (default %s: " fn)
+                          "Trace function in background: ")
+                        obarray 'fboundp t nil nil
+                        (and fn (symbol-name fn)))))
     (read-buffer "Output to buffer: " trace-buffer)))
   (trace-function-internal function buffer t))