dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Statprof works better with RTL programs

Browse source 
* module/statprof.scm (get-call-data, procedure=?): Work with RTL
  programs.
This commit is contained in:
Andy Wingo 2013-10-17 23:12:23 +02:00
commit 0bd6b1cae1
1 changed files with 9 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

16
module/statprof.scm
View file

@ -1,7 +1,7 @@
;;;; (statprof) -- a statistical profiler for Guile ;;;; (statprof) -- a statistical profiler for Guile
;;;; -*-scheme-*- ;;;; -*-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) 2004, 2009 Andy Wingo <wingo at pobox dot com>
;;;; Copyright (C) 2001 Rob Browning <rlb at defaultvalue dot org> ;;;; Copyright (C) 2001 Rob Browning <rlb at defaultvalue dot org>
;;;; ;;;;
@ -216,13 +216,13 @@
(+ accumulated-time 0.0 (- ,stop-time last-start-time)))) (+ accumulated-time 0.0 (- ,stop-time last-start-time))))
(define (get-call-data proc) (define (get-call-data proc)
(let ((k (if (or (not (program? proc)) (let ((k (cond
(zero? (program-num-free-variables proc))) ((program? proc) (program-objcode proc))
proc ((rtl-program? proc) (rtl-program-code proc))
(program-objcode proc)))) (else proc))))
(or (hashq-ref procedure-data k) (or (hashv-ref procedure-data k)
(let ((call-data (make-call-data proc 0 0 0))) (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)))) call-data))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -583,6 +583,8 @@ to @code{statprof-reset} is true."
((eq? a b)) ((eq? a b))
((and (program? a) (program? b)) ((and (program? a) (program? b))
(eq? (program-objcode a) (program-objcode b))) (eq? (program-objcode a) (program-objcode b)))
((and (rtl-program? a) (rtl-program? b))
(eq? (rtl-program-code a) (rtl-program-code b)))
(else (else
#f)))) #f))))