May nearly have simple statistical profiler working (need help).

[Rob Browning]

Neil Jerram <address@hidden> writes:

>     Rob>                       I'm using that right now, along with
>     Rob> setitimer and times to write a first pass at a statistical
>     Rob> profiler.  For now there'll be no call graph or other fancy
>     Rob> bits, but so far it's going pretty well.
> 
> This sounds very useful - good luck!

I think I nearly have a (very) simple version working, but I'm getting
some unexpected results, and I wanted to see if others could help make
sure I understand some of the less well documented bits I needed to
use.

Right now the profiler is trying to track the total elapsed time
during profiling (via times), the total number of calls to each
function during profiling (the call count), the total number of times
a function was on the stack when the profiling timer went off (the
sample count), and the total number of times the profiling timer went
off altogether.

This mostly seems to work, but I'm getting some strange results.  For
example, I get functions that have sample counts (i.e. they were on
the stack when the sample timer fired), but they have a zero call
count.  This led me to wonder if I misinterpreted the apply-frame trap
since given my original interpretation, procedures should't be on the
stack if they haven't been called and registered by the apply-frame
handler.

So what is the difference between apply-frame and enter-frame, and is
the apply-frame handler guaranteed to be run for *every* function
that's called?  Is apply-frame sufficient to catch all calls?

