benchmark/measure.scm

   1 #!/bin/sh
   2 # aside from this initial boilerplate, this is actually -*- scheme -*- code
   3 main='(module-ref (resolve-module '\''(measure)) '\'main')'
   4 exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
   5 !#
   6
   7 ;; A simple interpreter vs. VM performance comparison tool
   8 ;;
   9
  10 (define-module (measure)
  11   :export (measure)
  12   :use-module (system vm core)
  13   :use-module (system vm disasm)
  14   :use-module (system base compile)
  15   :use-module (system base language))
  16
  17
  18 (define (time-for-eval sexp eval)
  19   (let ((before (tms:utime (times))))
  20     (eval sexp)
  21     (let ((elapsed (- (tms:utime (times)) before)))
  22       (format #t "elapsed time: ~a~%" elapsed)
  23       elapsed)))
  24
  25 (define *scheme* (lookup-language 'scheme))
  26
  27 \f
  28 (define (measure . args)
  29   (if (< (length args) 2)
  30       (begin
  31         (format #t "Usage: measure SEXP FILE-TO-LOAD...~%")
  32         (format #t "~%")
  33         (format #t "Example: measure '(loop 23424)' lib.scm~%~%")
  34         (exit 1)))
  35   (for-each load (cdr args))
  36   (let* ((sexp (with-input-from-string (car args)
  37                  (lambda ()
  38                    (read))))
  39          (eval-here (lambda (sexp) (eval sexp (current-module))))
  40          (proc-name (car sexp))
  41          (proc-source (procedure-source (eval proc-name (current-module))))
  42          (% (format #t "proc: ~a~%source: ~a~%" proc-name proc-source))
  43          (time-interpreted (time-for-eval sexp eval-here))
  44          (& (if (defined? proc-name)
  45                 (eval `(set! ,proc-name #f) (current-module))
  46                 (format #t "unbound~%")))
  47          (objcode (compile-in proc-source
  48                               (current-module) *scheme*))
  49          (the-program (vm-load (the-vm) objcode))
  50
  51 ;        (%%% (disassemble-objcode objcode))
  52          (time-compiled (time-for-eval `(,proc-name ,@(cdr sexp))
  53                                        (lambda (sexp)
  54                                          (eval `(begin
  55                                                   (define ,proc-name
  56                                                     ,the-program)
  57                                                   ,sexp)
  58                                                (current-module))))))
  59
  60     (format #t "proc:        ~a => ~a~%"
  61             proc-name (eval proc-name (current-module)))
  62     (format #t "interpreted: ~a~%" time-interpreted)
  63     (format #t "compiled:    ~a~%" time-compiled)
  64     (format #t "speedup:     ~a~%"
  65             (exact->inexact (/ time-interpreted time-compiled)))
  66     0))
  67
  68 (define main measure)