diff options
Diffstat (limited to 'module/statprof.scm')
-rw-r--r-- | module/statprof.scm | 33 |
1 files changed, 15 insertions, 18 deletions
diff --git a/module/statprof.scm b/module/statprof.scm index 33246e5bd..7c3a339bb 100644 --- a/module/statprof.scm +++ b/module/statprof.scm @@ -1,7 +1,7 @@ ;;;; (statprof) -- a statistical profiler for Guile ;;;; -*-scheme-*- ;;;; -;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010, 2011, 2013 Free Software Foundation, Inc. ;;;; Copyright (C) 2004, 2009 Andy Wingo <wingo at pobox dot com> ;;;; Copyright (C) 2001 Rob Browning <rlb at defaultvalue dot org> ;;;; @@ -216,13 +216,12 @@ (+ accumulated-time 0.0 (- ,stop-time last-start-time)))) (define (get-call-data proc) - (let ((k (if (or (not (program? proc)) - (zero? (program-num-free-variables proc))) - proc - (program-objcode proc)))) - (or (hashq-ref procedure-data k) + (let ((k (cond + ((program? proc) (program-code proc)) + (else proc)))) + (or (hashv-ref procedure-data k) (let ((call-data (make-call-data proc 0 0 0))) - (hashq-set! procedure-data k call-data) + (hashv-set! procedure-data k call-data) call-data)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -296,8 +295,7 @@ ;; confuse guile wrt re-enabling the trap when ;; count-call finishes. (if %count-calls? - (set-vm-trace-level! (the-vm) - (1- (vm-trace-level (the-vm))))) + (set-vm-trace-level! (1- (vm-trace-level)))) (accumulate-time stop-time))) (setitimer ITIMER_PROF @@ -309,8 +307,7 @@ (begin (set! last-start-time (get-internal-run-time)) (if %count-calls? - (set-vm-trace-level! (the-vm) - (1+ (vm-trace-level (the-vm))))))))) + (set-vm-trace-level! (1+ (vm-trace-level)))))))) (set! inside-profiler? #f)) @@ -358,8 +355,8 @@ than @code{statprof-stop}, @code{#f} otherwise." (car sampling-frequency) (cdr sampling-frequency))) (if %count-calls? - (add-hook! (vm-apply-hook (the-vm)) count-call)) - (set-vm-trace-level! (the-vm) (1+ (vm-trace-level (the-vm)))) + (add-hook! (vm-apply-hook) count-call)) + (set-vm-trace-level! (1+ (vm-trace-level))) #t))) ;; Do not call this from statprof internal functions -- user only. @@ -372,9 +369,9 @@ than @code{statprof-stop}, @code{#f} otherwise." (begin (set! gc-time-taken (- (cdr (assq 'gc-time-taken (gc-stats))) gc-time-taken)) - (set-vm-trace-level! (the-vm) (1- (vm-trace-level (the-vm)))) + (set-vm-trace-level! (1- (vm-trace-level))) (if %count-calls? - (remove-hook! (vm-apply-hook (the-vm)) count-call)) + (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 (setitimer ITIMER_PROF 0 0 0 0)) @@ -426,7 +423,7 @@ none is available." (if (positive? profile-level) (error "Can't call statprof-fold-called while profiler is running.")) - (hashq-ref procedure-data proc)) + (get-call-data proc)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Stats @@ -582,7 +579,7 @@ to @code{statprof-reset} is true." (cond ((eq? a b)) ((and (program? a) (program? b)) - (eq? (program-objcode a) (program-objcode b))) + (eq? (program-code a) (program-code b))) (else #f)))) @@ -755,7 +752,7 @@ whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or (set! last-start-time (get-internal-run-time)) (set! gc-time-taken (cdr (assq 'gc-time-taken (gc-stats)))) (add-hook! after-gc-hook gc-callback) - (set-vm-trace-level! (the-vm) (1+ (vm-trace-level (the-vm)))) + (set-vm-trace-level! (1+ (vm-trace-level))) #t))) (define (stop) |