Commit | Line | Data |
---|---|---|
2d80426a LC |
1 | ;; -*- Scheme -*- |
2 | ;; | |
3 | ;; A library of dumb functions that may be used to benchmark Guile-VM. | |
4 | ||
5 | ||
e677365c AW |
6 | ;; The comments are from Ludovic, a while ago. The speedups now are much |
7 | ;; more significant (all over 2x, sometimes 8x). | |
8 | ||
2d80426a | 9 | (define (fibo x) |
6649bc04 | 10 | (if (or (= x 1) (= x 2)) |
2d80426a | 11 | 1 |
6649bc04 AW |
12 | (+ (fibo (- x 1)) |
13 | (fibo (- x 2))))) | |
2d80426a LC |
14 | |
15 | (define (g-c-d x y) | |
16 | (if (= x y) | |
17 | x | |
18 | (if (< x y) | |
19 | (g-c-d x (- y x)) | |
20 | (g-c-d (- x y) y)))) | |
21 | ||
f41cb00c | 22 | (define (loop n) |
2d80426a LC |
23 | ;; This one shows that procedure calls are no faster than within the |
24 | ;; interpreter: the VM yields no performance improvement. | |
f41cb00c | 25 | (if (= 0 n) |
2d80426a | 26 | 0 |
f41cb00c | 27 | (loop (1- n)))) |
2d80426a LC |
28 | |
29 | ;; Disassembly of `loop' | |
30 | ;; | |
87c4242c | 31 | ;; Disassembly of #<objcode b79bdf28>: |
e677365c AW |
32 | |
33 | ;; nlocs = 0 nexts = 0 | |
34 | ||
35 | ;; 0 (make-int8 64) ;; 64 | |
36 | ;; 2 (load-symbol "guile-user") ;; guile-user | |
37 | ;; 14 (list 0 1) ;; 1 element | |
38 | ;; 17 (load-symbol "loop") ;; loop | |
39 | ;; 23 (link-later) | |
87c4242c AW |
40 | ;; 24 (vector 0 1) ;; 1 element |
41 | ;; 27 (make-int8 0) ;; 0 | |
42 | ;; 29 (load-symbol "n") ;; n | |
43 | ;; 32 (make-false) ;; #f | |
44 | ;; 33 (make-int8 0) ;; 0 | |
45 | ;; 35 (list 0 3) ;; 3 elements | |
46 | ;; 38 (list 0 2) ;; 2 elements | |
47 | ;; 41 (list 0 1) ;; 1 element | |
48 | ;; 44 (make-int8 5) ;; 5 | |
49 | ;; 46 (make-false) ;; #f | |
50 | ;; 47 (cons) | |
51 | ;; 48 (make-int8 18) ;; 18 | |
52 | ;; 50 (make-false) ;; #f | |
53 | ;; 51 (cons) | |
54 | ;; 52 (make-int8 20) ;; 20 | |
55 | ;; 54 (make-false) ;; #f | |
56 | ;; 55 (cons) | |
57 | ;; 56 (list 0 4) ;; 4 elements | |
58 | ;; 59 (load-program ##{66}#) | |
59 | ;; 81 (define "loop") | |
60 | ;; 87 (variable-set) | |
61 | ;; 88 (void) | |
62 | ;; 89 (return) | |
63 | ||
64 | ;; Bytecode ##{66}#: | |
e677365c AW |
65 | |
66 | ;; 0 (make-int8 0) ;; 0 | |
67 | ;; 2 (local-ref 0) | |
68 | ;; 4 (ee?) | |
69 | ;; 5 (br-if-not 0 3) ;; -> 11 | |
70 | ;; 8 (make-int8 0) ;; 0 | |
71 | ;; 10 (return) | |
f7e5296e | 72 | ;; 11 (toplevel-ref 0) |
87c4242c AW |
73 | ;; 13 (local-ref 0) |
74 | ;; 15 (make-int8 1) ;; 1 | |
75 | ;; 17 (sub) | |
76 | ;; 18 (tail-call 1) | |
2d80426a | 77 | |
f41cb00c | 78 | (define (loopi n) |
2d80426a | 79 | ;; Same as `loop'. |
f41cb00c LC |
80 | (let loopi ((n n)) |
81 | (if (= 0 n) | |
2d80426a | 82 | 0 |
f41cb00c | 83 | (loopi (1- n))))) |
2d80426a | 84 | |
0b5f0e49 LC |
85 | (define (do-loop n) |
86 | ;; Same as `loop' using `do'. | |
87 | (do ((i n (1- i))) | |
88 | ((= 0 i)) | |
89 | ;; do nothing | |
90 | )) | |
91 | ||
2d80426a LC |
92 | |
93 | (define (do-cons x) | |
94 | ;; This one shows that the built-in `cons' instruction yields a significant | |
f41cb00c | 95 | ;; improvement (speedup: 1.5). |
2d80426a LC |
96 | (let loop ((x x) |
97 | (result '())) | |
98 | (if (<= x 0) | |
99 | result | |
100 | (loop (1- x) (cons x result))))) | |
101 | ||
f41cb00c LC |
102 | (define big-list (iota 500000)) |
103 | ||
2d80426a | 104 | (define (copy-list lst) |
f41cb00c | 105 | ;; Speedup: 5.9. |
2d80426a LC |
106 | (let loop ((lst lst) |
107 | (result '())) | |
108 | (if (null? lst) | |
109 | result | |
110 | (loop (cdr lst) | |
111 | (cons (car lst) result))))) |