diff options
| author | Andy Wingo <wingo@pobox.com> | 2017-02-17 13:11:39 +0100 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2017-02-17 13:11:39 +0100 |
| commit | e5ed64c26c21e5e6815dd44f6129c1cd0495f2ba (patch) | |
| tree | d3ccdcf5009cc16c457fc13ca0f5341069443ceb | |
| parent | Take advantage of accept4 interface. (diff) | |
| download | guile-fibers-e5ed64c26c21e5e6815dd44f6129c1cd0495f2ba.tar.gz | |
Add allocation speedup test
* tests/speedup.scm: Add allocation speedup test.
| -rw-r--r-- | tests/speedup.scm | 13 |
1 files changed, 13 insertions, 0 deletions
diff --git a/tests/speedup.scm b/tests/speedup.scm index bf4bb5f..ea67d6a 100644 --- a/tests/speedup.scm +++ b/tests/speedup.scm @@ -47,6 +47,12 @@ (current-processor-count))))))) (define (loop-to n) (let lp ((i 0)) (when (< i n) (lp (1+ i))))) +(define (alloc-to words n) + (let lp ((i 0) (x #f)) + (if (< i n) + (lp (1+ i) (make-vector (- words 2) #f)) + x))) + (measure-speedup (do-times 100000 (spawn-fiber (lambda () #t) #:parallel? #t))) (measure-speedup @@ -57,3 +63,10 @@ (do-times 10000 (spawn-fiber (lambda () (loop-to #e1e5)) #:parallel? #t))) (measure-speedup (do-times 1000 (spawn-fiber (lambda () (loop-to #e1e6)) #:parallel? #t))) + +(measure-speedup + (do-times 100000 (spawn-fiber (lambda () (alloc-to 4 #e1e3)) #:parallel? #t))) +(measure-speedup + (do-times 10000 (spawn-fiber (lambda () (alloc-to 4 #e1e4)) #:parallel? #t))) +(measure-speedup + (do-times 1000 (spawn-fiber (lambda () (alloc-to 4 #e1e5)) #:parallel? #t))) |