[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: sb-sprof: Simplify wallclock profiling if #+sb-thread
From:       Douglas Katzman via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2021-01-12 16:39:21
Message-ID: 1610469562.225938.14939 () sfp-scm-1 ! v30 ! lw ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  e976fefc2a166dc56b9b9c1d29a8773f0b81fe8d (commit)
      from  af2023c0ce0f657e91ff2ea8c7262e937c2cac8b (commit)

- Log -----------------------------------------------------------------
commit e976fefc2a166dc56b9b9c1d29a8773f0b81fe8d
Author: Douglas Katzman <dougk@google.com>
Date:   Tue Jan 12 10:13:30 2021 -0500

    sb-sprof: Simplify wallclock profiling if #+sb-thread
    
    * No need for a signal handler that runs in a "any" thread, and uses a lock to
      avoid multiple invocations. Just have the timer thread sleep between samples.
    
    * No need for an instance of SB-EXT:TIMER either.
    
    * Implement looping over all threads in a non-consing way.
    
    * Remove SAMPLES-{START,END}-TIME while we're at it.
---
 contrib/sb-sprof/interface.lisp | 63 +++++++++++++++++++++++++----------------
 contrib/sb-sprof/record.lisp    | 46 ++++--------------------------
 2 files changed, 45 insertions(+), 64 deletions(-)

diff --git a/contrib/sb-sprof/interface.lisp b/contrib/sb-sprof/interface.lisp
index ff71aa3b3..c76b5d5c8 100644
--- a/contrib/sb-sprof/interface.lisp
+++ b/contrib/sb-sprof/interface.lisp
@@ -127,8 +127,6 @@ The following keyword args are recognized:
            (stop-profiling)))
        ,@(when report-p `((report :type ,report))))))
 
-(defvar *timer* nil)
-
 #-win32
 (defun start-profiling (&key (max-samples *max-samples*)
                         (mode *sampling-mode*)
@@ -185,8 +183,7 @@ The following keyword args are recognized:
             (truncate sample-interval)
           (values secs (truncate (* rest 1000000))))
       (setf *sampling* sampling
-            *samples* (make-samples :start-time (get-internal-real-time)
-                                    :max-depth max-depth
+            *samples* (make-samples :max-depth max-depth
                                     :max-samples max-samples
                                     :sample-interval sample-interval
                                     :alloc-interval alloc-interval
@@ -195,7 +192,18 @@ The following keyword args are recognized:
       (setf *profiled-threads* threads)
       (sb-sys:enable-interrupt sb-unix:sigprof
                                #'sigprof-handler)
-      (ecase mode
+      (flet (#+sb-thread
+             (map-threads (function &aux (threads *profiled-threads*))
+               (if (listp threads)
+                   (mapc function threads)
+                   (named-let visit ((node sb-thread::*all-threads*))
+                     (awhen (sb-thread::avlnode-left node) (visit it))
+                     (awhen (sb-thread::avlnode-right node) (visit it))
+                     (let ((thread (sb-thread::avlnode-data node)))
+                       (when (and (= (sb-thread::thread-%visible thread) 1)
+                                  (neq thread *timer*))
+                         (funcall function thread)))))))
+       (ecase mode
         (:alloc
          (let ((alloc-signal (1- alloc-interval)))
            #+sb-thread
@@ -208,27 +216,32 @@ The following keyword args are recognized:
                (progn
                  (setf sb-thread::*default-alloc-signal* alloc-signal)))
              ;; Turn on allocation profiling in existing threads.
-             (dolist (thread (profiled-threads))
-               (sb-thread::%set-symbol-value-in-thread 'sb-vm::*alloc-signal* thread alloc-signal)))
+             (map-threads
+              (lambda (thread)
+                (sb-thread::%set-symbol-value-in-thread 'sb-vm::*alloc-signal* thread alloc-signal))))
            #-sb-thread
            (setf sb-vm:*alloc-signal* alloc-signal)))
         (:cpu
          (unix-setitimer :profile secs usecs secs usecs))
         (:time
          #+sb-thread
-         (let ((setup (sb-thread:make-semaphore :name "Timer thread setup semaphore")))
-           (setf *timer-thread*
-                 (sb-thread:make-thread (lambda ()
-                                          (sb-thread:wait-on-semaphore setup)
-                                          (loop while (eq sb-thread:*current-thread* *timer-thread*)
-                                                do (sleep 1.0)))
-                                        :name "SB-SPROF wallclock timer thread"))
-           (sb-thread:signal-semaphore setup))
+         (sb-thread::start-thread
+          (setf *timer* (sb-thread::%make-thread "SPROF timer" nil (sb-thread:make-semaphore)))
+          (lambda ()
+            (loop (unless *timer* (return))
+                  (sleep sample-interval)
+                  (map-threads
+                   (lambda (thread)
+                     (sb-thread:with-deathlok (thread c-thread)
+                       (unless (= c-thread 0)
+                         (sb-thread:pthread-kill (sb-thread::thread-os-thread thread)
+                                                 sb-unix:sigprof)))))))
+          nil)
          #-sb-thread
-         (setf *timer-thread* nil)
-         (setf *timer* (make-timer #'thread-distribution-handler :name "SB-PROF wallclock timer"
-                                   :thread *timer-thread*))
-         (schedule-timer *timer* sample-interval :repeat-interval sample-interval)))
+         (schedule-timer
+          (setf *timer* (make-timer (lambda () (unix-kill 0 sb-unix:sigprof))
+                                    :name "SPROF timer"))
+          sample-interval :repeat-interval sample-interval))))
       (setq *profiling* mode)))
   (values))
 
@@ -248,14 +261,16 @@ The following keyword args are recognized:
         (:cpu
          (unix-setitimer :profile 0 0 0 0))
         (:time
-         (unschedule-timer *timer*)
-         (setf *timer* nil
-               *timer-thread* nil)))
+         (let ((timer *timer*))
+           ;; after this assignment, the timer thread will raise the
+           ;; profiling signal at most once more, and then stop.
+           (setf *timer* nil)
+           #-sb-thread (unschedule-timer timer)
+           #+sb-thread (sb-thread:join-thread timer))))
      (disable-call-counting)
      (setf *profiling* nil
            *sampling* nil
-           *profiled-threads* nil)
-     (setf (samples-end-time *samples*) (get-internal-real-time))))
+           *profiled-threads* nil)))
   (values))
 
 (defun reset ()
diff --git a/contrib/sb-sprof/record.lisp b/contrib/sb-sprof/record.lisp
index 97cc6b37c..2e0901cd1 100644
--- a/contrib/sb-sprof/record.lisp
+++ b/contrib/sb-sprof/record.lisp
@@ -34,8 +34,7 @@
 ;;; Encapsulate all the information about a sampling run
 (defstruct (samples
              (:constructor
-              make-samples (&key start-time
-                                 mode sample-interval alloc-interval
+              make-samples (&key mode sample-interval alloc-interval
                                  max-depth max-samples
                             &aux (vector (make-sample-vector max-samples)))))
   ;; When this vector fills up, we allocate a new one and copy over
@@ -59,9 +58,6 @@
   (sampled-threads nil                  :type list)
 
   ;; Metadata
-  (start-time      (sb-int:missing-arg) :type sb-kernel:internal-time    :read-only t)
-  (end-time        nil                  :type (or null sb-kernel:internal-time))
-
   (mode            nil                  :type sampling-mode              :read-only t)
   (sample-interval (sb-int:missing-arg) :type (real (0))                 :read-only t)
   (alloc-interval  (sb-int:missing-arg) :type (integer (0))              :read-only t)
@@ -283,48 +279,18 @@ EXPERIMENTAL: Interface subject to change."
 (defvar *profiled-threads* nil)
 (declaim (type (or list (member :all)) *profiled-threads*))
 
-;;; Thread which runs the wallclock timers, if any.
-(defvar *timer-thread* nil)
-
-(defun profiled-threads ()
-  (let ((profiled-threads *profiled-threads*))
-    (remove *timer-thread*
-            (if (eq :all profiled-threads)
-                ;; FIXME: inefficient, probably memoize on a best-effort basis:
-                ;;  detect whether the tree has changed, and recompute only if it did.
-                (sb-thread:list-all-threads)
-                profiled-threads))))
+;;; In wallclock mode, *TIMER* is an instance of either SB-THREAD:THREAD
+;;; or SB-EXT:TIMER depending on whether thread support exists.
+(defglobal *timer* nil)
 
 (defun profiled-thread-p (thread)
   (let ((profiled-threads *profiled-threads*))
-    (or (and (eq :all profiled-threads)
-             (not (eq *timer-thread* thread)))
-        (member thread profiled-threads :test #'eq))))
+    (if (listp profiled-threads) (memq thread profiled-threads) (neq *timer* thread))))
 
 #+(and (or x86 x86-64) (not win32))
 (progn
   ;; Ensure that only one thread at a time will be doing profiling stuff.
-  (defvar *profiler-lock* (sb-thread:make-mutex :name "Statistical Profiler"))
-  (defvar *distribution-lock* (sb-thread:make-mutex :name "Wallclock profiling lock"))
-
-  ;;; A random thread will call this in response to either a timer firing,
-  ;;; This in turn will distribute the notice to those threads we are
-  ;;; interested using SIGPROF.
-  (defun thread-distribution-handler ()
-    (declare (optimize speed (space 0)))
-    #+sb-thread
-    (let ((lock *distribution-lock*))
-      ;; Don't flood the system with more interrupts if the last
-      ;; set is still being delivered.
-      (unless (sb-thread:mutex-owner lock)
-        (with-system-mutex (lock)
-          (dolist (thread (profiled-threads))
-            (sb-thread:with-deathlok (thread c-thread)
-              (unless (= c-thread 0)
-                (sb-thread:pthread-kill (sb-thread::thread-os-thread thread)
-                                        sb-unix:sigprof)))))))
-    #-sb-thread
-    (unix-kill 0 sb-unix:sigprof))
+  (defglobal *profiler-lock* (sb-thread:make-mutex :name "Statistical Profiler"))
 
   (defun sigprof-handler (signal code scp)
     (declare (ignore signal code) (optimize speed)

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL


_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread] 

Configure | About | News | Add a list | Sponsored by KoreLogic