+ (set-current-module module)
+ (module-define! module 'run-benchmark run-benchmark)
+ (load (basename file))
+
+ ;; Invoke the benchmark's entry point.
+ (let ((entry (module-ref (current-module)
+ (symbol-append (string->symbol name)
+ '-benchmark))))
+ (entry))))))))
+
+
+\f
+;;;
+;;; Option processing.
+;;;
+
+(define %options
+ (list (option '(#\h "help") #f #f
+ (lambda args
+ (show-help)
+ (exit 0)))
+ (option '(#\l "larceny") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'larceny? #t result)))
+ (option '(#\i "iterations") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'iterations (string->number arg) result)))))
+
+(define (show-help)
+ (format #t "Usage: gc-profile [OPTIONS] FILE.SCM
+Load FILE.SCM, a Guile Scheme source file, and report its execution time and
+final heap usage.
+
+ -h, --help Show this help message
+
+ -l, --larceny Provide mechanisms compatible with the Larceny/Twobit
+ GC benchmark suite.
+ -i, --iterations=COUNT
+ Run the given benchmark COUNT times, regardless of the
+ iteration count passed to `run-benchmark' (for Larceny
+ benchmarks).
+
+Report bugs to <bug-guile@gnu.org>.~%"))
+
+(define (parse-args args)
+ (define (leave fmt . args)
+ (apply format (current-error-port) (string-append fmt "~%") args)
+ (exit 1))
+
+ (args-fold args %options
+ (lambda (opt name arg result)
+ (leave "~A: unrecognized option" opt))
+ (lambda (file result)
+ (if (pair? (assoc 'input result))
+ (leave "~a: only one input file at a time" file)
+ (alist-cons 'input file result)))
+ '()))
+
+\f
+;;;
+;;; Main program.
+;;;
+
+(define (main . args)
+ (let* ((options (parse-args args))
+ (prog (assoc-ref options 'input))
+ (load (if (assoc-ref options 'larceny?)
+ load-larceny-benchmark
+ load)))
+
+ (parameterize ((*iteration-count* (assoc-ref options 'iterations)))
+ (format #t "running `~a' with Guile ~a...~%" prog (version))
+
+ (let ((start (gettimeofday)))
+ (dynamic-wind
+ (lambda ()
+ #t)
+ (lambda ()
+ (set! quit (lambda args args))
+ (load prog))
+ (lambda ()
+ (let ((end (gettimeofday)))
+ (format #t "done~%")
+ (display-stats start end))))))))