X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fntrace.lisp;h=609be520ff2cb33432657b631b4223e0b0ea25ec;hb=aab24d77d0eeafb6880dce4420d3f422ef7a0971;hp=d4e2158ff3341a741a8a9b63aa9d0d457d9ae032;hpb=d40a76606c86722b0aef8179155f9f2840739b72;p=sbcl.git

diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp
index d4e2158..609be52 100644
--- a/src/code/ntrace.lisp
+++ b/src/code/ntrace.lisp
@@ -29,14 +29,14 @@
   "If the trace indentation exceeds this value, then indentation restarts at
    0.")
 
-(defvar *trace-encapsulate-default* :default
+(defvar *trace-encapsulate-default* t
   #+sb-doc
   "the default value for the :ENCAPSULATE option to TRACE")
 
 ;;;; 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.
+;;; entry for a closure is the shared function entry object.
 (defvar *traced-funs* (make-hash-table :test 'eq))
 
 ;;; A TRACE-INFO object represents all the information we need to
@@ -154,6 +154,7 @@
     (let ((exp (car form)))
       (if (sb-di:code-location-p loc)
 	  (let ((fun (sb-di:preprocess-for-eval exp loc)))
+            (declare (type function fun))
 	    (cons exp
 		  (lambda (frame)
 		    (let ((*current-frame* frame))
@@ -162,8 +163,8 @@
 			((nil) exp)
 			(:encapsulated
 			 `(flet ((sb-debug:arg (n)
-				   (declare (special argument-list))
-				   (elt argument-list n)))
+				   (declare (special arg-list))
+				   (elt arg-list n)))
 			    (declare (ignorable #'sb-debug:arg))
 			    ,exp))))
 		 (fun (coerce `(lambda () ,bod) 'function)))
@@ -183,7 +184,7 @@
     (dolist (entry *traced-entries*)
       (when (cdr entry) (incf depth)))
     (format t
-	    "~@V,0T~W: "
+	    "~V,0@T~W: "
 	    (+ (mod (* depth *trace-indentation-step*)
 		    (- *max-trace-indentation* *trace-indentation-step*))
 	       *trace-indentation-step*)
@@ -248,17 +249,23 @@
 		    (or (not wherein)
 			(trace-wherein-p frame wherein)))))
        (when conditionp
-	 (let ((sb-kernel:*current-level* 0)
-	       (*standard-output* *trace-output*)
+	 (let ((sb-kernel:*current-level-in-print* 0)
+	       (*standard-output* (make-string-output-stream))
 	       (*in-trace* t))
 	   (fresh-line)
 	   (print-trace-indentation)
 	   (if (trace-info-encapsulated info)
-	       (locally (declare (special basic-definition argument-list))
-			(prin1 `(,(trace-info-what info) ,@argument-list)))
+	       ;; FIXME: These special variables should be given
+	       ;; *FOO*-style names, and probably declared globally
+	       ;; with DEFVAR.
+	       (locally
+		 (declare (special basic-definition arg-list))
+		 (prin1 `(,(trace-info-what info) ,@arg-list)))
 	       (print-frame-call frame))
 	   (terpri)
-	   (trace-print frame (trace-info-print info)))
+	   (trace-print frame (trace-info-print info))
+	   (write-sequence (get-output-stream-string *standard-output*)
+			   *trace-output*))
 	 (trace-maybe-break info (trace-info-break info) "before" frame)))
 
      (lambda (frame cookie)
@@ -271,6 +278,7 @@
 ;;; 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.
+(declaim (ftype (function (trace-info) function) trace-end-breakpoint-fun))
 (defun trace-end-breakpoint-fun (info)
   (lambda (frame bpt *trace-values* cookie)
     (declare (ignore bpt))
@@ -283,8 +291,8 @@
 		 (or (cdr entry)
 		     (let ((cond (trace-info-condition-after info)))
 		       (and cond (funcall (cdr cond) frame)))))
-	(let ((sb-kernel:*current-level* 0)
-	      (*standard-output* *trace-output*)
+	(let ((sb-kernel:*current-level-in-print* 0)
+	      (*standard-output* (make-string-output-stream))
 	      (*in-trace* t))
 	  (fresh-line)
 	  (pprint-logical-block (*standard-output* nil)
@@ -296,7 +304,9 @@
 	      (pprint-newline :linear)
 	      (prin1 v)))
 	  (terpri)
-	  (trace-print frame (trace-info-print-after info)))
+	  (trace-print frame (trace-info-print-after info))
+	  (write-sequence (get-output-stream-string *standard-output*)
+			  *trace-output*))
 	(trace-maybe-break info
 			   (trace-info-break-after info)
 			   "after"
@@ -307,14 +317,15 @@
 ;;; which we have cleverly contrived to work for our hook functions.
 (defun trace-call (info)
   (multiple-value-bind (start cookie) (trace-start-breakpoint-fun info)
+    (declare (type function start cookie))
     (let ((frame (sb-di:frame-down (sb-di:top-frame))))
       (funcall start frame nil)
       (let ((*traced-entries* *traced-entries*))
-	(declare (special basic-definition argument-list))
+	(declare (special basic-definition arg-list))
 	(funcall cookie frame nil)
 	(let ((vals
 	       (multiple-value-list
-		(apply basic-definition argument-list))))
+		(apply basic-definition arg-list))))
 	  (funcall (trace-end-breakpoint-fun info) frame nil vals nil)
 	  (values-list vals))))))