diff options
Diffstat (limited to 'benchmark')
-rw-r--r-- | benchmark/lib.scm | 22 | ||||
-rwxr-xr-x | benchmark/measure.scm | 35 |
2 files changed, 39 insertions, 18 deletions
diff --git a/benchmark/lib.scm b/benchmark/lib.scm index f272842b3..31e524453 100644 --- a/benchmark/lib.scm +++ b/benchmark/lib.scm @@ -16,12 +16,12 @@ (g-c-d x (- y x)) (g-c-d (- x y) y)))) -(define (loop how-long) +(define (loop n) ;; This one shows that procedure calls are no faster than within the ;; interpreter: the VM yields no performance improvement. - (if (= 0 how-long) + (if (= 0 n) 0 - (loop (1- how-long)))) + (loop (1- n)))) ;; Disassembly of `loop' ;; @@ -35,7 +35,7 @@ ; 11 (link "1-") ; 15 (vector 3) ; 17 (make-int8:0) ;; 0 -; 18 (load-symbol "how-long") ;; how-long +; 18 (load-symbol "n") ;; n ; 28 (make-false) ;; #f ; 29 (make-int8:0) ;; 0 ; 30 (list 3) @@ -92,25 +92,27 @@ ; 23 (tail-call 1) -(define (loopi how-long) +(define (loopi n) ;; Same as `loop'. - (let loopi ((how-long how-long)) - (if (= 0 how-long) + (let loopi ((n n)) + (if (= 0 n) 0 - (loopi (1- how-long))))) + (loopi (1- n))))) (define (do-cons x) ;; This one shows that the built-in `cons' instruction yields a significant - ;; improvement (speedup: 1.4). + ;; improvement (speedup: 1.5). (let loop ((x x) (result '())) (if (<= x 0) result (loop (1- x) (cons x result))))) +(define big-list (iota 500000)) + (define (copy-list lst) - ;; Speedup: 1.3. + ;; Speedup: 5.9. (let loop ((lst lst) (result '())) (if (null? lst) diff --git a/benchmark/measure.scm b/benchmark/measure.scm index 0fe4b8efa..aadbc516d 100755 --- a/benchmark/measure.scm +++ b/benchmark/measure.scm @@ -10,18 +10,21 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" (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 (current-module)) + (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 @@ -33,13 +36,29 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" (let* ((sexp (with-input-from-string (car args) (lambda () (read)))) - (time-interpreted (time-for-eval sexp eval)) - (objcode (compile-in sexp (current-module) *scheme*)) - (time-compiled (time-for-eval objcode - (let ((vm (the-vm)) - (prog (objcode->program objcode))) - (lambda (o e) - (vm prog)))))) + (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~%" |