1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00

Refactor representation of sampling periods in statprof

* module/statprof.scm (<state>): The sampling frequency is actually a
  period; label it as such, and express in microseconds instead of as a
  pair.  Likewise for remaining-prof-time.
  (fresh-profiler-state): Adapt.
  (reset-sigprof-timer): New helper.
  (profile-signal-handler): Use the new helper.
  (statprof-start): Use the new helper.
  (statprof-stop): Here too.
  (statprof-reset): Adapt to <state> change.
  (gcprof): Set remaining prof time to 0.
This commit is contained in:
Andy Wingo 2014-02-25 22:40:32 +01:00
parent fd5dfcce80
commit 19bf8caff3

View file

@ -162,7 +162,7 @@
(define-record-type <state> (define-record-type <state>
(make-state accumulated-time last-start-time sample-count (make-state accumulated-time last-start-time sample-count
sampling-frequency remaining-prof-time profile-level sampling-period remaining-prof-time profile-level
count-calls? gc-time-taken record-full-stacks? count-calls? gc-time-taken record-full-stacks?
stacks procedure-data inside-profiler?) stacks procedure-data inside-profiler?)
state? state?
@ -172,8 +172,8 @@
(last-start-time last-start-time set-last-start-time!) (last-start-time last-start-time set-last-start-time!)
;; Total count of sampler calls. ;; Total count of sampler calls.
(sample-count sample-count set-sample-count!) (sample-count sample-count set-sample-count!)
;; (seconds . microseconds) ;; Microseconds.
(sampling-frequency sampling-frequency set-sampling-frequency!) (sampling-period sampling-period set-sampling-period!)
;; Time remaining when prof suspended. ;; Time remaining when prof suspended.
(remaining-prof-time remaining-prof-time set-remaining-prof-time!) (remaining-prof-time remaining-prof-time set-remaining-prof-time!)
;; For user start/stop nesting. ;; For user start/stop nesting.
@ -196,9 +196,9 @@
(define profiler-state (make-parameter #f)) (define profiler-state (make-parameter #f))
(define* (fresh-profiler-state #:key (count-calls? #f) (define* (fresh-profiler-state #:key (count-calls? #f)
(sampling-frequency '(0 . 10000)) (sampling-period 10000)
(full-stacks? #f)) (full-stacks? #f))
(make-state 0 #f 0 sampling-frequency #f 0 count-calls? 0 #f '() (make-state 0 #f 0 sampling-period 0 0 count-calls? 0 #f '()
(make-hash-table) #f)) (make-hash-table) #f))
(define (ensure-profiler-state) (define (ensure-profiler-state)
@ -294,6 +294,13 @@
(loop (frame-previous frame) procs-seen self)))) (loop (frame-previous frame) procs-seen self))))
hit-count-call?)) hit-count-call?))
(define (reset-sigprof-timer usecs)
(let ((secs (quotient usecs #e1e6))
(usecs (remainder usecs #e1e6)))
;; Guile's setitimer binding is terrible.
(let ((prev (setitimer ITIMER_PROF 0 0 secs usecs)))
(+ (* (caadr prev) #e1e6) (cdadr prev)))))
(define (profile-signal-handler sig) (define (profile-signal-handler sig)
(define state (existing-profiler-state)) (define state (existing-profiler-state))
@ -316,10 +323,7 @@
(accumulate-time state stop-time) (accumulate-time state stop-time)
(set-last-start-time! state (get-internal-run-time)) (set-last-start-time! state (get-internal-run-time))
(setitimer ITIMER_PROF (reset-sigprof-timer (sampling-period state))))
0 0
(car (sampling-frequency state))
(cdr (sampling-frequency state)))))
(set-inside-profiler?! state #f)) (set-inside-profiler?! state #f))
@ -355,20 +359,12 @@ than @code{statprof-stop}, @code{#f} otherwise."
(define state (ensure-profiler-state)) (define state (ensure-profiler-state))
(set-profile-level! state (+ (profile-level state) 1)) (set-profile-level! state (+ (profile-level state) 1))
(when (= (profile-level state) 1) (when (= (profile-level state) 1)
(let* ((rpt (remaining-prof-time state)) (let ((rpt (remaining-prof-time state)))
(use-rpt? (and rpt (set-remaining-prof-time! state 0)
(or (positive? (car rpt))
(positive? (cdr rpt))))))
(set-remaining-prof-time! state #f)
;; FIXME: Use per-thread run time. ;; FIXME: Use per-thread run time.
(set-last-start-time! state (get-internal-run-time)) (set-last-start-time! state (get-internal-run-time))
(set-gc-time-taken! state (assq-ref (gc-stats) 'gc-time-taken)) (set-gc-time-taken! state (assq-ref (gc-stats) 'gc-time-taken))
(if use-rpt? (reset-sigprof-timer (if (zero? rpt) (sampling-period state) rpt))
(setitimer ITIMER_PROF 0 0 (car rpt) (cdr rpt))
(setitimer ITIMER_PROF
0 0
(car (sampling-frequency state))
(cdr (sampling-frequency state))))
(when (count-calls? state) (when (count-calls? state)
(add-hook! (vm-apply-hook) count-call)) (add-hook! (vm-apply-hook) count-call))
(set-vm-trace-level! (1+ (vm-trace-level))) (set-vm-trace-level! (1+ (vm-trace-level)))
@ -390,7 +386,7 @@ than @code{statprof-stop}, @code{#f} otherwise."
(remove-hook! (vm-apply-hook) count-call)) (remove-hook! (vm-apply-hook) count-call))
;; I believe that we need to do this before getting the time ;; I believe that we need to do this before getting the time
;; (unless we want to make things even more complicated). ;; (unless we want to make things even more complicated).
(set-remaining-prof-time! state (setitimer ITIMER_PROF 0 0 0 0)) (set-remaining-prof-time! state (reset-sigprof-timer 0))
(accumulate-time state (get-internal-run-time)) (accumulate-time state (get-internal-run-time))
(set-last-start-time! state #f))) (set-last-start-time! state #f)))
@ -406,8 +402,9 @@ Enables traps and debugging as necessary."
(when (statprof-active?) (when (statprof-active?)
(error "Can't reset profiler while profiler is running.")) (error "Can't reset profiler while profiler is running."))
(let ((state (fresh-profiler-state #:count-calls? count-calls? (let ((state (fresh-profiler-state #:count-calls? count-calls?
#:sampling-frequency #:sampling-period
(cons sample-seconds sample-microseconds) (+ (* sample-seconds #e1e6)
sample-microseconds)
#:full-stacks? full-stacks?))) #:full-stacks? full-stacks?)))
(profiler-state state) (profiler-state state)
(sigaction SIGPROF profile-signal-handler) (sigaction SIGPROF profile-signal-handler)
@ -767,7 +764,7 @@ whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or
(define (start) (define (start)
(set-profile-level! state (+ (profile-level state) 1)) (set-profile-level! state (+ (profile-level state) 1))
(when (= (profile-level state) 1) (when (= (profile-level state) 1)
(set-remaining-prof-time! state #f) (set-remaining-prof-time! state 0)
(set-last-start-time! state (get-internal-run-time)) (set-last-start-time! state (get-internal-run-time))
(set-gc-time-taken! state (assq-ref (gc-stats) 'gc-time-taken)) (set-gc-time-taken! state (assq-ref (gc-stats) 'gc-time-taken))
(add-hook! after-gc-hook gc-callback) (add-hook! after-gc-hook gc-callback)