X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fntrace.lisp;h=c5c80b6daf5f141fcef1d613c643e12421e6a6b5;hb=771b864c8f32af7734bc0550aeaf1539fc4df194;hp=03eac599ac24d2d6b8a44fe41b5106d22a0fa46b;hpb=4f07ad793f1a0b3d379ffe412f4cf92a137dccae;p=sbcl.git diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp index 03eac59..c5c80b6 100644 --- a/src/code/ntrace.lisp +++ b/src/code/ntrace.lisp @@ -162,11 +162,13 @@ (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) @@ -204,9 +206,10 @@ (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) @@ -230,9 +233,9 @@ ;;;; 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 @@ -342,7 +345,7 @@ (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)) @@ -461,8 +464,7 @@ 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)) @@ -480,13 +482,20 @@ ((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))))) - - (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* @@ -495,26 +504,32 @@ (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 ...) - (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 @@ -568,10 +583,10 @@ 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))) @@ -605,6 +620,11 @@ #+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 #, + ;; 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))