mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
Improved the VM's efficiency. The VM is as fast as the interpreter. :-(
* benchmark/lib.scm: New file. * benchmark/measure.scm: New file. * README: Added useful pointers to various threads. * doc/guile-vm.texi: Fixed the description of `load-program' (it now expects _immediate_ integers). * src/*.[ch]: Use immediate integers whereever possible, as in the original code. For `CONS', use `scm_cell' rather than `scm_cons'. git-archimport-id: lcourtes@laas.fr--2004-libre/guile-vm--revival--0.6--patch-6
This commit is contained in:
parent
238e7a11a8
commit
2d80426a3e
16 changed files with 275 additions and 51 deletions
119
benchmark/lib.scm
Normal file
119
benchmark/lib.scm
Normal file
|
@ -0,0 +1,119 @@
|
|||
;; -*- Scheme -*-
|
||||
;;
|
||||
;; A library of dumb functions that may be used to benchmark Guile-VM.
|
||||
|
||||
|
||||
(define (fibo x)
|
||||
(if (= 1 x)
|
||||
1
|
||||
(+ x
|
||||
(fibo (1- x)))))
|
||||
|
||||
(define (g-c-d x y)
|
||||
(if (= x y)
|
||||
x
|
||||
(if (< x y)
|
||||
(g-c-d x (- y x))
|
||||
(g-c-d (- x y) y))))
|
||||
|
||||
(define (loop how-long)
|
||||
;; This one shows that procedure calls are no faster than within the
|
||||
;; interpreter: the VM yields no performance improvement.
|
||||
(if (= 0 how-long)
|
||||
0
|
||||
(loop (1- how-long))))
|
||||
|
||||
;; Disassembly of `loop'
|
||||
;;
|
||||
; Disassembly of #<objcode 302360b0>:
|
||||
|
||||
; nlocs = 0 nexts = 0
|
||||
|
||||
; 0 (make-int8 64) ;; 64
|
||||
; 2 (link "=")
|
||||
; 5 (link "loop")
|
||||
; 11 (link "1-")
|
||||
; 15 (vector 3)
|
||||
; 17 (make-int8:0) ;; 0
|
||||
; 18 (load-symbol "how-long") ;; how-long
|
||||
; 28 (make-false) ;; #f
|
||||
; 29 (make-int8:0) ;; 0
|
||||
; 30 (list 3)
|
||||
; 32 (list 2)
|
||||
; 34 (list 1)
|
||||
; 36 (make-int8 8) ;; 8
|
||||
; 38 (make-int8 2) ;; 2
|
||||
; 40 (make-int8 6) ;; 6
|
||||
; 42 (cons)
|
||||
; 43 (cons)
|
||||
; 44 (make-int8 23) ;; 23
|
||||
; 46 (make-int8 4) ;; 4
|
||||
; 48 (make-int8 12) ;; 12
|
||||
; 50 (cons)
|
||||
; 51 (cons)
|
||||
; 52 (make-int8 25) ;; 25
|
||||
; 54 (make-int8 4) ;; 4
|
||||
; 56 (make-int8 6) ;; 6
|
||||
; 42 (cons)
|
||||
; 43 (cons)
|
||||
; 44 (make-int8 23) ;; 23
|
||||
; 46 (make-int8 4) ;; 4
|
||||
; 48 (make-int8 12) ;; 12
|
||||
; 50 (cons)
|
||||
; 51 (cons)
|
||||
; 52 (make-int8 25) ;; 25
|
||||
; 54 (make-int8 4) ;; 4
|
||||
; 56 (make-int8 6) ;; 6
|
||||
; 58 (cons)
|
||||
; 59 (cons)
|
||||
; 60 (list 4)
|
||||
; 62 load-program ##{201}#
|
||||
; 89 (link "loop")
|
||||
; 95 (variable-set)
|
||||
; 96 (void)
|
||||
; 97 (return)
|
||||
|
||||
; Bytecode ##{201}#:
|
||||
|
||||
; 0 (object-ref 0)
|
||||
; 2 (variable-ref)
|
||||
; 3 (make-int8:0) ;; 0
|
||||
; 4 (local-ref 0)
|
||||
; 6 (call 2)
|
||||
; 8 (br-if-not 0 2) ;; -> 13
|
||||
; 11 (make-int8:0) ;; 0
|
||||
; 12 (return)
|
||||
; 13 (object-ref 1)
|
||||
; 15 (variable-ref)
|
||||
; 16 (object-ref 2)
|
||||
; 18 (variable-ref)
|
||||
; 19 (local-ref 0)
|
||||
; 21 (call 1)
|
||||
; 23 (tail-call 1)
|
||||
|
||||
|
||||
(define (loopi how-long)
|
||||
;; Same as `loop'.
|
||||
(let loopi ((how-long how-long))
|
||||
(if (= 0 how-long)
|
||||
0
|
||||
(loopi (1- how-long)))))
|
||||
|
||||
|
||||
(define (do-cons x)
|
||||
;; This one shows that the built-in `cons' instruction yields a significant
|
||||
;; improvement (speedup: 1.4).
|
||||
(let loop ((x x)
|
||||
(result '()))
|
||||
(if (<= x 0)
|
||||
result
|
||||
(loop (1- x) (cons x result)))))
|
||||
|
||||
(define (copy-list lst)
|
||||
;; Speedup: 1.3.
|
||||
(let loop ((lst lst)
|
||||
(result '()))
|
||||
(if (null? lst)
|
||||
result
|
||||
(loop (cdr lst)
|
||||
(cons (car lst) result)))))
|
49
benchmark/measure.scm
Executable file
49
benchmark/measure.scm
Executable file
|
@ -0,0 +1,49 @@
|
|||
#!/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 base compile)
|
||||
:use-module (system base language))
|
||||
|
||||
(define (time-for-eval sexp eval)
|
||||
(let ((before (tms:utime (times))))
|
||||
(eval sexp (current-module))
|
||||
(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))))
|
||||
(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))))))
|
||||
(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)
|
Loading…
Add table
Add a link
Reference in a new issue