Commit | Line | Data |
---|---|---|
2d80426a LC |
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) | |
d0927dde | 12 | :use-module (system vm vm) |
f41cb00c | 13 | :use-module (system vm disasm) |
2d80426a LC |
14 | :use-module (system base compile) |
15 | :use-module (system base language)) | |
16 | ||
f41cb00c | 17 | |
2d80426a LC |
18 | (define (time-for-eval sexp eval) |
19 | (let ((before (tms:utime (times)))) | |
f41cb00c | 20 | (eval sexp) |
2d80426a LC |
21 | (let ((elapsed (- (tms:utime (times)) before))) |
22 | (format #t "elapsed time: ~a~%" elapsed) | |
23 | elapsed))) | |
24 | ||
25 | (define *scheme* (lookup-language 'scheme)) | |
26 | ||
f41cb00c | 27 | \f |
2d80426a LC |
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)))) | |
f41cb00c LC |
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))) | |
2d80426a LC |
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) |