/[cmucl]/src/code/ntrace.lisp
ViewVC logotype

Diff of /src/code/ntrace.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.43.12.1 by rtoy, Mon Feb 8 17:15:48 2010 UTC revision 1.43.12.2 by rtoy, Tue Feb 9 23:42:32 2010 UTC
# Line 28  Line 28 
28  (use-package :fwrappers)  (use-package :fwrappers)
29    
30  (defvar *trace-values* nil  (defvar *trace-values* nil
31    "This is bound to the returned values when evaluating :BREAK-AFTER and    _N"This is bound to the returned values when evaluating :BREAK-AFTER and
32     :PRINT-AFTER forms.")     :PRINT-AFTER forms.")
33    
34  (defvar *max-trace-indentation* 40  (defvar *max-trace-indentation* 40
35    "If the trace indentation exceeds this value, then indentation restarts at    _N"If the trace indentation exceeds this value, then indentation restarts at
36     0.")     0.")
37    
38  (defvar *trace-encapsulate-default* :default  (defvar *trace-encapsulate-default* :default
39    "The default value for the :ENCAPSULATE option to trace.")    _N"The default value for the :ENCAPSULATE option to trace.")
40    
41  (defvar *trace-encapsulate-package-names*  (defvar *trace-encapsulate-package-names*
42    '("LISP"    '("LISP"
# Line 51  Line 51 
51      "SYSTEM"      "SYSTEM"
52      "COMPILER"      "COMPILER"
53      "TRACE")      "TRACE")
54    "List of package names.  Encapsulate functions from these packages    _N"List of package names.  Encapsulate functions from these packages
55     by default.  This should at least include the packages of functions     by default.  This should at least include the packages of functions
56     used by TRACE, directly or indirectly.")     used by TRACE, directly or indirectly.")
57    
# Line 163  Line 163 
163        (typecase x        (typecase x
164          (symbol          (symbol
165           (cond ((special-operator-p x)           (cond ((special-operator-p x)
166                  (error "Can't trace special form ~S." x))                  (error _"Can't trace special form ~S." x))
167                 ((macro-function x))                 ((macro-function x))
168                 (t                 (t
169                  (values (fdefinition x) t))))                  (values (fdefinition x) t))))
# Line 302  Line 302 
302    (when (and break (funcall (cdr break) frame))    (when (and break (funcall (cdr break) frame))
303      (di:flush-frames-above frame)      (di:flush-frames-above frame)
304      (let ((*stack-top-hint* frame))      (let ((*stack-top-hint* frame))
305        (break "Breaking ~A traced call to ~S:" where        (break _"Breaking ~A traced call to ~S:" where
306               (trace-info-what info)))))               (trace-info-what info)))))
307    
308  ;;; DISCARD-INVALID-ENTRIES  --  Internal  ;;; DISCARD-INVALID-ENTRIES  --  Internal
# Line 398  Line 398 
398              (pprint-logical-block (*standard-output* nil)              (pprint-logical-block (*standard-output* nil)
399                (print-trace-indentation)                (print-trace-indentation)
400                (pprint-indent :current 2)                (pprint-indent :current 2)
401                (format t "~S returned" (trace-info-what info))                (format t _"~S returned" (trace-info-what info))
402                (dolist (v *trace-values*)                (dolist (v *trace-values*)
403                  (write-char #\space)                  (write-char #\space)
404                  (pprint-newline :linear)                  (pprint-newline :linear)
# Line 458  Line 458 
458                      (nth-value 2 (trace-fdefinition definition))))                      (nth-value 2 (trace-fdefinition definition))))
459            (trace-fdefinition function-or-name))            (trace-fdefinition function-or-name))
460      (when (gethash (or local fun) *traced-functions*)      (when (gethash (or local fun) *traced-functions*)
461        (warn "Function ~S already TRACE'd, retracing it." function-or-name)        (warn _"Function ~S already TRACE'd, retracing it." function-or-name)
462        (untrace-1 fun))        (untrace-1 fun))
463    
464      (let* ((debug-fun (di:function-debug-function fun :local-name local))      (let* ((debug-fun (di:function-debug-function fun :local-name local))
# Line 472  Line 472 
472                       encapsulate-p)                       encapsulate-p)
473                      (:compiled-closure                      (:compiled-closure
474                       (unless (functionp function-or-name)                       (unless (functionp function-or-name)
475                         (warn "Tracing shared code for ~S:~%  ~S"                         (warn _"Tracing shared code for ~S:~%  ~S"
476                               function-or-name fun))                               function-or-name fun))
477                       encapsulate-p)                       encapsulate-p)
478                      ((:interpreted :interpreted-closure                      ((:interpreted :interpreted-closure
# Line 504  Line 504 
504                     (declare (ignore validp))                     (declare (ignore validp))
505                     (unless (or (stringp block-name)                     (unless (or (stringp block-name)
506                                 (fboundp block-name))                                 (fboundp block-name))
507                       (warn "~S name is not a defined global function: ~S"                       (warn _"~S name is not a defined global function: ~S"
508                             type wherein))))))                             type wherein))))))
509          (verify-wherein (trace-info-wherein info) :wherein)          (verify-wherein (trace-info-wherein info) :wherein)
510          (verify-wherein (trace-info-wherein-only info) :wherein-only))          (verify-wherein (trace-info-wherein-only info) :wherein-only))
# Line 513  Line 513 
513        (cond        (cond
514         (encapsulated         (encapsulated
515          (unless named          (unless named
516            (error "Can't use encapsulation to trace anonymous function ~S."            (error _"Can't use encapsulation to trace anonymous function ~S."
517                   fun))                   fun))
518          (when (listp fun)          (when (listp fun)
519            (error "Can't use encapsulation to trace local flet/labels function ~S."            (error _"Can't use encapsulation to trace local flet/labels function ~S."
520                   fun))                   fun))
521          (fwrap function-or-name #'trace-fwrapper :type 'trace          (fwrap function-or-name #'trace-fwrapper :type 'trace
522                 :user-data info))                 :user-data info))
# Line 626  Line 626 
626               (t (return)))               (t (return)))
627             (pop current)             (pop current)
628             (unless current             (unless current
629               (error "Missing argument to ~S TRACE option." option))               (error _"Missing argument to ~S TRACE option." option))
630             (pop current)))             (pop current)))
631        current)))        current)))
632    
# Line 661  Line 661 
661                            (trace-1 name ',options))))))                            (trace-1 name ',options))))))
662             ((and (keywordp name)             ((and (keywordp name)
663                   (not (or (fboundp name) (macro-function name))))                   (not (or (fboundp name) (macro-function name))))
664              (error "Unknown TRACE option: ~S" name))              (error _"Unknown TRACE option: ~S" name))
665             ;;             ;;
666             ;; Method name -> trace method functions.             ;; Method name -> trace method functions.
667             ((and (consp name) (eq (car name) 'method))             ((and (consp name) (eq (car name) 'method))
# Line 689  Line 689 
689  ;;; TRACE -- Public.  ;;; TRACE -- Public.
690  ;;;  ;;;
691  (defmacro trace (&rest specs)  (defmacro trace (&rest specs)
692    "TRACE {Option Global-Value}* {Name {Option Value}*}*    _N"TRACE {Option Global-Value}* {Name {Option Value}*}*
693     TRACE is a debugging tool that prints information when specified functions     TRACE is a debugging tool that prints information when specified functions
694     are called.  In its simplest form:     are called.  In its simplest form:
695         (trace Name-1 Name-2 ...)         (trace Name-1 Name-2 ...)
# Line 786  Line 786 
786      (let* ((key (or local fun))      (let* ((key (or local fun))
787             (info (gethash key *traced-functions*)))             (info (gethash key *traced-functions*)))
788        (cond ((not info)        (cond ((not info)
789               (warn "Function is not TRACE'd -- ~S." function-or-name))               (warn _"Function is not TRACE'd -- ~S." function-or-name))
790              (t              (t
791               (cond ((trace-info-encapsulated info)               (cond ((trace-info-encapsulated info)
792                      (funwrap (trace-info-what info) :type 'trace))                      (funwrap (trace-info-what info) :type 'trace))
# Line 806  Line 806 
806    t)    t)
807    
808  (defmacro untrace (&rest specs)  (defmacro untrace (&rest specs)
809    "Removes tracing from the specified functions.  With no args, untraces all    _N"Removes tracing from the specified functions.  With no args, untraces all
810     functions."     functions."
811    (if specs    (if specs
812        (collect ((res))        (collect ((res))

Legend:
Removed from v.1.43.12.1  
changed lines
  Added in v.1.43.12.2

  ViewVC Help
Powered by ViewVC 1.1.5