Changeset 9168


Ignore:
Timestamp:
Apr 16, 2008, 12:47:17 PM (11 years ago)
Author:
gb
Message:

Getting closer to actually working, at least on ppc32/ppc64.
With the -b option, receipt of SIGUSR1 toggles sampling; when it's toggled
from on to off, a session file is (generally) produced.
There -may- be a race condition (hard to reproduce) whereby a SIGUSR1
sent too soon after shark announces that it's 'ready' is dropped.
Try to read process output via a pipe, to determine (a) when a newly-created
shark process announces that it's ready and (b) to pick up the name of
any session file created after sampling's toggled off.
In all modes (certainly including -b/batch), SIGUSR2 toggles sampling off
and causes the shark process to exit. Use a (simple) status-hook function
to detect cases where the shark process dies, which is (a) better than not
noticing or (b) polling for the process' status all the time.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/library/chud-metering.lisp

    r9162 r9168  
    3737
    3838(defparameter *shark-session-path* nil)
     39
     40(defloadvar *written-spatch-file* nil)
    3941
    4042(defparameter *shark-session-native-namestring* nil)
     
    6567             (native-name (ccl::native-untranslated-namestring dir)))
    6668        (ensure-directories-exist dir)
    67         (finder-open-file native-name)
    6869        (setenv "SHARK_SEARCH_PATH_PATCH_FILES" native-name)
    6970        (setq *shark-session-native-namestring*
     
    185186        (dotimes (i (length functions))
    186187          (print-shark-spatch-record (svref functions i) f))
    187         (format f "!SHARK_SPATCH_END~%"))) t))
     188        (format f "!SHARK_SPATCH_END~%")))
     189    (setq *written-spatch-file* t)
     190    t))
    188191
    189192(defun terminate-shark-process ()
     
    196199  (if *shark-process*
    197200    (progn
    198       (signal-external-process *shark-process* (if *sampling* #$SIGUSR2 #$SIGUSR1))
     201      (signal-external-process *shark-process* #$SIGUSR1)
    199202      (setq *sampling* (not *sampling*)))
    200203    (warn "No active shark procsss")))
     
    206209  (when *sampling* (toggle-sampling)))
    207210
    208 (defun ensure-shark-process (reset)
     211(defun ensure-shark-process (reset hook)
    209212  (when (or (null *shark-process*) reset)
    210213    (terminate-shark-process)
    211     (generate-shark-spatch-file)
    212     (let* ((args (list "-b" "-r" "-a" (format nil "~d" (ccl::getpid))
     214    (when (or reset (not *written-spatch-file*))
     215      (generate-shark-spatch-file))
     216    (let* ((args (list "-b" "-1" "-a" (format nil "~d" (ccl::getpid))
    213217                             "-d" *shark-session-native-namestring*)))
    214218      (when *shark-config-file*
     
    219223            (run-program "/usr/bin/shark"
    220224                         args
    221                          :output t
     225                         :output :stream
     226                         :status-hook hook
    222227                         :wait nil))
    223       (sleep 5))))
     228      (let* ((output (external-process-output-stream *shark-process*)))
     229        (do* ((line (read-line output nil nil) (read-line output nil nil)))
     230             ((null line))
     231          (when (search "ready." line :key #'char-downcase)
     232            (return)))))))
     233
     234(defun display-shark-session-file (line)
     235  (let* ((last-quote (position #\' line :from-end t))
     236         (first-quote (and last-quote (position #\' line :end (1- last-quote) :from-end t)))
     237         (path (and first-quote  (subseq line (1+ first-quote) last-quote))))
     238    (when path (finder-open-file path))))
     239   
     240(defun scan-shark-process-output (p)
     241  (with-interrupts-enabled
     242      (let* ((out (ccl::external-process-output p)))
     243        (do* ((line (read-line out nil nil) (read-line out nil nil)))
     244             ((null line))
     245          (when (search "Created session file:" line)
     246            (display-shark-session-file line)
     247            (return))))))
     248
    224249
    225250
    226251(defmacro meter (form &key reset)
    227     `(progn
    228       (ensure-shark-process ,reset)
     252  (let* ((hook (gensym))
     253         (block (gensym))
     254         (process (gensym)))
     255    `(block ,block
     256      (flet ((,hook (p)
     257               (when (or (eq (external-process-status p) :exited)
     258                         (eq (external-process-status p) :signaled))
     259                 (setq *shark-process* nil
     260                       *sampling* nil))))
     261      (ensure-shark-process ,reset #',hook)
    229262      (unwind-protect
    230263         (progn
     
    232265           ,form)
    233266        (disable-sampling)
    234         (wait-and-open-mshark-file *shark-session-path* 5))))
    235 
    236 
     267        (let* ((,process *shark-process*))
     268          (when ,process
     269            (scan-shark-process-output ,process))))))))
     270
     271
Note: See TracChangeset for help on using the changeset viewer.