summaryrefslogtreecommitdiff
path: root/module/statprof.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/statprof.scm')
-rw-r--r--module/statprof.scm45
1 files changed, 21 insertions, 24 deletions
diff --git a/module/statprof.scm b/module/statprof.scm
index b43210533..2268af3b7 100644
--- a/module/statprof.scm
+++ b/module/statprof.scm
@@ -162,7 +162,7 @@
(define-record-type <state>
(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?
stacks procedure-data inside-profiler?)
state?
@@ -172,8 +172,8 @@
(last-start-time last-start-time set-last-start-time!)
;; Total count of sampler calls.
(sample-count sample-count set-sample-count!)
- ;; (seconds . microseconds)
- (sampling-frequency sampling-frequency set-sampling-frequency!)
+ ;; Microseconds.
+ (sampling-period sampling-period set-sampling-period!)
;; Time remaining when prof suspended.
(remaining-prof-time remaining-prof-time set-remaining-prof-time!)
;; For user start/stop nesting.
@@ -196,9 +196,9 @@
(define profiler-state (make-parameter #f))
(define* (fresh-profiler-state #:key (count-calls? #f)
- (sampling-frequency '(0 . 10000))
+ (sampling-period 10000)
(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))
(define (ensure-profiler-state)
@@ -294,6 +294,13 @@
(loop (frame-previous frame) procs-seen self))))
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 state (existing-profiler-state))
@@ -316,10 +323,7 @@
(accumulate-time state stop-time)
(set-last-start-time! state (get-internal-run-time))
- (setitimer ITIMER_PROF
- 0 0
- (car (sampling-frequency state))
- (cdr (sampling-frequency state)))))
+ (reset-sigprof-timer (sampling-period state))))
(set-inside-profiler?! state #f))
@@ -355,20 +359,12 @@ than @code{statprof-stop}, @code{#f} otherwise."
(define state (ensure-profiler-state))
(set-profile-level! state (+ (profile-level state) 1))
(when (= (profile-level state) 1)
- (let* ((rpt (remaining-prof-time state))
- (use-rpt? (and rpt
- (or (positive? (car rpt))
- (positive? (cdr rpt))))))
- (set-remaining-prof-time! state #f)
+ (let ((rpt (remaining-prof-time state)))
+ (set-remaining-prof-time! state 0)
;; FIXME: Use per-thread run time.
(set-last-start-time! state (get-internal-run-time))
(set-gc-time-taken! state (assq-ref (gc-stats) 'gc-time-taken))
- (if use-rpt?
- (setitimer ITIMER_PROF 0 0 (car rpt) (cdr rpt))
- (setitimer ITIMER_PROF
- 0 0
- (car (sampling-frequency state))
- (cdr (sampling-frequency state))))
+ (reset-sigprof-timer (if (zero? rpt) (sampling-period state) rpt))
(when (count-calls? state)
(add-hook! (vm-apply-hook) count-call))
(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))
;; I believe that we need to do this before getting the time
;; (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))
(set-last-start-time! state #f)))
@@ -406,8 +402,9 @@ Enables traps and debugging as necessary."
(when (statprof-active?)
(error "Can't reset profiler while profiler is running."))
(let ((state (fresh-profiler-state #:count-calls? count-calls?
- #:sampling-frequency
- (cons sample-seconds sample-microseconds)
+ #:sampling-period
+ (+ (* sample-seconds #e1e6)
+ sample-microseconds)
#:full-stacks? full-stacks?)))
(profiler-state state)
(sigaction SIGPROF profile-signal-handler)
@@ -767,7 +764,7 @@ whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or
(define (start)
(set-profile-level! state (+ (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-gc-time-taken! state (assq-ref (gc-stats) 'gc-time-taken))
(add-hook! after-gc-hook gc-callback)