mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
f41cb00ce2
* src/*.[ch]: Replaced `scm_mem2symbol' by `scm_from_locale_symboln' and `scm_ulong2num' by `scm_from_ulong'. * src/vm_system.c (tail-call): Fixed stack leak (SP lacked decrement by one more Scheme object in the tail-recursive case). * benchmark/measure.scm (measure): Make sure we are using the compiled procedure (i.e. a program object) when measuring. This yields better results than before. :-) * doc/guile-vm.texi: Augmented the instruction set documentation with branch instructions, `call' and `tail-call'. git-archimport-id: lcourtes@laas.fr--2004-libre/guile-vm--revival--0.6--patch-7
68 lines
2 KiB
Scheme
Executable file
68 lines
2 KiB
Scheme
Executable file
#!/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)
|