1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +02:00

Pass state around statprof in more places

* module/statprof.scm (get-call-data, sample-stack-procs): Take the
  state as an argument.
  (profile-signal-handler, count-call, statprof-proc-call-data)
  (gcprof): Adapt.
This commit is contained in:
Andy Wingo 2014-02-22 15:09:54 +01:00
parent e70a42d4c9
commit e4a8775ddb

View file

@ -111,6 +111,7 @@
(define-module (statprof) (define-module (statprof)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:autoload (ice-9 format) (format) #:autoload (ice-9 format) (format)
#:use-module (system vm vm) #:use-module (system vm vm)
#:use-module (system vm frame) #:use-module (system vm frame)
@ -235,8 +236,7 @@
(+ (accumulated-time state) (+ (accumulated-time state)
(- stop-time (last-start-time state))))) (- stop-time (last-start-time state)))))
(define (get-call-data proc) (define (get-call-data state proc)
(define state (ensure-profiler-state))
(let ((k (cond (let ((k (cond
((program? proc) (program-code proc)) ((program? proc) (program-code proc))
(else proc)))) (else proc))))
@ -253,10 +253,9 @@
;; growable vector, and resolve them to procedures when analyzing ;; growable vector, and resolve them to procedures when analyzing
;; instead of at collection time. ;; instead of at collection time.
;; ;;
(define (sample-stack-procs stack) (define (sample-stack-procs state stack)
(let ((stacklen (stack-length stack)) (let ((stacklen (stack-length stack))
(hit-count-call? #f) (hit-count-call? #f))
(state (existing-profiler-state)))
(when (record-full-stacks? state) (when (record-full-stacks? state)
(set-stacks! state (cons stack (stacks state)))) (set-stacks! state (cons stack (stacks state))))
@ -271,10 +270,11 @@
(hash-fold (hash-fold
(lambda (proc val accum) (lambda (proc val accum)
(inc-call-data-cum-sample-count! (inc-call-data-cum-sample-count!
(get-call-data proc))) (get-call-data state proc)))
#f #f
procs-seen) procs-seen)
(and=> (and=> self get-call-data) (and=> (and=> self (lambda (proc)
(get-call-data state proc)))
inc-call-data-self-sample-count!)) inc-call-data-self-sample-count!))
((frame-procedure frame) ((frame-procedure frame)
=> (lambda (proc) => (lambda (proc)
@ -311,7 +311,7 @@
;; signal handler instead... ;; signal handler instead...
(stack (or (make-stack #t profile-signal-handler) (stack (or (make-stack #t profile-signal-handler)
(pk 'what! (make-stack #t)))) (pk 'what! (make-stack #t))))
(inside-apply-trap? (sample-stack-procs stack))) (inside-apply-trap? (sample-stack-procs state stack)))
(unless inside-apply-trap? (unless inside-apply-trap?
;; disabling here is just a little more efficient, but ;; disabling here is just a little more efficient, but
@ -348,7 +348,7 @@
(and=> (frame-procedure frame) (and=> (frame-procedure frame)
(lambda (proc) (lambda (proc)
(inc-call-data-call-count! (inc-call-data-call-count!
(get-call-data proc)))) (get-call-data state proc))))
(set-last-start-time! state (get-internal-run-time)))) (set-last-start-time! state (get-internal-run-time))))
@ -447,7 +447,7 @@ it represents different functions with the same name."
none is available." none is available."
(when (statprof-active?) (when (statprof-active?)
(error "Can't call statprof-proc-call-data while profiler is running.")) (error "Can't call statprof-proc-call-data while profiler is running."))
(get-call-data proc)) (get-call-data (existing-profiler-state) proc))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Stats ;; Stats
@ -771,7 +771,7 @@ whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or
;; also. ;; also.
(stack (or (make-stack #t gc-callback 0 1) (stack (or (make-stack #t gc-callback 0 1)
(pk 'what! (make-stack #t))))) (pk 'what! (make-stack #t)))))
(sample-stack-procs stack) (sample-stack-procs state stack)
(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)))