Further, can someone tell me what's normally on the stack?  i.e. when
you (make-stack #t), you get a set of frames, but what exactly is a
frame -- what in the source causes one to be created?  More directly,
if I scan for all frames have a non-false frame-procedure? result,
will I hit all the frames that contain procedures,
primitive-procedures, etc. -- all the stuff you'd normally want to
profile?

Also, does masking signals just block them briefly, or could they be
dropped (I don't mind if multiple signals are collapsed into one
pending signal, I just don't want to miss a set of signals
altogether).

Thanks

;; TODO
;;
;; More sophisticated collection/reporting.
;; make sure frames we're skipping in PROF handler are OK.
;; Maybe change to skip stacks containing trap or signal handlers.

(define-module (ice-9 statprof))

(export statprof-active?
        statprof-start
        statprof-stop
        statprof-reset
        statprof-map-called
        statprof-accumulated-time
        statprof-display)

;; This profiler tracks two numbers for every function called while
;; it's active.  It tracks the total number of calls, and the number
;; of times the function was active when the sampler fired.
;;
;; Globally the profiler tracks the total time elapsed and the number
;; of times the sampler was fired.
;;
;; Right now, this profiler is not per-thread and is not thread safe.

(define accumulated-time #f)            ; total so far.
(define last-start-time #f)             ; start-time when timer is active.
(define sample-count #f)                ; total count of sampler calls.
(define sampling-frequency #f)          ; in (seconds . microseconds)
(define remaining-prof-time #f)         ; time remaining when prof suspended.
(define profile-level 0)                ; for user start/stop nesting.
(define inside-apply-trap? #f)          ; avoid races from prof handler.

;; function-data will be a weak-key-hash where the key is the function
;; object itself and the value is the data.  The data will be a vector
;; like this: #(name call-count sample-count)
(define function-data #f)

(define (make-call-data name call-count sample-count)
  (vector name call-count sample-count))
(define (call-data-name cd) (vector-ref cd 0))
(define (call-data-call-count cd) (vector-ref cd 1))
(define (call-data-sample-count cd) (vector-ref cd 2))
(define (set-call-data-name! cd name) (vector-set! cd 0 name))
(define (set-call-data-call-count! cd val) (vector-set! cd 1 val))
(define (set-call-data-sample-count! cd val) (vector-set! cd 2 val))

(export call-data-name
        call-data-count
        call-data-sample-count)

(define (accumulate-time stop-time)
  (set! accumulated-time
        (+ accumulated-time
           (- (tms:utime stop-time) (tms:utime last-start-time))
           (- (tms:stime stop-time) (tms:stime last-start-time)))))

;;======================================================================
;; SIGPROF handler

(define (sample-count-frame frame)
  (if (frame-procedure? frame)
      (let* ((frame-proc (frame-procedure frame))
             (proc-data (hashq-ref function-data frame-proc)))
        
        
        (if proc-data
            (set-call-data-sample-count! proc-data
                                         (+ (call-data-sample-count proc-data)
                                            1))
            ;; I think perhaps this is impossible...
            (hashq-set! function-data frame-proc
                        (make-call-data (procedure-name frame-proc)
                                        0
                                        1))))))

;; No one can interrupt this since it immediately disables the call
;; traps and since guile should block any other profile signals.  Even
;; if it doesn't, there shouldn't be any more scheduled.
(define (profile-signal-handler sig)
  (trap-disable 'apply-frame)           ; unconditionally.
  
  (if (not (zero? profile-level))
      (begin
        (if (not inside-apply-trap?)
            (accumulate-time (times)))
        
        (let* ((stack (make-stack #t))
               (caller-stack-num 2)     ; where to start profiling.
                                        ; (we need to skip the profile
                                        ; funcs themselves).
               (stacklen (stack-length stack)))         
          (if (< caller-stack-num stacklen)
              (begin
                ;; We've got at least one non-profiling frame
                (set! sample-count (+ sample-count 1))
                
                ;; Now accumulate stats for the whole stack.
                (let loop ((n caller-stack-num))
                  (if (< n stacklen)
                      (begin
                        ;;(simple-format #t "Trace frame: (~A of ~A)\n" n 
stacklen)
                        (sample-count-frame (stack-ref stack n))
                        (loop (+ n 1))))))))
        
        (setitimer ITIMER_PROF
                   0 0
                   (car sampling-frequency)
                   (cdr sampling-frequency))
        
        (if (not inside-apply-trap?)
            (begin
              (set! last-start-time (times))
              (trap-enable 'apply-frame))))))

;;======================================================================
;; Count total calls.

(define (count-call trap-name continuation tail)
  ;; Worst case is if profile timer goes off right here -- hence the
  ;; explict trap-disable/enable below.  If anyone knows that guile
  ;; does an explicit enable on return, then we can leave out the
  ;; enable below...
  (mask-signals)
  (set! inside-apply-trap? #t)
  (trap-disable 'apply-frame)
  (unmask-signals)

  (accumulate-time (times))

  (let ((frame (last-stack-frame continuation)))
    (if (frame-procedure? frame)
        (let* ((frame-proc (frame-procedure frame))
               (proc-data (hashq-ref function-data frame-proc)))
          (if proc-data
              (set-call-data-call-count! proc-data
                                         (+ (call-data-call-count proc-data)
                                            1))
              (hashq-set! function-data frame-proc
                          (make-call-data (procedure-name frame-proc)
                                          1
                                          0))))))
  
  (set! last-start-time (times))
  (mask-signals)
  (set! inside-apply-trap? #f)
  (trap-enable 'apply-frame)
  (unmask-signals))

;;======================================================================

(define (statprof-active?) (positive? profile-level))

;; Do not call this from statprof internal functions -- user only.
(define (statprof-start)
  ;; After some head-scratching, I don't *think* I need to mask/unmask
  ;; signals here, but if I'm wrong, please let me know.
  (set! profile-level (+ profile-level 1))
  (if (= profile-level 1)
      (let* ((rpt remaining-prof-time)
             (use-rpt? (and rpt
                            (or (positive? (car rpt))
                                (positive? (cdr rpt))))))
        (set! remaining-prof-time #f)
        (set! last-start-time (times))
        (if use-rpt?
            (setitimer ITIMER_PROF 0 0 (car rpt) (cdr rpt))
            (setitimer ITIMER_PROF
                       0 0
                       (car sampling-frequency)
                       (cdr sampling-frequency)))
        (trap-enable 'apply-frame)
        #t)))
  
;; Do not call this from statprof internal functions -- user only.
(define (statprof-stop)
  ;; After some head-scratching, I don't *think* I need to mask/unmask
  ;; signals here, but if I'm wrong, please let me know.
  (set! profile-level (- profile-level 1))
  (if (zero? profile-level)
      (begin
        (trap-disable 'apply-frame)
        ;; 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))
        (accumulate-time (times))
        (set! last-start-time #f))))

(define (statprof-reset sample-seconds sample-microseconds)
  (if (not (zero? profile-level))
      (error "Can't reset profiler while profiler is running."))
  (set! accumulated-time 0)
  (set! last-start-time #f)
  (set! sample-count 0)
  (set! sampling-frequency (cons sample-seconds sample-microseconds))
  (set! remaining-prof-time #f)
  (set! function-data (make-weak-key-hash-table 131))
  (trap-set! apply-frame-handler count-call)
  (debug-enable 'trace)
  (sigaction SIGPROF profile-signal-handler)
  #t)

(define (statprof-map-called func)
  ;; func should take one arg, call-data.  Note that a
  ;; given proc-name may appear multiple times, but if it does, it
  ;; represents different functions with the same name.
  (hash-fold
   (lambda (key value prior-result)
     (func value))
   #f
   function-data))

(define (statprof-display)
  (statprof-map-called
   (lambda (data)
     (simple-format #t
                    "==[~A ~A ~A]\n"
                    (call-data-name data)
                    (call-data-call-count data)
                    (call-data-sample-count data))))
  (simple-format #t "Total time: ~A\n" accumulated-time)
  (simple-format #t "Sample count: ~A\n" sample-count))

(define (statprof-accumulated-time)
  (if (positive? profile-level)
      (error "Can't get accumulated time while profiler is running."))
  accumulated-time)

;;======================================================================

(define (statprof-display-anomolies)
  (statprof-map-called
   (lambda (data)
     (if (and (zero? (call-data-call-count data))
              (positive? (call-data-sample-count data)))
         (simple-format #t
                        "==[~A ~A ~A]\n"
                        (call-data-name data)
                        (call-data-call-count data)
                        (call-data-sample-count data)))))
  (simple-format #t "Total time: ~A\n" accumulated-time)
  (simple-format #t "Sample count: ~A\n" sample-count))

(export statprof-display-anomolies)

(define (test-func)
  (simple-format #t "Starting test.\n")
  (let loop ((x 10000))
    (if (positive? x)
        (loop (- x 1))))
  (simple-format #t "Stopping test.\n"))

(define (statprof-test)
  (statprof-reset 0 25000)
  (statprof-start)
  (test-func)
  (statprof-stop)
  (statprof-display)
  )

(export statprof-test)

(define (display-frame frame)
  (simple-format #t "Frame ~A\n" frame)
  (simple-format
   #t
   (string-append "  number: ~A\n"
                  "  source: ~A\n"
                  "  procedure: ~A\n"
                  "  arguments: ~A\n"
                  "  previous: ~A\n"
                  "  next: ~A\n"
                  "  real?: ~A\n"
                  "  procedure? ~A\n"
                  "  frame-evaluating-args?: ~A\n"
                  "  frame-overflow?: ~A\n")
   (frame-number frame)
   (frame-source frame)
   (frame-procedure frame)
   (frame-arguments frame)
   (frame-previous frame)
   (frame-next frame)
   (frame-real? frame)
   (frame-procedure? frame)
   (frame-evaluating-args? frame)
   (frame-overflow? frame)))

-- 
Rob Browning
rlb @defaultvalue.org, @linuxdevel.com, and @debian.org
Previously @cs.utexas.edu
GPG=1C58 8B2C FB5E 3F64 EA5C  64AE 78FE E5FE F0CB A0AD