blob: 31e5244539901ce13f222f4d23aab93b12d59766 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
;; -*- 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 n)
;; This one shows that procedure calls are no faster than within the
;; interpreter: the VM yields no performance improvement.
(if (= 0 n)
0
(loop (1- n))))
;; 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 "n") ;; n
; 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 n)
;; Same as `loop'.
(let loopi ((n n))
(if (= 0 n)
0
(loopi (1- n)))))
(define (do-cons x)
;; This one shows that the built-in `cons' instruction yields a significant
;; improvement (speedup: 1.5).
(let loop ((x x)
(result '()))
(if (<= x 0)
result
(loop (1- x) (cons x result)))))
(define big-list (iota 500000))
(define (copy-list lst)
;; Speedup: 5.9.
(let loop ((lst lst)
(result '()))
(if (null? lst)
result
(loop (cdr lst)
(cons (car lst) result)))))
|