1 2(import (chibi ast) (chibi time) (scheme cxr) (srfi 33) (srfi 39)) 3 4(define (timeval->milliseconds tv) 5 (quotient (+ (* 1000000 (timeval-seconds tv)) (timeval-microseconds tv)) 6 1000)) 7 8(define (timeval-diff start end) 9 (- (timeval->milliseconds end) 10 (timeval->milliseconds start))) 11 12(define (time* thunk) 13 (call-with-output-string 14 (lambda (out) 15 (gc) 16 (let* ((start (car (get-time-of-day))) 17 (start-rusage (get-resource-usage)) 18 (gc-start (gc-usecs)) 19 (gc-start-count (gc-count)) 20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 21 (result (parameterize ((current-output-port out)) (thunk))) 22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 23 (end (car (get-time-of-day))) 24 (end-rusage (get-resource-usage)) 25 (gc-end (gc-usecs)) 26 (gc-msecs (quotient (- gc-end gc-start) 1000)) 27 (real-msecs (timeval-diff start end)) 28 (user-msecs 29 (timeval-diff (resource-usage-time start-rusage) 30 (resource-usage-time end-rusage))) 31 (system-msecs 32 (timeval-diff (resource-usage-system-time start-rusage) 33 (resource-usage-system-time end-rusage)))) 34 (display "user: ") 35 (display user-msecs) 36 (display " system: ") 37 (display system-msecs) 38 (display " real: ") 39 (display real-msecs) 40 (display " gc: ") 41 (display gc-msecs) 42 (display " (") 43 (display (- (gc-count) gc-start-count)) 44 (display " times)\n") 45 (display "result: ") 46 (write result) 47 (newline) 48 result)))) 49 50(define-syntax time 51 (syntax-rules () 52 ((_ expr) (time* (lambda () expr))))) 53