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