0.8.16.6:

[sbcl.git] / src / code / ntrace.lisp

diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp
index 03eac59..c5c80b6 100644 (file)
--- a/src/code/ntrace.lisp
+++ b/src/code/ntrace.lisp
@@ -162,11 +162,13 @@
          (let* ((bod (ecase loc
                        ((nil) exp)
                        (:encapsulated
          (let* ((bod (ecase loc
                        ((nil) exp)
                        (:encapsulated

-                        `(flet ((sb-debug:arg (n)
-                                  (declare (special arg-list))
-                                  (elt arg-list n)))
-                           (declare (ignorable #'sb-debug:arg))
-                           ,exp))))
+                        `(locally (declare (disable-package-locks sb-debug:arg arg-list))
+                           (flet ((sb-debug:arg (n)
+                                    (declare (special arg-list))
+                                    (elt arg-list n)))
+                             (declare (ignorable #'sb-debug:arg)
+                                      (enable-package-locks sb-debug:arg arg-list))
+                             ,exp)))))

                 (fun (coerce `(lambda () ,bod) 'function)))
            (cons exp
                  (lambda (frame)
                 (fun (coerce `(lambda () ,bod) 'function)))
            (cons exp
                  (lambda (frame)

@@ -204,9 +206,10 @@
   (dolist (ele forms)
     (fresh-line)
     (print-trace-indentation)
   (dolist (ele forms)
     (fresh-line)
     (print-trace-indentation)

-    (format t "~@<~S ~_= ~S~:>" (car ele) (funcall (cdr ele) frame))))
+    (format t "~@<~S ~_= ~S~:>" (car ele) (funcall (cdr ele) frame))
+    (terpri)))

 
 

-;;; Test a BREAK option, and break if true.
+;;; Test a BREAK option, and if true, break.

 (defun trace-maybe-break (info break where frame)
   (when (and break (funcall (cdr break) frame))
     (sb-di:flush-frames-above frame)
 (defun trace-maybe-break (info break where frame)
   (when (and break (funcall (cdr break) frame))
     (sb-di:flush-frames-above frame)

@@ -230,9 +233,9 @@
 ;;;; hook functions
 
 ;;; Return a closure that can be used for a function start breakpoint
 ;;;; hook functions
 
 ;;; Return a closure that can be used for a function start breakpoint

-;;; hook function and a closure that can be used as the
-;;; FUN-END-COOKIE function. The first communicates the sense of
-;;; the Condition to the second via a closure variable.
+;;; hook function and a closure that can be used as the FUN-END-COOKIE
+;;; function. The first communicates the sense of the
+;;; TRACE-INFO-CONDITION to the second via a closure variable.

 (defun trace-start-breakpoint-fun (info)
   (let (conditionp)
     (values
 (defun trace-start-breakpoint-fun (info)
   (let (conditionp)
     (values

@@ -342,7 +345,7 @@
                  (nth-value 2 (trace-fdefinition definition)))
          (trace-fdefinition function-or-name))
     (when (gethash fun *traced-funs*)
                  (nth-value 2 (trace-fdefinition definition)))
          (trace-fdefinition function-or-name))
     (when (gethash fun *traced-funs*)

-      (warn "~S is already TRACE'd, untracing it." function-or-name)
+      (warn "~S is already TRACE'd, untracing it first." function-or-name)

       (untrace-1 fun))
 
     (let* ((debug-fun (sb-di:fun-debug-fun fun))
       (untrace-1 fun))
 
     (let* ((debug-fun (sb-di:fun-debug-fun fun))

@@ -461,8 +464,7 @@
     current))
 
 ;;; Compute the expansion of TRACE in the non-trivial case (arguments
     current))
 
 ;;; Compute the expansion of TRACE in the non-trivial case (arguments

-;;; specified.) If there are no :FUNCTION specs, then don't use a LET.
-;;; This allows TRACE to be used without the full interpreter.
+;;; specified.) 

 (defun expand-trace (specs)
   (collect ((binds)
            (forms))
 (defun expand-trace (specs)
   (collect ((binds)
            (forms))

@@ -480,13 +482,20 @@
           ((and (keywordp name)
                 (not (or (fboundp name) (macro-function name))))
            (error "unknown TRACE option: ~S" name))
           ((and (keywordp name)
                 (not (or (fboundp name) (macro-function name))))
            (error "unknown TRACE option: ~S" name))

+          ((stringp name)
+           (let ((package (find-undeleted-package-or-lose name)))
+             (do-all-symbols (symbol (find-package name))
+               (when (and (eql package (symbol-package symbol))
+                          (fboundp symbol)
+                          (not (macro-function symbol))
+                          (not (special-operator-p symbol)))
+                 (forms `(trace-1 ',symbol ',options))))))

           (t
            (forms `(trace-1 ',name ',options))))
          (setq current (parse-trace-options current options)))))
           (t
            (forms `(trace-1 ',name ',options))))
          (setq current (parse-trace-options current options)))))

-
-    (if (binds)
-       `(let ,(binds) (list ,@(forms)))
-       `(list ,@(forms)))))
+    
+    `(let ,(binds)
+      (list ,@(forms)))))

 
 (defun %list-traced-funs ()
   (loop for x being each hash-value in *traced-funs*
 
 (defun %list-traced-funs ()
   (loop for x being each hash-value in *traced-funs*

@@ -495,26 +504,32 @@
 (defmacro trace (&rest specs)
   #+sb-doc
   "TRACE {Option Global-Value}* {Name {Option Value}*}*
 (defmacro trace (&rest specs)
   #+sb-doc
   "TRACE {Option Global-Value}* {Name {Option Value}*}*

-   TRACE is a debugging tool that provides information when specified functions
-   are called. In its simplest form:
+
+TRACE is a debugging tool that provides information when specified
+functions are called. In its simplest form:
+

        (TRACE NAME-1 NAME-2 ...)
        (TRACE NAME-1 NAME-2 ...)

-   (The NAMEs are not evaluated.)

 
 

-   Options allow modification of the default behavior. Each option is a pair
-   of an option keyword and a value form. Global options are specified before
-   the first name, and affect all functions traced by a given use of TRACE.
-   Options may also be interspersed with function names, in which case they
-   act as local options, only affecting tracing of the immediately preceding
-   function name. Local options override global options.
+The NAMEs are not evaluated. Each may be a symbol, denoting an
+individual function, or a string, denoting all functions fbound to
+symbols whose home package is the package with the given name.
+
+Options allow modification of the default behavior. Each option is a
+pair of an option keyword and a value form. Global options are
+specified before the first name, and affect all functions traced by a
+given use of TRACE. Options may also be interspersed with function
+names, in which case they act as local options, only affecting tracing
+of the immediately preceding function name. Local options override
+global options.

 
 

-   By default, TRACE causes a printout on *TRACE-OUTPUT* each time that
-   one of the named functions is entered or returns. (This is the
-   basic, ANSI Common Lisp behavior of TRACE.) As an SBCL extension, the
-   :REPORT SB-EXT:PROFILE option can be used to instead cause information
-   to be silently recorded to be inspected later using the SB-EXT:PROFILE
-   function.
+By default, TRACE causes a printout on *TRACE-OUTPUT* each time that
+one of the named functions is entered or returns. (This is the basic,
+ANSI Common Lisp behavior of TRACE.) As an SBCL extension, the
+:REPORT SB-EXT:PROFILE option can be used to instead cause information
+to be silently recorded to be inspected later using the SB-EXT:PROFILE
+function.

 
 

-   The following options are defined:
+The following options are defined:

 
    :REPORT Report-Type
        If Report-Type is TRACE (the default) then information is reported
 
    :REPORT Report-Type
        If Report-Type is TRACE (the default) then information is reported

@@ -568,10 +583,10 @@
        and the resulting function is instrumented, i.e. traced or profiled
        as specified in REPORT.
 
        and the resulting function is instrumented, i.e. traced or profiled
        as specified in REPORT.
 

-   :CONDITION, :BREAK and :PRINT forms are evaluated in a context which
-   mocks up the lexical environment of the called function, so that
-   SB-DEBUG:VAR and SB-DEBUG:ARG can be used. The -AFTER and -ALL forms
-   are evaluated in the null environment."
+:CONDITION, :BREAK and :PRINT forms are evaluated in a context which
+mocks up the lexical environment of the called function, so that
+SB-DEBUG:VAR and SB-DEBUG:ARG can be used. The -AFTER and -ALL forms
+are evaluated in the null environment."

   (if specs
       (expand-trace specs)
       '(%list-traced-funs)))
   (if specs
       (expand-trace specs)
       '(%list-traced-funs)))

@@ -605,6 +620,11 @@
   #+sb-doc
   "Remove tracing from the specified functions. With no args, untrace all
    functions."
   #+sb-doc
   "Remove tracing from the specified functions. With no args, untrace all
    functions."

+  ;; KLUDGE: Since we now allow (TRACE FOO BAR "SB-EXT") to trace not
+  ;; only #'FOO and #'BAR but also all the functions in #<PACKAGE "SB-EXT">,
+  ;; it would be probably be best for consistency to do something similar
+  ;; with UNTRACE. (But I leave it to someone who uses and cares about
+  ;; UNTRACE-with-args more often than I do.) -- WHN 2003-12-17

   (if specs
       (collect ((res))
        (let ((current specs))
   (if specs
       (collect ((res))
        (let ((current specs))