From 2d80426a3ec7de15a194d0baed0e9f4be8659b92 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es <ludovic.courtes@laas.fr>
Date: Fri, 29 Apr 2005 14:12:12 +0000
Subject: 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
---
 benchmark/lib.scm     | 119 ++++++++++++++++++++++++++++++++++++++++++++++++++
 benchmark/measure.scm |  49 +++++++++++++++++++++
 2 files changed, 168 insertions(+)
 create mode 100644 benchmark/lib.scm
 create mode 100755 benchmark/measure.scm

(limited to 'benchmark')

diff --git a/benchmark/lib.scm b/benchmark/lib.scm
new file mode 100644
index 000000000..f272842b3
--- /dev/null
+++ b/benchmark/lib.scm
@@ -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)))))
diff --git a/benchmark/measure.scm b/benchmark/measure.scm
new file mode 100755
index 000000000..0fe4b8efa
--- /dev/null
+++ b/benchmark/measure.scm
@@ -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)
-- 
cgit v1.2.3