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