Re: Problems with debug-on-entry in the Lisp debugger.

[Lute Kamstra]

Richard Stallman <address@hidden> writes:

>        The only solution (within the current implementation) that I can
>        think of, is to temporarily remove all debug-on-entry code while
>        stepping with `d'.
>
> Would setting inhibit-debug-on-entry temporarily do the job?

inhibit-debug-on-entry cannot be set from within the debugger because
it is shadowed by a let binding.  That's what I introduced
debugger-jumping-flag for.  Temporary setting debugger-jumping-flag
would solve the problem of stepping into the code of the debugger.
(I'll implement this fix.)  The debug-entry-code would still be
visible in the backtrace however.

>        I can think of two points in a macro to set a break for the
>        debugger: just before macro expansion and just after it, right
>        before the evaluation of the resulting sexp.
>
> The correct place to do it is before macro expansion.
> This is a very evident bug, so please just fix it if you can.

Stefan already did this.

>                                                    In both cases, hiding
>        the debug-on-entry code from the user of the debugger seems not
>        possible.
>
> I am not sure what that means.

Consider this example (with Stefan's fix for macro's installed):

(defmacro inc (var)
  (list 'setq var (list '1+ var)))
(debug-on-entry 'inc)
(progn (setq x 0) (inc x))

This gives a backtrace like this:

------ Buffer: *Backtrace* ------ 
Debugger entered--entering a function:
* (lambda (var) (if (or inhibit-debug-on-entry debugger-jumping-flag) nil 
(debug ...)) (list (quote setq) var (list ... var)))(x)
  (inc x)
  (progn (setq x 0) (inc x))
  eval((progn (setq x 0) (inc x)))
  eval-last-sexp-1(nil)
  eval-last-sexp(nil)
  call-interactively(eval-last-sexp)
------ Buffer: *Backtrace* ------ 

where you can see the debug-entry-code (if (or inhibit-debug-on-entry
debugger-jumping-flag) nil (debug ...)).  I would prefer to hide the
internals of the debugger from its users.  Moving support for
debug-on-entry into the lisp interpreter (just like support for
stepping is in the lisp interpreter) would make this possible (and
easy).

>     When I was thinking about these three problems, it seemed to me that
>     the easiest and simplest thing to do, is to move support for
>     debug-on-entry into the C implementation of the Lisp interpreter.  To
>     mark a function for debug-on-entry, you could set the debug-on-entry
>     property of the function's symbol and the Lisp interpreter would then
>     call the debugger.
>
> I agree this is undesirable due to slowness.

My proposed change would add one test like
 
  if (debug_on_entry) ...

to Feval and Ffuncall.  And when no functions are set to break on
entry (i.e., the normal situation), debug_on_entry will be zero.  Do
you think that this will have a significant impact on performance?

> I don't see a need for this big a change.

You proposed to change defun, defsubst, defalias and defmacro to add
debug-entry-code when their argument was in debug-function-list.  That
is a similarly big change.

Below is a quick "proof-of-concept" patch for src/eval.c and
lisp/emacs-lisp/debug.el to get a better idea of what I mean.  As you
can see, the change to eval.c isn't that big.  The change in debug.el
is more substantial, but the code becomes a lot simpler.

I also did a quick-and-dirty test to measure the performance impact of
the patch but I did not see any effect on speed; so I suppose it is
negligible.

Lute.


Index: src/eval.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/eval.c,v
retrieving revision 1.234
diff -u -r1.234 eval.c
--- src/eval.c  6 Mar 2005 16:02:47 -0000       1.234
+++ src/eval.c  8 Mar 2005 14:58:49 -0000
@@ -1,6 +1,6 @@
 /* Evaluator for GNU Emacs Lisp interpreter.
-   Copyright (C) 1985, 86, 87, 93, 94, 95, 99, 2000, 2001, 02, 2004
-     Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
+     2002, 2004, 2005 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -91,6 +91,7 @@
 Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
 Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
 Lisp_Object Qand_rest, Qand_optional;
+Lisp_Object Qdebug_on_entry, Qdebug;
 Lisp_Object Qdebug_on_error;
 Lisp_Object Qdeclare;
 
@@ -135,6 +136,14 @@
 
 int debug_on_next_call;
 
+/* Nonzero means check the debug-on-entry property of functions. */
+
+int debug_on_entry;
+
+/* Nonzero means dont't check the debug-on-entry property of functions. */
+
+int suspend_debug_on_entry;
+
 /* Non-zero means debugger may continue.  This is zero when the
    debugger is called during redisplay, where it might not be safe to
    continue the interrupted redisplay. */
@@ -206,6 +215,8 @@
   specpdl_ptr = specpdl;
   max_specpdl_size = 1000;
   max_lisp_eval_depth = 300;
+  debug_on_entry = 0;
+  suspend_debug_on_entry = 0;
 
   Vrun_hooks = Qnil;
 }
@@ -2051,6 +2062,11 @@
 
   if (debug_on_next_call)
     do_debug_on_call (Qt);
+  else if (debug_on_entry && 
+          ! suspend_debug_on_entry && 
+          SYMBOLP (original_fun) &&
+          ! NILP (Fget (original_fun, Qdebug_on_entry)))
+    do_debug_on_call (Qdebug);
 
   /* At this point, only original_fun and original_args
      have values that will be used below */
@@ -2741,6 +2757,11 @@
 
   if (debug_on_next_call)
     do_debug_on_call (Qlambda);
+  else if (debug_on_entry && 
+          ! suspend_debug_on_entry && 
+          SYMBOLP (args[0]) &&
+          ! NILP (Fget (args[0], Qdebug_on_entry)))
+    do_debug_on_call (Qdebug);
 
  retry:
 
@@ -3379,6 +3400,12 @@
   Qexit = intern ("exit");
   staticpro (&Qexit);
 
+  Qdebug_on_entry = intern ("debug-on-entry");
+  staticpro (&Qdebug_on_entry);
+
+  Qdebug = intern ("debug");
+  staticpro (&Qdebug);
+
   Qinteractive = intern ("interactive");
   staticpro (&Qinteractive);
 
@@ -3432,6 +3459,18 @@
   DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call,
               doc: /* Non-nil means enter debugger before next `eval', `apply' 
