summaryrefslogtreecommitdiff
path: root/module/statprof.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/statprof.scm')
-rw-r--r--module/statprof.scm33
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)