1.0.11.24: internal hash-table usage thread-safety, part 2

[sbcl.git] / src / code / ntrace.lisp

diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp
index ded1ab7..c9cca4d 100644 (file)
--- a/src/code/ntrace.lisp
+++ b/src/code/ntrace.lisp
@@ -37,7 +37,7 @@
 
 ;;; 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-funs* (make-hash-table :test 'eq))
+(defvar *traced-funs* (make-hash-table :test 'eq :synchronized t))
 
 ;;; A TRACE-INFO object represents all the information we need to
 ;;; trace a given function.
@@ -265,12 +265,14 @@
                ;; with DEFVAR.
                (locally
                  (declare (special basic-definition arg-list))
-                 (prin1 `(,(trace-info-what info) ,@arg-list)))
+                 (prin1 `(,(trace-info-what info)
+                          ,@(mapcar #'ensure-printable-object arg-list))))
                (print-frame-call frame *standard-output*))
            (terpri)
            (trace-print frame (trace-info-print info))
            (write-sequence (get-output-stream-string *standard-output*)
-                           *trace-output*))
+                           *trace-output*)
+           (finish-output *trace-output*))
          (trace-maybe-break info (trace-info-break info) "before" frame)))
 
      (lambda (frame cookie)
@@ -300,18 +302,20 @@
               (*standard-output* (make-string-output-stream))
               (*in-trace* t))
           (fresh-line)
-          (pprint-logical-block (*standard-output* nil)
-            (print-trace-indentation)
-            (pprint-indent :current 2)
-            (format t "~S returned" (trace-info-what info))
-            (dolist (v *trace-values*)
-              (write-char #\space)
-              (pprint-newline :linear)
-              (prin1 v)))
-          (terpri)
+          (let ((*print-pretty* t))
+            (pprint-logical-block (*standard-output* nil)
+              (print-trace-indentation)
+              (pprint-indent :current 2)
+              (format t "~S returned" (trace-info-what info))
+              (dolist (v *trace-values*)
+                (write-char #\space)
+                (pprint-newline :linear)
+                (prin1 (ensure-printable-object v))))
+            (terpri))
           (trace-print frame (trace-info-print-after info))
           (write-sequence (get-output-stream-string *standard-output*)
-                          *trace-output*))
+                          *trace-output*)
+          (finish-output *trace-output*))
         (trace-maybe-break info
                            (trace-info-break-after info)
                            "after"
@@ -417,21 +421,23 @@
       (setf (gethash fun *traced-funs*) info))
 
     (when (and (typep fun 'generic-function)
-               (trace-info-methods info))
-      (dolist (method-name (sb-pcl::list-all-maybe-method-names fun))
-        (when (fboundp method-name)
+               (trace-info-methods info)
+               ;; we are going to trace the method functions directly.
+               (not (trace-info-encapsulated info)))
+      (dolist (method (sb-mop:generic-function-methods fun))
+        (let ((mf (sb-mop:method-function method)))
           ;; NOTE: this direct style of tracing methods -- tracing the
           ;; pcl-internal method functions -- is only one possible
           ;; alternative.  It fails (a) when encapulation is
           ;; requested, because the function objects themselves are
           ;; stored in the method object; (b) when the method in
           ;; question is particularly simple, when the method
-          ;; functionality is in the dfun.  There is an alternative
-          ;; technique: to replace any currently active methods with
-          ;; methods which encapsulate the current one.  Steps towards
-          ;; this are currently commented out in src/pcl/env.lisp.  --
-          ;; CSR, 2005-01-03
-          (trace-1 method-name info)))))
+          ;; functionality is in the dfun.  See src/pcl/env.lisp for a
+          ;; stub implementation of encapsulating through a
+          ;; traced-method class.
+          (trace-1 mf info)
+          (when (typep mf 'sb-pcl::%method-function)
+            (trace-1 (sb-pcl::%method-function-fast-function mf) info))))))
 
   function-or-name)
 \f