or `funcall'.  */);
 
+  DEFVAR_BOOL ("debug-on-entry", &debug_on_entry,
+              doc: /* Non-nil means debug-on-entry is enabled.
+When debug-on-entry is enabled, the debugger in entered when functions
+are called that have the debug-on-entry property set.  */);
+
+  DEFVAR_BOOL ("suspend-debug-on-entry", &suspend_debug_on_entry,
+              doc: /* Non-nil means debug-on-entry is disabled.
+When this variable is nil, the variable `debug-on-entry' determines
+whether debug-on-entry is enabled.  When debug-on-entry is enabled,
+the debugger in entered when functions are called that have the
+debug-on-entry property set.  */);
+
   DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue,
               doc: /* Non-nil means debugger may continue execution.
 This is nil when the debugger is called under circumstances where it
Index: lisp/emacs-lisp/debug.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/emacs-lisp/debug.el,v
retrieving revision 1.73
diff -u -r1.73 debug.el
--- lisp/emacs-lisp/debug.el    7 Mar 2005 14:12:26 -0000       1.73
+++ lisp/emacs-lisp/debug.el    8 Mar 2005 14:58:50 -0000
@@ -89,21 +89,6 @@
 (defvar debugger-outer-inhibit-redisplay)
 (defvar debugger-outer-cursor-in-echo-area)
 
-(defvar inhibit-debug-on-entry nil
-  "Non-nil means that debug-on-entry is disabled.")
-
-(defvar debugger-jumping-flag nil
-  "Non-nil means that debug-on-entry is disabled.
-This variable is used by `debugger-jump' and `debugger-reenable'.")
-
-;; When you change this, you may also need to change the number of
-;; frames that the debugger skips.
-(defconst debug-entry-code
-  '(if (or inhibit-debug-on-entry debugger-jumping-flag)
-       nil
-     (debug 'debug))
-  "Code added to a function to cause it to call the debugger upon entry.")
-
 ;;;###autoload
 (setq debugger 'debug)
 ;;;###autoload
@@ -124,6 +109,7 @@
     (let (debugger-value
          (debug-on-error nil)
          (debug-on-quit nil)
+         (debug-on-entry nil)
          (debugger-buffer (let ((default-major-mode 'fundamental-mode))
                             (get-buffer-create "*Backtrace*")))
          (debugger-old-buffer (current-buffer))
@@ -159,7 +145,6 @@
       ;; Don't let these magic variables affect the debugger itself.
       (let ((last-command nil) this-command track-mouse
            (inhibit-trace t)
-           (inhibit-debug-on-entry t)
            unread-command-events
            unread-post-input-method-events
            last-input-event last-command-event last-nonmenu-event
@@ -198,9 +183,8 @@
                  (message "%s" (buffer-string))
                  (kill-emacs))
                (if (eq (car debugger-args) 'debug)
-                   ;; Skip the frames for backtrace-debug, byte-code,
-                   ;; and debug-entry-code.
-                   (backtrace-debug 4 t))
+                   ;; Skip the frames for backtrace-debug and byte-code.
+                   (backtrace-debug 3 t))
                (message "")
                (let ((standard-output nil)
                      (buffer-read-only t))
@@ -262,9 +246,7 @@
   (delete-region (point)
                 (progn
                   (search-forward "\n  debug(")
-                  (forward-line (if (eq (car debugger-args) 'debug)
-                                    2  ; Remove debug-entry-code frame.
-                                  1))
+                  (forward-line 1)
                   (point)))
   (insert "Debugger entered")
   ;; lambda is for debug-on-call when a function call is next.
@@ -409,7 +391,7 @@
   "Continue to exit from this frame, with all debug-on-entry suspended."
   (interactive)
   (debugger-frame)
-  (setq debugger-jumping-flag t)
+  (setq suspend-debug-on-entry t)
   (add-hook 'post-command-hook 'debugger-reenable)
   (message "Continuing through this frame")
   (exit-recursive-edit))
@@ -418,7 +400,7 @@
   "Turn all debug-on-entry functions back on.
 This function is put on `post-command-hook' by `debugger-jump' and
 removes itself from that hook."
-  (setq debugger-jumping-flag nil)
+  (setq suspend-debug-on-entry nil)
   (remove-hook 'post-command-hook 'debugger-reenable))
 
 (defun debugger-frame-number ()
@@ -429,9 +411,6 @@
          (count 0))
       (while (not (eq (cadr (backtrace-frame count)) 'debug))
        (setq count (1+ count)))
-      ;; Skip debug-entry-code frame.
-      (when (member '(debug (quote debug)) (cdr (backtrace-frame (1+ count))))
-       (setq count (1+ count)))
       (goto-char (point-min))
       (when (looking-at "Debugger entered--\\(Lisp error\\|returning 
value\\):")
        (goto-char (match-end 0))
@@ -624,29 +603,16 @@
 (defun debug-on-entry (function)
   "Request FUNCTION to invoke debugger each time it is called.
 If you tell the debugger to continue, FUNCTION's execution proceeds.
-This works by modifying the definition of FUNCTION,
-which must be written in Lisp, not predefined.
-Use \\[cancel-debug-on-entry] to cancel the effect of this command.
-Redefining FUNCTION also cancels it."
+This works by setting the debug-on-entry property of FUNCTION.
+Use \\[cancel-debug-on-entry] to cancel the effect of this command."
   (interactive "aDebug on entry (to function): ")
   ;; Handle a function that has been aliased to some other function.
   (if (and (subrp (symbol-function function))
           (eq (cdr (subr-arity (symbol-function function))) 'unevalled))
       (error "Function %s is a special form" function))
-  (if (or (symbolp (symbol-function function))
-         (subrp (symbol-function function)))
-      ;; Create a wrapper in which we can then add the necessary debug call.
-      (fset function `(lambda (&rest debug-on-entry-args)
-                       ,(interactive-form (symbol-function function))
-                       (apply ',(symbol-function function)
-                              debug-on-entry-args))))
-  (or (consp (symbol-function function))
-      (debug-convert-byte-code function))
-  (or (consp (symbol-function function))
-      (error "Definition of %s is not a list" function))
-  (fset function (debug-on-entry-1 function (symbol-function function) t))
-  (or (memq function debug-function-list)
-      (push function debug-function-list))
+  (put function 'debug-on-entry t)
+  (add-to-list 'debug-function-list function)
+  (setq debug-on-entry t)
   function)
 
 ;;;###autoload
@@ -661,56 +627,14 @@
           (if name (intern name)))))
   (if (and function (not (string= function "")))
       (progn
-       (let ((f (debug-on-entry-1 function (symbol-function function) nil)))
-         (condition-case nil
-             (if (and (equal (nth 1 f) '(&rest debug-on-entry-args))
-                      (eq (car (nth 3 f)) 'apply))
-                 ;; `f' is a wrapper introduced in debug-on-entry.
-                 ;; Get rid of it since we don't need it any more.
-                 (setq f (nth 1 (nth 1 (nth 3 f)))))
-           (error nil))
-         (fset function f))
+       (put function 'debug-on-entry nil)
        (setq debug-function-list (delq function debug-function-list))
+       (unless debug-function-list
+         (setq debug-on-entry nil))
        function)
     (message "Cancelling debug-on-entry for all functions")
-    (mapcar 'cancel-debug-on-entry debug-function-list)))
-
-(defun debug-convert-byte-code (function)
-  (let ((defn (symbol-function function)))
-    (if (not (consp defn))
-       ;; Assume a compiled code object.
-       (let* ((contents (append defn nil))
-              (body
-               (list (list 'byte-code (nth 1 contents)
-                           (nth 2 contents) (nth 3 contents)))))
-         (if (nthcdr 5 contents)
-             (setq body (cons (list 'interactive (nth 5 contents)) body)))
-         (if (nth 4 contents)
-             ;; Use `documentation' here, to get the actual string,
-             ;; in case the compiled function has a reference
-             ;; to the .elc file.
-             (setq body (cons (documentation function) body)))
-         (fset function (cons 'lambda (cons (car contents) body)))))))
-
-(defun debug-on-entry-1 (function defn flag)
-  (let ((tail defn))
-    (if (subrp tail)
-       (error "%s is a built-in function" function)
-      (if (eq (car tail) 'macro) (setq tail (cdr tail)))
-      (if (eq (car tail) 'lambda) (setq tail (cdr tail))
-       (error "%s not user-defined Lisp function" function))
-      ;; Skip the docstring.
-      (when (and (stringp (cadr tail)) (cddr tail))
-       (setq tail (cdr tail)))
-      ;; Skip the interactive form.
-      (when (eq 'interactive (car-safe (cadr tail)))
-       (setq tail (cdr tail)))
-      (unless (eq flag (equal (cadr tail) debug-entry-code))
-       ;; Add/remove debug statement as needed.
-       (if flag
-           (setcdr tail (cons debug-entry-code (cdr tail)))
-         (setcdr tail (cddr tail))))
-      defn)))
+    (setq debug-function-list nil)
+    (setq debug-on-entry nil)))
 
 (defun debugger-list-functions ()
   "Display a list of all the functions now set to debug on entry."
@@ -726,10 +650,7 @@
          (make-text-button (point) (progn (prin1 fun) (point))
                            'type 'help-function
                            'help-args (list fun))
-         (terpri))
-       (terpri)
-       (princ "Note: if you have redefined a function, then it may no 
longer\n")
-       (princ "be set to debug on entry, even if it is in the list.")))))
+         (terpri))))))
 
 (provide 'debug)