Profiling

[srt@aerospace.aero.org]

I forget exactly where this came from, but it might prove useful to 
those people interested in timing stuff in T3:

(herald profile (env tsys))


;;; The beginings of a profiler.

(define (make-uid_$t) (make-bytev 8))

(define-foreign proc2_$who_am_i
  (proc2_$who_am_i (ignore rep/extend my-uid))
        ignore)

(define (make-proc2_$info_t) (make-bytev 112))

(define (cpu_total.high info) (mref-integer info 28))
(define (cpu_total.low  info) (mref-16-u    info 28))
(define (priv_faults  info)   (mref-integer info 86))
(define (glob_faults  info)   (mref-integer info 90))
(define (disk_page_io info)   (mref-integer info 94))
(define (net_page_io  info)   (mref-integer info 98))

(define-foreign proc2_$get_info
  (proc2_$get_info (ignore rep/extend       process-uid)
                   (out    rep/extend       info)
                   (in     rep/integer-16-u info-buf-length)
                   (out    rep/integer      status))
        ignore)

(define (make-time_$clock_t) (make-bytev 6))

(define-foreign time_$clock
  (time_$clock (ignore rep/extend clock))
        ignore)

(define-syntax (monitor . expr)
  `(let ((thunk (lambda () ,@expr)))
     (%monitor 1 thunk)))

(define-syntax (bench repetitions  . expr)
  `(let ((thunk (lambda () ,@expr)))
     (%monitor ,repetitions thunk)))

;++ why is cpu sometime greater than elapsed?                               

;++ make this machine independent *********

(let ((pid    (make-uid_$t))
      (start  (make-time_$clock_t))
      (stop   (make-time_$clock_t))
      (pstart (make-proc2_$info_t))
      (pstop  (make-proc2_$info_t)))
  (define (%monitor repetitions thunk)
    (proc2_$who_am_i pid)
    (let ((heap-start (process-global task/area-frontier)))
      (time_$clock start)
      (proc2_$get_info pid pstart 112 nil)
      (let ((val (iterate loop ((i 1))          
                   (cond ((fx>= i repetitions) (thunk))
                         (else (thunk)
                          (loop (fx+ i 1)))))))
        (proc2_$get_info pid pstop 112 nil)
        (time_$clock stop)
        (let* ((heap-stop (process-global task/area-frontier))
               (cells (fx- heap-stop heap-start))
               (etime (- (clock->bignum stop) (clock->bignum start)))
               (cpu   (- (info->cpu pstop)   (info->cpu pstart)))
               (priv  (fx- (priv_faults pstop)
                           (priv_faults pstart)))
               (glob  (fx- (glob_faults pstop)
                           (glob_faults pstart)))
               (disk  (fx- (disk_page_io pstop)
                           (disk_page_io pstart)))
               (net   (fx- (net_page_io pstop)
                           (net_page_io pstart))))
          (let ((factor (* 250000 repetitions)))
            (format t "~&;Elapsed time = ~a.~a CPU time = ~a.~a~%"
                      (quotient etime factor)
                      (remainder etime factor)
                      (quotient cpu factor)
                      (remainder cpu factor)))
          (format t "~&;Page faults: Private = ~a  Global = ~a  Disk = ~a  Net = ~a~%"
                  (quotient priv repetitions)
                  (quotient glob repetitions)
                  (quotient disk repetitions)
                  (quotient net  repetitions))
          (format t "~&;Consed ~s longwords~%" cells)
          val)))))

(define (info->cpu info)
  (+ (ash (mref-16-u info 28) 32)
     (ash (mref-16-u info 30) 16)
     (mref-16-u info 32)))

(define (clock->bignum clock)
  (+ (ash (mref-16-u clock 0) 32)
     (ash (mref-16-u clock 2) 16)
     (mref-16-u clock 4)))