Skip to content
Snippets Groups Projects
Commit 58cc0d92 authored by wlott's avatar wlott
Browse files

Added pretty-printer directives so that arg lists and results print better.

[From Rob:] Fixed untrace-1 not to flame out when untracing untraced
functions.
parent 5686b79b
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ntrace.lisp,v 1.9 1992/07/10 17:46:06 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ntrace.lisp,v 1.10 1992/12/08 20:10:16 wlott Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -219,7 +219,7 @@ ...@@ -219,7 +219,7 @@
(let ((depth 0)) (let ((depth 0))
(dolist (entry *traced-entries*) (dolist (entry *traced-entries*)
(when (cdr entry) (incf depth))) (when (cdr entry) (incf depth)))
(format t "~&~VT~D: " (format t "~@V,0T~D: "
(+ (mod (* depth 2) (- *max-trace-indentation* 2)) 2) (+ (mod (* depth 2) (- *max-trace-indentation* 2)) 2)
depth))) depth)))
...@@ -299,6 +299,7 @@ ...@@ -299,6 +299,7 @@
(when conditionp (when conditionp
(let ((*print-length* (or *debug-print-length* *print-length*)) (let ((*print-length* (or *debug-print-length* *print-length*))
(*print-level* (or *debug-print-level* *print-level*)) (*print-level* (or *debug-print-level* *print-level*))
(kernel:*current-level* 0)
(*standard-output* *trace-output*) (*standard-output* *trace-output*)
(*in-trace* t)) (*in-trace* t))
(fresh-line) (fresh-line)
...@@ -338,15 +339,20 @@ ...@@ -338,15 +339,20 @@
(and cond (funcall (cdr cond) frame))))) (and cond (funcall (cdr cond) frame)))))
(let ((*print-length* (or *debug-print-length* *print-length*)) (let ((*print-length* (or *debug-print-length* *print-length*))
(*print-level* (or *debug-print-level* *print-level*)) (*print-level* (or *debug-print-level* *print-level*))
(kernel:*current-level* 0)
(*standard-output* *trace-output*) (*standard-output* *trace-output*)
(*in-trace* t)) (*in-trace* t))
(print-trace-indentation) (fresh-line)
(format t "~S returned " (trace-info-what info)) (pprint-logical-block (*standard-output* nil)
(dolist (v *trace-values*) (print-trace-indentation)
(prin1 v) (pprint-indent :current 2)
(write-char #\space)) (format t "~S returned" (trace-info-what info))
(trace-print frame (trace-info-print-after info)) (dolist (v *trace-values*)
(terpri)) (write-char #\space)
(pprint-newline :linear)
(prin1 v)))
(terpri)
(trace-print frame (trace-info-print-after info)))
(trace-maybe-break info (trace-info-break-after info) (trace-maybe-break info (trace-info-break-after info)
"after" frame))))) "after" frame)))))
...@@ -633,13 +639,15 @@ ...@@ -633,13 +639,15 @@
(info (gethash fun *traced-functions*))) (info (gethash fun *traced-functions*)))
(cond (cond
((not info) (warn "Function is not TRACE'd -- ~S." function-or-name)) ((not info) (warn "Function is not TRACE'd -- ~S." function-or-name))
((trace-info-encapsulated info)
(ext:unencapsulate (trace-info-what info) 'trace))
(t (t
(di:delete-breakpoint (trace-info-start-breakpoint info)) (cond
(di:delete-breakpoint (trace-info-end-breakpoint info)))) ((trace-info-encapsulated info)
(setf (trace-info-untraced info) t) (ext:unencapsulate (trace-info-what info) 'trace))
(remhash fun *traced-functions*))) (t
(di:delete-breakpoint (trace-info-start-breakpoint info))
(di:delete-breakpoint (trace-info-end-breakpoint info))))
(setf (trace-info-untraced info) t)
(remhash fun *traced-functions*)))))
;;; UNTRACE-ALL -- Internal ;;; UNTRACE-ALL -- Internal
;;; ;;;
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment