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

[Lute Kamstra <Lute.Kamstra.lists@xs4all.nl>]

Richard Stallman <rms@gnu.org> 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)