0.6.11.45:
[sbcl.git] / src / code / ntrace.lisp
index 2ac8fc1..3f72462 100644 (file)
 
 (in-package "SB-DEBUG")
 
-(file-comment
-  "$Header$")
-
-;;; FIXME: Why, oh why, doesn't the SB-DEBUG package use the SB-DI package?
-;;; That would let us get rid of a whole lot of stupid prefixes..
+;;; FIXME: Why, oh why, doesn't the SB-DEBUG package use the SB-DI
+;;; package? That would let us get rid of a whole lot of stupid
+;;; prefixes..
 
 (defvar *trace-values* nil
   #+sb-doc
 \f
 ;;;; internal state
 
-;;; a hash table that maps each traced function to the TRACE-INFO. The entry
-;;; for a closure is the shared function-entry object.
+;;; a hash table that maps each traced function to the TRACE-INFO. The
+;;; entry for a closure is the shared function-entry object.
 (defvar *traced-functions* (make-hash-table :test 'eq))
 
-;;; A TRACE-INFO object represents all the information we need to trace a
-;;; given function.
+;;; A TRACE-INFO object represents all the information we need to
+;;; trace a given function.
 (def!struct (trace-info
             (:make-load-form-fun sb-kernel:just-dump-it-normally)
             (:print-object (lambda (x stream)
   ;; the list of function names for WHEREIN, or NIL if unspecified
   (wherein nil :type list)
 
-  ;; The following slots represent the forms that we are supposed to evaluate
-  ;; on each iteration. Each form is represented by a cons (Form . Function),
-  ;; where the Function is the cached result of coercing Form to a function.
-  ;; Forms which use the current environment are converted with
-  ;; PREPROCESS-FOR-EVAL, which gives us a one-arg function.
-  ;; Null environment forms also have one-arg functions, but the argument is
-  ;; ignored. NIL means unspecified (the default.)
+  ;; The following slots represent the forms that we are supposed to
+  ;; evaluate on each iteration. Each form is represented by a cons
+  ;; (Form . Function), where the Function is the cached result of
+  ;; coercing Form to a function. Forms which use the current
+  ;; environment are converted with PREPROCESS-FOR-EVAL, which gives
+  ;; us a one-arg function. Null environment forms also have one-arg
+  ;; functions, but the argument is ignored. NIL means unspecified
+  ;; (the default.)
 
   ;; current environment forms
   (condition nil)
   ;; list of null environment forms
   (print-after () :type list))
 
-;;; This is a list of conses (function-end-cookie .
-;;; condition-satisfied), which we use to note distinct dynamic
-;;; entries into functions. When we enter a traced function, we add a
-;;; entry to this list holding the new end-cookie and whether the
-;;; trace condition was satisfied. We must save the trace condition so
-;;; that the after breakpoint knows whether to print. The length of
-;;; this list tells us the indentation to use for printing TRACE
-;;; messages.
+;;; This is a list of conses (function-end-cookie . condition-satisfied),
+;;; which we use to note distinct dynamic entries into functions. When
+;;; we enter a traced function, we add a entry to this list holding
+;;; the new end-cookie and whether the trace condition was satisfied.
+;;; We must save the trace condition so that the after breakpoint
+;;; knows whether to print. The length of this list tells us the
+;;; indentation to use for printing TRACE messages.
 ;;;
 ;;; This list also helps us synchronize the TRACE facility dynamically
 ;;; for detecting non-local flow of control. Whenever execution hits a
-;;; :function-end breakpoint used for TRACE'ing, we look for the
-;;; function-end-cookie at the top of *traced-entries*. If it is not
+;;; :FUNCTION-END breakpoint used for TRACE'ing, we look for the
+;;; FUNCTION-END-COOKIE at the top of *TRACED-ENTRIES*. If it is not
 ;;; there, we discard any entries that come before our cookie.
 ;;;
 ;;; When we trace using encapsulation, we bind this variable and add
 (defvar *traced-entries* ())
 (declaim (list *traced-entries*))
 
-;;; This variable is used to discourage infinite recursions when some trace
-;;; action invokes a function that is itself traced. In this case, we quietly
-;;; ignore the inner tracing.
+;;; This variable is used to discourage infinite recursions when some
+;;; trace action invokes a function that is itself traced. In this
+;;; case, we quietly ignore the inner tracing.
 (defvar *in-trace* nil)
 \f
 ;;;; utilities
 
-;;;    Given a function name, a function or a macro name, return the raw
-;;; definition and some information. "Raw"  means that if the result is a
-;;; closure, we strip off the closure and return the bare code. The second
-;;; value is T if the argument was a function name. The third value is one of
-;;; :COMPILED, :COMPILED-CLOSURE, :INTERPRETED, :INTERPRETED-CLOSURE and
-;;; :FUNCALLABLE-INSTANCE.
+;;; Given a function name, a function or a macro name, return the raw
+;;; definition and some information. "Raw" means that if the result is
+;;; a closure, we strip off the closure and return the bare code. The
+;;; second value is T if the argument was a function name. The third
+;;; value is one of :COMPILED, :COMPILED-CLOSURE, :INTERPRETED,
+;;; :INTERPRETED-CLOSURE and :FUNCALLABLE-INSTANCE.
 (defun trace-fdefinition (x)
   (multiple-value-bind (res named-p)
       (typecase x
           (values res named-p :funcallable-instance))
          (t (values res named-p :compiled))))))
 
-;;; When a function name is redefined, and we were tracing that name, then
-;;; untrace the old definition and trace the new one.
+;;; When a function name is redefined, and we were tracing that name,
+;;; then untrace the old definition and trace the new one.
 (defun trace-redefined-update (fname new-value)
   (when (fboundp fname)
     (let* ((fun (trace-fdefinition fname))
       (when (and info (trace-info-named info))
        (untrace-1 fname)
        (trace-1 fname info new-value)))))
-(push #'trace-redefined-update sb-int:*setf-fdefinition-hook*)
+(push #'trace-redefined-update *setf-fdefinition-hook*)
 
-;;; Annotate some forms to evaluate with pre-converted functions. Each form
-;;; is really a cons (exp . function). Loc is the code location to use for
-;;; the lexical environment. If Loc is NIL, evaluate in the null environment.
-;;; If Form is NIL, just return NIL.
+;;; Annotate some forms to evaluate with pre-converted functions. Each
+;;; form is really a cons (exp . function). Loc is the code location
+;;; to use for the lexical environment. If Loc is NIL, evaluate in the
+;;; null environment. If Form is NIL, just return NIL.
 (defun coerce-form (form loc)
   (when form
     (let ((exp (car form)))
             (trace-info-what info)))))
 
 ;;; This function discards any invalid cookies on our simulated stack.
-;;; Encapsulated entries are always valid, since we bind *traced-entries* in
-;;; the encapsulation.
+;;; Encapsulated entries are always valid, since we bind
+;;; *TRACED-ENTRIES* in the encapsulation.
 (defun discard-invalid-entries (frame)
   (loop
     (when (or (null *traced-entries*)
 \f
 ;;;; 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 FUNCTION-END-COOKIE
-;;; function. The first communicates the sense of the Condition to the second
-;;; via a closure variable.
+;;; Return a closure that can be used for a function start breakpoint
+;;; hook function and a closure that can be used as the
+;;; FUNCTION-END-COOKIE function. The first communicates the sense of
+;;; the Condition to the second via a closure variable.
 (defun trace-start-breakpoint-fun (info)
   (let (conditionp)
     (values
 
 ;;; This prints a representation of the return values delivered.
 ;;; First, this checks to see that cookie is at the top of
-;;; *traced-entries*; if it is not, then we need to adjust this list
+;;; *TRACED-ENTRIES*; if it is not, then we need to adjust this list
 ;;; to determine the correct indentation for output. We then check to
 ;;; see whether the function is still traced and that the condition
 ;;; succeeded before printing anything.
          (values-list vals))))))
 \f
 ;;; Trace one function according to the specified options. We copy the
-;;; trace info (it was a quoted constant), fill in the functions, and then
-;;; install the breakpoints or encapsulation.
+;;; trace info (it was a quoted constant), fill in the functions, and
+;;; then install the breakpoints or encapsulation.
 ;;;
-;;; If non-null, Definition is the new definition of a function that we are
-;;; automatically retracing.
+;;; If non-null, DEFINITION is the new definition of a function that
+;;; we are automatically retracing.
 (defun trace-1 (function-or-name info &optional definition)
   (multiple-value-bind (fun named kind)
       (if definition
                  (nth-value 2 (trace-fdefinition definition)))
          (trace-fdefinition function-or-name))
     (when (gethash fun *traced-functions*)
-      ;; FIXME: should be STYLE-WARNING
-      (warn "Function ~S is already TRACE'd, retracing it." function-or-name)
+      (warn "~S is already TRACE'd, untracing it." function-or-name)
       (untrace-1 fun))
 
     (let* ((debug-fun (sb-di:function-debug-function fun))
        (unless named
          (error "can't use encapsulation to trace anonymous function ~S"
                 fun))
-       (sb-int:encapsulate function-or-name 'trace `(trace-call ',info)))
+       (encapsulate function-or-name 'trace `(trace-call ',info)))
        (t
        (multiple-value-bind (start-fun cookie-fun)
            (trace-start-breakpoint-fun info)
                      :function-end-cookie cookie-fun)))
            (setf (trace-info-start-breakpoint info) start)
            (setf (trace-info-end-breakpoint info) end)
-           ;; The next two forms must be in the order in which they appear,
-           ;; since the start breakpoint must run before the function-end
-           ;; breakpoint's start helper (which calls the cookie function.)
-           ;; One reason is that cookie function requires that the CONDITIONP
-           ;; shared closure variable be initialized.
+           ;; The next two forms must be in the order in which they
+           ;; appear, since the start breakpoint must run before the
+           ;; function-end breakpoint's start helper (which calls the
+           ;; cookie function.) One reason is that cookie function
+           ;; requires that the CONDITIONP shared closure variable be
+           ;; initialized.
            (sb-di:activate-breakpoint start)
            (sb-di:activate-breakpoint end)))))
 
 \f
 ;;;; the TRACE macro
 
-;;; Parse leading trace options off of SPECS, modifying INFO accordingly. The
-;;; remaining portion of the list is returned when we encounter a plausible
-;;; function name.
+;;; Parse leading trace options off of SPECS, modifying INFO
+;;; accordingly. The remaining portion of the list is returned when we
+;;; encounter a plausible function name.
 (defun parse-trace-options (specs info)
   (let ((current specs))
     (loop
     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.) If there are no :FUNCTION specs, then don't use a LET.
+;;; This allows TRACE to be used without the full interpreter.
 (defun expand-trace (specs)
   (collect ((binds)
            (forms))
      (t
       (cond
        ((trace-info-encapsulated info)
-       (sb-int:unencapsulate (trace-info-what info) 'trace))
+       (unencapsulate (trace-info-what info) 'trace))
        (t
        (sb-di:delete-breakpoint (trace-info-start-breakpoint info))
        (sb-di:delete-breakpoint (trace-info-end-breakpoint info))))