/
bench.scm
43 lines (37 loc) · 1.68 KB
/
bench.scm
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
(use-modules (oop goops) (aiscm core) (aiscm util) (ice-9 format))
(load-extension "libguile-aiscm-bench" "init_bench")
(define hook #t); prevent optimizer from removing benchmarked code
(define-syntax-rule (run description n body ...)
(begin
body ...
(let [(t0 (times))]
(do ((i 0 (1+ i))) ((>= i n)) (set! hook (begin body ...)))
(gc)
(let* [(t1 (times))
(user (- (tms:utime t1) (tms:utime t0)))
(system (- (tms:stime t1) (tms:stime t0)))
(clock (- (tms:clock t1) (tms:clock t0)))]
(format #t "~32a ~10,6f ~10,6f ~10,6f (~10,6f)~%" description
(/ (* 1.0e-9 user) n)
(/ (* 1.0e-9 system) n)
(/ (* 1.0e-9 (+ user system)) n)
(/ (* 1.0e-9 clock) n))))))
(define n 1000)
(define size 250000)
(define ptr (gc-malloc-pointerless (* (size-of <int>) size)))
(define <sequence<int>> (multiarray <int> 1))
(define empty (make <sequence<int>> #:shape '(0)))
(define s (make <sequence<int>> #:shape (list size)))
(define-class <c> ())
(define-method (neg (self <c>)) self)
(define c (make <c>))
(format #t "~32t ~10@a ~10@a ~10@a ~10@a~%" "user" "system" "total" "real")
(run "Guile GOOPS method dispatch" n (neg c))
(run "Guile make empty sequence" n (make <sequence<int>> #:shape '(0)))
(run "Guile allocate memory" n (gc-malloc-pointerless (* (size-of <int>) size)))
(run "Guile negate empty sequence" n (- empty))
(run "Guile make sequence" n (make <sequence<int>> #:shape (list size)))
(run "Guile negate sequence" n (- s))
(run "C allocate memory" n (allocation (* (size-of <int>) size)))
(run "C negate empty sequence" n (negate ptr 1 0))
(run "C negate sequence" n (negate ptr 1 size))