racket-benchmarks: some microbenchmarks for continuations. etc.
This commit is contained in:
Matthew Flatt
parent
b1a6baffc6
commit
6d7ae5e1d2
|
|
@ -0,0 +1,3 @@
|
|||
Microbenchmarks to help explain and improve the performance of
|
||||
continuaations, threads, continuation marks, thread cells, and
|
||||
parameters.
|
||||
|
|
@ -0,0 +1,212 @@
|
|||
;; This file is meant to be run in Scheme
|
||||
|
||||
(load "setup.rktl")
|
||||
(load "config.rktl")
|
||||
|
||||
;; Not inlined:
|
||||
(define (f x) x)
|
||||
|
||||
(show '----------------------------------------)
|
||||
|
||||
;; Compare to 'pair-loop; the difference is the time to check
|
||||
;; that the continuation is reified and pop the old attachementt
|
||||
(show 'attachment-set-loop)
|
||||
(show
|
||||
(times
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
(car (current-continuation-attachments))
|
||||
(call-setting-continuation-attachment
|
||||
i
|
||||
(lambda ()
|
||||
(loop (sub1 i))))))))
|
||||
|
||||
;; Compare to 'loop; the diffrenmce is the time to check
|
||||
;; for an attachment that is never there
|
||||
(show 'attachment-get-loop)
|
||||
(show
|
||||
(times
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
0
|
||||
(call-getting-continuation-attachment
|
||||
1
|
||||
(lambda (v)
|
||||
(loop (- i v))))))))
|
||||
|
||||
;; Compare to 'loop; the diffrenmce is the time to check
|
||||
;; for an attachment --- discovering the reified continuation
|
||||
;; that indicates that the attachment is there
|
||||
(show 'attachment-get-loop/has-attachment)
|
||||
(show
|
||||
(times
|
||||
(call-setting-continuation-attachment
|
||||
1
|
||||
(lambda ()
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
0
|
||||
(call-getting-continuation-attachment
|
||||
1
|
||||
(lambda (v)
|
||||
(loop (- i v))))))))))
|
||||
|
||||
;; Combines the overheads of 'attachment-get-loop and 'attachment-set-loop
|
||||
(show 'attachment-get-set-loop)
|
||||
(show
|
||||
(times
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
(car (current-continuation-attachments))
|
||||
(call-getting-continuation-attachment
|
||||
1
|
||||
(lambda (v)
|
||||
(call-setting-continuation-attachment
|
||||
i
|
||||
(lambda ()
|
||||
(loop (sub1 i))))))))))
|
||||
|
||||
;; Like 'attachment-get-loop and 'attachment-set-loop, but
|
||||
;; "cosume" insteda of "get" sets up a faster "set" because
|
||||
;; it doesn't have to re-check for reified or attachment
|
||||
(show 'attachment-consume-set-loop)
|
||||
(show
|
||||
(times
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
(car (current-continuation-attachments))
|
||||
(call-consuming-continuation-attachment
|
||||
0
|
||||
(lambda (v)
|
||||
(call-setting-continuation-attachment
|
||||
i
|
||||
(lambda ()
|
||||
(loop (sub1 i))))))))))
|
||||
|
||||
;; Simulate `with-continuation-mark`
|
||||
(show 'attachment-consume-pair-set-loop)
|
||||
(show
|
||||
(times
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
(car (current-continuation-attachments))
|
||||
(call-consuming-continuation-attachment
|
||||
#f
|
||||
(lambda (v)
|
||||
(call-setting-continuation-attachment
|
||||
(if v
|
||||
(cons i (cdr v))
|
||||
(cons i #f))
|
||||
(lambda ()
|
||||
(loop (sub1 i))))))))))
|
||||
|
||||
;; Build a long chain of attachments, where the continuation
|
||||
;; doesn't have to be reified because the compiler can add
|
||||
;; a "push" and "pop" around the `add1` call
|
||||
;; Most of the time here is GC time to deal with the growing
|
||||
;; chain of attachments
|
||||
(show 'attachment-set-nontail-easy)
|
||||
(show
|
||||
(times
|
||||
(let loop ([i M])
|
||||
(if (zero? i)
|
||||
(car (current-continuation-attachments))
|
||||
(add1
|
||||
(call-setting-continuation-attachment
|
||||
i
|
||||
(lambda ()
|
||||
(add1 (loop (sub1 i))))))))))
|
||||
|
||||
;; Build a long chain of attachments *and* continuaiton frames;
|
||||
;; the continuation frame is reified for the current `loop`
|
||||
;; call, since `call-setting-continuation-attachment` is in
|
||||
;; tail position
|
||||
;; Most of the time here is GC time, because
|
||||
;; this creates a chain of continuation records;
|
||||
;; compare to 'k-nontail
|
||||
(show 'attachment-set-nontail-outside)
|
||||
(show
|
||||
(times
|
||||
(let loop ([i M])
|
||||
(if (zero? i)
|
||||
(car (current-continuation-attachments))
|
||||
(call-setting-continuation-attachment
|
||||
i
|
||||
(lambda ()
|
||||
(add1 (loop (sub1 i)))))))))
|
||||
|
||||
;; Like the "outside" version, but the continuation frame is
|
||||
;; reified on the previous `loop` call to move the attachment
|
||||
;; to the frame
|
||||
;; Most of the time here is GC time, still
|
||||
(show 'attachment-set-nontail-inside)
|
||||
(show
|
||||
(times
|
||||
(let loop ([i M])
|
||||
(if (zero? i)
|
||||
(car (current-continuation-attachments))
|
||||
(add1
|
||||
(call-setting-continuation-attachment
|
||||
i
|
||||
(lambda ()
|
||||
(loop (sub1 i)))))))))
|
||||
|
||||
;; Like 'attachment-set-nontail-inside in that the attachment
|
||||
;; is moved to a reified frame for a non-tail call, but
|
||||
;; no chain of frames is created
|
||||
;; A frame cache pays off here, because the reified frame is
|
||||
;; short-lived
|
||||
(show 'attachment-nontail-argument-loop)
|
||||
(show
|
||||
(times
|
||||
(let ([f f])
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
0
|
||||
(loop (call-setting-continuation-attachment
|
||||
i
|
||||
(lambda ()
|
||||
(f (sub1 i))))))))))
|
||||
|
||||
;; Like 'attachment-nontail-argument-loop, but with a
|
||||
;; `cons` to simulate a key--value mapping
|
||||
(show 'attachment-nontail-argument-pair-loop)
|
||||
(show
|
||||
(times
|
||||
(let ([f f])
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
0
|
||||
(loop (call-setting-continuation-attachment
|
||||
(cons 'key i)
|
||||
(lambda ()
|
||||
(f (sub1 i))))))))))
|
||||
|
||||
;; Since the compiler knows about `sub1`, it doesn't have
|
||||
;; to reify the continuation frame
|
||||
(show 'attachment-nontail-argument-loop-easy)
|
||||
(show
|
||||
(times
|
||||
(let ([f f])
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
0
|
||||
(loop (f (call-setting-continuation-attachment
|
||||
i
|
||||
(lambda ()
|
||||
(sub1 i))))))))))
|
||||
|
||||
|
||||
;; Like 'attachment-nontail-argument-loop-easy, but
|
||||
;; with a pair for the attachment
|
||||
(show 'attachment-nontail-argument-pair-loop-easy)
|
||||
(show
|
||||
(times
|
||||
(let ([f f])
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
0
|
||||
(loop (f (call-setting-continuation-attachment
|
||||
(cons 'key i)
|
||||
(lambda ()
|
||||
(sub1 i))))))))))
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
#lang racket/base
|
||||
(require racket/include)
|
||||
|
||||
(include "config.rktl")
|
||||
|
||||
(define (f x) x)
|
||||
(set! f f)
|
||||
|
||||
'----------------------------------------
|
||||
|
||||
;; Baseline loop performance
|
||||
'loop
|
||||
(times
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
0
|
||||
(loop (sub1 i)))))
|
||||
|
||||
;; How much does it const to allocate a pair each time?
|
||||
;; See "attach.scm"
|
||||
'pair-loop
|
||||
(times
|
||||
(let loop ([i N] [p #f])
|
||||
(if (zero? i)
|
||||
p
|
||||
(loop (sub1 i) (cons i i)))))
|
||||
|
||||
;; Baseline for continuation-growing non-tail recursion (note `M` instead of `N`)
|
||||
'nontail
|
||||
(times
|
||||
(let loop ([i M])
|
||||
(if (zero? i)
|
||||
0
|
||||
(add1 (loop (sub1 i))))))
|
||||
|
||||
;; How much more does it add to allocate pairs?
|
||||
'pairs-nontail
|
||||
(times
|
||||
(let loop ([i M] [p #f])
|
||||
(if (zero? i)
|
||||
(car p)
|
||||
(add1 (loop (sub1 i) (cons i (cons i p)))))))
|
||||
|
||||
;; Racket CS time is 12% slower than CS time due to
|
||||
;; the extra code generated by `#%app`
|
||||
'indirect-nontail-argument-loop
|
||||
(times
|
||||
(let ([f f])
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
0
|
||||
(loop (f (sub1 i)))))))
|
||||
|
|
@ -0,0 +1,71 @@
|
|||
;; This file is meant to be run in Scheme
|
||||
|
||||
(load "setup.rktl")
|
||||
(load "config.rktl")
|
||||
|
||||
;; Not inlined:
|
||||
(define (f x) x)
|
||||
|
||||
(show '----------------------------------------)
|
||||
|
||||
;; Baseline loop performance
|
||||
(show 'loop)
|
||||
(show
|
||||
(times
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
0
|
||||
(loop (sub1 i))))))
|
||||
|
||||
;; How much does it const to allocate a pair each time, since
|
||||
;; pushing a continuation attachment will do that?
|
||||
;; Answer: makes the loop about 25% slower
|
||||
(show 'pair-loop)
|
||||
(show
|
||||
(times
|
||||
(let loop ([i N] [p #f])
|
||||
(if (zero? i)
|
||||
p
|
||||
(loop (sub1 i) (cons i i))))))
|
||||
|
||||
;; Baseline for continuation-growing non-tail recursion (note `M` instead of `N`)
|
||||
(show 'nontail)
|
||||
(show
|
||||
(times
|
||||
(let loop ([i M])
|
||||
(if (zero? i)
|
||||
0
|
||||
(add1 (loop (sub1 i)))))))
|
||||
|
||||
;; Baseline for instantiating the continuation in a non-tail recursion
|
||||
;; Most of the time here is GC time, because
|
||||
;; this creates a chain of continuation records
|
||||
(show 'k-nontail)
|
||||
(show
|
||||
(times
|
||||
(let loop ([i M])
|
||||
(if (zero? i)
|
||||
0
|
||||
(add1
|
||||
(call/cc
|
||||
(lambda (k)
|
||||
(loop (sub1 i)))))))))
|
||||
|
||||
;; How much more does it add to allocate pairs?
|
||||
(show 'pairs-nontail)
|
||||
(show
|
||||
(times
|
||||
(let loop ([i M] [p #f])
|
||||
(if (zero? i)
|
||||
(car p)
|
||||
(add1 (loop (sub1 i) (cons i (cons i p))))))))
|
||||
|
||||
;; Baseline for non-tail calls to an unknown function `f`
|
||||
(show 'indirect-nontail-argument-loop)
|
||||
(show
|
||||
(times
|
||||
(let ([f f])
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
0
|
||||
(loop (f (sub1 i))))))))
|
||||
|
|
@ -0,0 +1,89 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/include)
|
||||
|
||||
(include "config.rktl")
|
||||
|
||||
(define my-prompt (make-continuation-prompt-tag 'mine))
|
||||
|
||||
'----------------------------------------
|
||||
|
||||
'compose-baseline
|
||||
(times
|
||||
(let ([k (let/ec esc
|
||||
(call-with-continuation-prompt
|
||||
(lambda ()
|
||||
(let loop ([j 100])
|
||||
(if (zero? j)
|
||||
(call-with-composable-continuation
|
||||
(lambda (k)
|
||||
(esc k)))
|
||||
(add1 (loop (sub1 j))))))))])
|
||||
(let loop ([i Q] [v #f])
|
||||
(if (zero? i)
|
||||
v
|
||||
(loop (sub1 i) (k 0))))))
|
||||
|
||||
'compose-deep-marks
|
||||
(times
|
||||
(let ([k (let/ec esc
|
||||
(call-with-continuation-prompt
|
||||
(lambda ()
|
||||
(let loop ([j 100])
|
||||
(if (zero? j)
|
||||
(call-with-composable-continuation
|
||||
(lambda (k)
|
||||
(esc k)))
|
||||
(with-continuation-mark
|
||||
'key j
|
||||
(add1 (loop (sub1 j)))))))))])
|
||||
(let loop ([i Q] [v #f])
|
||||
(if (zero? i)
|
||||
v
|
||||
(loop (sub1 i) (k 0))))))
|
||||
|
||||
'compose-deep/prompt-marks
|
||||
(times
|
||||
(let ([k (let/ec esc
|
||||
(call-with-continuation-prompt
|
||||
(lambda ()
|
||||
(let loop ([j 100])
|
||||
(if (zero? j)
|
||||
(call-with-composable-continuation
|
||||
(lambda (k)
|
||||
(esc k)))
|
||||
(call-with-continuation-prompt
|
||||
(lambda ()
|
||||
(with-continuation-mark
|
||||
'key j
|
||||
(add1 (loop (sub1 j)))))
|
||||
my-prompt))))))])
|
||||
(let loop ([i Q] [v #f])
|
||||
(if (zero? i)
|
||||
v
|
||||
(loop (sub1 i) (k 0))))))
|
||||
|
||||
;; Like the previous case, but the composable
|
||||
;; continuation doesn't start with a mark
|
||||
;; that needs to be spliced
|
||||
'compose-deep/prompt/nosplice-marks
|
||||
(times
|
||||
(let ([k (let/ec esc
|
||||
(call-with-continuation-prompt
|
||||
(lambda ()
|
||||
(add1
|
||||
(let loop ([j 100])
|
||||
(if (zero? j)
|
||||
(call-with-composable-continuation
|
||||
(lambda (k)
|
||||
(esc k)))
|
||||
(call-with-continuation-prompt
|
||||
(lambda ()
|
||||
(with-continuation-mark
|
||||
'key j
|
||||
(add1 (loop (sub1 j)))))
|
||||
my-prompt)))))))])
|
||||
(let loop ([i Q] [v #f])
|
||||
(if (zero? i)
|
||||
v
|
||||
(loop (sub1 i) (k 0))))))
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/include)
|
||||
|
||||
(include "config.rktl")
|
||||
|
||||
'----------------------------------------
|
||||
|
||||
(define c (make-thread-cell #f))
|
||||
|
||||
'cell-ref
|
||||
(times
|
||||
(let loop ([i L] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (thread-cell-ref c)))))
|
||||
|
||||
'cell-set!
|
||||
(times
|
||||
(let loop ([i L])
|
||||
(if (zero? i)
|
||||
(thread-cell-ref c)
|
||||
(begin
|
||||
(thread-cell-set! c i)
|
||||
(loop (sub1 i))))))
|
||||
|
||||
'cell-ref-after-set
|
||||
(times
|
||||
(let loop ([i L] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (thread-cell-ref c)))))
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
;; Iterations for slow things:
|
||||
(define Q 1000000)
|
||||
|
||||
;; The depth used for non-tail recursion, typically:
|
||||
(define M (* Q 10))
|
||||
|
||||
;; Intermediate count:
|
||||
(define L (* M 10))
|
||||
|
||||
;; Number of iteraitons used for a loop, typically
|
||||
(define N (* L 10))
|
||||
|
||||
;; Number of times to run each benchamrk:
|
||||
(define I 3)
|
||||
|
||||
(define-syntax times
|
||||
(syntax-rules ()
|
||||
[(_ e)
|
||||
(let loop ([v #f] [i I])
|
||||
(if (zero? i)
|
||||
v
|
||||
(loop (time e) (sub1 i))))]))
|
||||
153
pkgs/racket-benchmarks/tests/racket/benchmarks/control/get.rkt
Normal file
153
pkgs/racket-benchmarks/tests/racket/benchmarks/control/get.rkt
Normal file
|
|
@ -0,0 +1,153 @@
|
|||
#lang racket/base
|
||||
(require racket/include)
|
||||
|
||||
(include "config.rktl")
|
||||
|
||||
(define my-prompt (make-continuation-prompt-tag 'mine))
|
||||
|
||||
'----------------------------------------
|
||||
|
||||
;; This is relatively slow, because it collects backtrace information
|
||||
'marks-loop
|
||||
(times
|
||||
(let loop ([i M] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (current-continuation-marks)))))
|
||||
|
||||
;; Lookup with key not found
|
||||
'first-none-loop
|
||||
(times
|
||||
(let loop ([i L] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (continuation-mark-set-first #f 'key)))))
|
||||
|
||||
;; Lookup with key found
|
||||
'first-some-loop
|
||||
(times
|
||||
(with-continuation-mark
|
||||
'key 'val
|
||||
(let loop ([i L] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (continuation-mark-set-first #f 'key))))))
|
||||
|
||||
;; Lookup with key found on the other side of a prompt
|
||||
'first-some/prompt-loop
|
||||
(times
|
||||
(with-continuation-mark
|
||||
'key 'val
|
||||
(call-with-continuation-prompt
|
||||
(lambda ()
|
||||
(let loop ([i L] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (continuation-mark-set-first #f 'key)))))
|
||||
my-prompt)))
|
||||
|
||||
;; Lookup with key found in distant frame
|
||||
'first-some/deep-loop
|
||||
(times
|
||||
(with-continuation-mark
|
||||
'key 'val
|
||||
(let loop ([j 100])
|
||||
(cond
|
||||
[(zero? j)
|
||||
(let loop ([i L] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (continuation-mark-set-first #f 'key))))]
|
||||
[(odd? j)
|
||||
(list (loop (sub1 j)))]
|
||||
[else
|
||||
(car (loop (sub1 j)))]))))
|
||||
|
||||
;; Lookup with key found in distant frame with lots of other
|
||||
;; keys on frames in between
|
||||
'first-some/deep/push-loop
|
||||
(times
|
||||
(with-continuation-mark
|
||||
'key 'val
|
||||
(let loop ([j 100])
|
||||
(cond
|
||||
[(zero? j)
|
||||
(let loop ([i L] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (continuation-mark-set-first #f 'key))))]
|
||||
[(odd? j)
|
||||
(list (with-continuation-mark
|
||||
'other 'val
|
||||
(loop (sub1 j))))]
|
||||
[else
|
||||
(car (loop (sub1 j)))]))))
|
||||
|
||||
;; Lookup with key *not* found with lots of other
|
||||
;; keys on frames
|
||||
'first-none/deep/push-loop
|
||||
(times
|
||||
(let loop ([j 100])
|
||||
(cond
|
||||
[(zero? j)
|
||||
(let loop ([i L] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (continuation-mark-set-first #f 'key))))]
|
||||
[(odd? j)
|
||||
(list (with-continuation-mark
|
||||
'other 'val
|
||||
(loop (sub1 j))))]
|
||||
[else
|
||||
(car (loop (sub1 j)))])))
|
||||
|
||||
;; Lookup with key found in distant frame with lots of prompts
|
||||
;; and other keys on frames in between
|
||||
'first-some/deep/prompt/push-loop
|
||||
(times
|
||||
(with-continuation-mark
|
||||
'key 'val
|
||||
(let k-loop ([k 100])
|
||||
(let loop ([j 100])
|
||||
(cond
|
||||
[(zero? j)
|
||||
(if (zero? k)
|
||||
(let loop ([i M] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (continuation-mark-set-first #f 'key))))
|
||||
(call-with-continuation-prompt
|
||||
(lambda ()
|
||||
(k-loop (sub1 k)))
|
||||
my-prompt))]
|
||||
[(odd? j)
|
||||
(list (with-continuation-mark
|
||||
'other 'val
|
||||
(loop (sub1 j))))]
|
||||
[else
|
||||
(car (loop (sub1 j)))])))))
|
||||
|
||||
;; Like the previous one, but prompt makes only marks within
|
||||
;; the last prompt relevant
|
||||
'first-some/deep/stop-prompt/push-loop
|
||||
(times
|
||||
(with-continuation-mark
|
||||
'key 'val
|
||||
(let k-loop ([k 100])
|
||||
(let loop ([j 100])
|
||||
(cond
|
||||
[(zero? j)
|
||||
(if (zero? k)
|
||||
(let loop ([i M] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (continuation-mark-set-first #f 'key))))
|
||||
(call-with-continuation-prompt
|
||||
(lambda ()
|
||||
(k-loop (sub1 k)))))]
|
||||
[(odd? j)
|
||||
(list (with-continuation-mark
|
||||
'other 'val
|
||||
(loop (sub1 j))))]
|
||||
[else
|
||||
(car (loop (sub1 j)))])))))
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
#lang racket/base
|
||||
(require racket/include)
|
||||
|
||||
(include "config.rktl")
|
||||
|
||||
'----------------------------------------
|
||||
|
||||
;; Key not found
|
||||
'none-loop
|
||||
(times
|
||||
(let loop ([i N] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(call-with-immediate-continuation-mark
|
||||
'key
|
||||
(lambda (a)
|
||||
(loop (sub1 i) a))))))
|
||||
|
||||
;; Key found
|
||||
'some-loop
|
||||
(times
|
||||
(with-continuation-mark
|
||||
'key 'val
|
||||
(let loop ([i N] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(call-with-immediate-continuation-mark
|
||||
'key
|
||||
(lambda (a)
|
||||
(loop (sub1 i) a)))))))
|
||||
|
|
@ -0,0 +1,84 @@
|
|||
#lang racket/base
|
||||
(require racket/include)
|
||||
|
||||
(include "config.rktl")
|
||||
|
||||
(define (f x) x)
|
||||
(set! f f)
|
||||
|
||||
'----------------------------------------
|
||||
|
||||
;; Continuation marks around tail call for a loop
|
||||
;; Should be similar to 'attachment-consume-pair-set-loop
|
||||
;; from "attach.ss", but extra overhead is call to an "update"
|
||||
;; function instead of an inline `cons`
|
||||
'mark-set-loop
|
||||
(times
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
(continuation-mark-set-first #f 'key)
|
||||
(with-continuation-mark
|
||||
'key i
|
||||
(loop (sub1 i))))))
|
||||
|
||||
;; Analogous to 'attachment-set-nontail-easy
|
||||
;; Racket CS: in large-M configuration, nearly all
|
||||
;; time is GC due grouping attachment list
|
||||
'mark-set-nontail-easy
|
||||
(times
|
||||
(let loop ([i M])
|
||||
(if (zero? i)
|
||||
(continuation-mark-set-first #f 'key)
|
||||
(add1
|
||||
(with-continuation-mark
|
||||
'key i
|
||||
(add1 (loop (sub1 i))))))))
|
||||
|
||||
;; Racket: 1/3 time is GC
|
||||
;; Racket CS: nearly all time is GC, because
|
||||
;; this creates a chain of continuation records
|
||||
'mark-set-nontail-outside
|
||||
(times
|
||||
(let loop ([i M])
|
||||
(if (zero? i)
|
||||
(continuation-mark-set-first #f 'key)
|
||||
;; Note: traditional Racket uses a kind of `begin0` here
|
||||
(with-continuation-mark
|
||||
'key i
|
||||
(add1 (loop (sub1 i)))))))
|
||||
|
||||
;; Racket: 1/2 time is GC
|
||||
;; Racket CS: nearly all time is GC, because
|
||||
;; this creates a chain of continuation records
|
||||
'mark-set-nontail-inside
|
||||
(times
|
||||
(let loop ([i M])
|
||||
(if (zero? i)
|
||||
(continuation-mark-set-first #f 'key)
|
||||
(add1
|
||||
(with-continuation-mark
|
||||
'key i
|
||||
(loop (sub1 i)))))))
|
||||
|
||||
;; Racket CS time is 25% slower than CS time due to
|
||||
;; `#%app` plus the `cons` of 'key and `i`
|
||||
'mark-nontail-argument-loop
|
||||
(times
|
||||
(let ([f f])
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
0
|
||||
(loop (with-continuation-mark
|
||||
'key i
|
||||
(f (sub1 i))))))))
|
||||
|
||||
;; Racket CS time is 45% slower than CS time...
|
||||
'mark-nontail-argument-loop-easy
|
||||
(times
|
||||
(let ([f f])
|
||||
(let loop ([i N])
|
||||
(if (zero? i)
|
||||
0
|
||||
(loop (f (with-continuation-mark
|
||||
'key i
|
||||
(sub1 i))))))))
|
||||
|
|
@ -0,0 +1,92 @@
|
|||
#lang racket/base
|
||||
(require racket/include
|
||||
(only-in '#%paramz
|
||||
parameterization-key))
|
||||
|
||||
(include "config.rktl")
|
||||
|
||||
(define p (make-parameter #f))
|
||||
|
||||
'----------------------------------------
|
||||
|
||||
;; Twice as long as a typical key, because we look for the
|
||||
;; root prompt (never there) instead of the default prompt
|
||||
'get-paramz
|
||||
(times
|
||||
(let loop ([i L] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (continuation-mark-set-first
|
||||
#f
|
||||
parameterization-key)))))
|
||||
|
||||
'current-paramz
|
||||
(times
|
||||
(let loop ([i L] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (current-parameterization)))))
|
||||
|
||||
'current-paramz/local
|
||||
(times
|
||||
(parameterize ([p 10])
|
||||
(let loop ([i L] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (current-parameterization))))))
|
||||
|
||||
'param-ref
|
||||
(times
|
||||
(let loop ([i L] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (p)))))
|
||||
|
||||
'param-ref/local
|
||||
(times
|
||||
(parameterize ([p 10])
|
||||
(let loop ([i L] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (p))))))
|
||||
|
||||
'param-set!
|
||||
(times
|
||||
(let loop ([i L])
|
||||
(if (zero? i)
|
||||
(p)
|
||||
(begin
|
||||
(p i)
|
||||
(loop (sub1 i))))))
|
||||
|
||||
'param-ref-after-set
|
||||
(times
|
||||
(let loop ([i L] [a #f])
|
||||
(if (zero? i)
|
||||
a
|
||||
(loop (sub1 i) (p)))))
|
||||
|
||||
'param-bind-loop
|
||||
(times
|
||||
(let loop ([i M])
|
||||
(if (zero? i)
|
||||
(p)
|
||||
(parameterize ([p i])
|
||||
(loop (sub1 i))))))
|
||||
|
||||
'param-bind-prim-loop
|
||||
(times
|
||||
(let ([insp (make-inspector)])
|
||||
(let loop ([i M])
|
||||
(if (zero? i)
|
||||
(p)
|
||||
(parameterize ([current-inspector insp])
|
||||
(loop (sub1 i)))))))
|
||||
|
||||
'param-bind-nontail
|
||||
(times
|
||||
(let loop ([i M])
|
||||
(if (zero? i)
|
||||
(p)
|
||||
(parameterize ([p i])
|
||||
(add1 (loop (sub1 i)))))))
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
;; Racket-style outtput for timing informatiton:
|
||||
(define-syntax time
|
||||
(syntax-rules ()
|
||||
[(_ e)
|
||||
(let ([pre (statistics)])
|
||||
(let ([r e])
|
||||
(let ([post (statistics)])
|
||||
(print-delta pre post)
|
||||
r)))]))
|
||||
|
||||
(define (print-delta pre post)
|
||||
(define (msecs a b)
|
||||
(quotient (- (+ (* 1000000000 (time-second a)) (time-nanosecond a))
|
||||
(+ (* 1000000000 (time-second b)) (time-nanosecond b)))
|
||||
1000000))
|
||||
(printf "cpu time: ~a real time: ~a gc time: ~a\n"
|
||||
(msecs (sstats-cpu post) (sstats-cpu pre))
|
||||
(msecs (sstats-real post) (sstats-real pre))
|
||||
(msecs (sstats-gc-cpu post) (sstats-gc-cpu pre))))
|
||||
|
||||
(print-extended-identifiers #t)
|
||||
|
||||
(define (show v)
|
||||
(when (symbol? v) (display "'"))
|
||||
(write v)
|
||||
(newline))
|
||||
|
|
@ -0,0 +1,109 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/include)
|
||||
|
||||
(include "config.rktl")
|
||||
|
||||
'----------------------------------------
|
||||
|
||||
'spin-ping-pong
|
||||
(times
|
||||
(let ([s1 (box #t)]
|
||||
[s2 (box #t)])
|
||||
(define (box-wait b)
|
||||
(unless (box-cas! b #t #f)
|
||||
(sleep)
|
||||
(box-wait b)))
|
||||
(define (box-post b)
|
||||
(unless (box-cas! b #f #t)
|
||||
(sleep)
|
||||
(box-post b)))
|
||||
(define (make s1 s2)
|
||||
(thread (lambda ()
|
||||
(let loop ([i Q])
|
||||
(box-wait s1)
|
||||
(unless (zero? i)
|
||||
(box-post s2)
|
||||
(loop (sub1 i)))))))
|
||||
(define t1 (make s1 s2))
|
||||
(define t2 (make s2 s1))
|
||||
(thread-wait t1)
|
||||
(thread-wait t2)))
|
||||
|
||||
'channel-ping-pong
|
||||
(times
|
||||
(let ([c1 (make-channel)]
|
||||
[c2 (make-channel)])
|
||||
(define (make first?)
|
||||
(thread (lambda ()
|
||||
(let loop ([i Q])
|
||||
(if first?
|
||||
(channel-put c2 (channel-get c1))
|
||||
(begin
|
||||
(channel-put c1 'ok)
|
||||
(channel-get c2)))
|
||||
(unless (zero? i)
|
||||
(loop (sub1 i)))))))
|
||||
(define t1 (make #t))
|
||||
(define t2 (make #f))
|
||||
(thread-wait t1)
|
||||
(thread-wait t2)))
|
||||
|
||||
'sema-ping-pong
|
||||
(times
|
||||
(let ([s1 (make-semaphore 1)]
|
||||
[s2 (make-semaphore 1)])
|
||||
(define (make s1 s2)
|
||||
(thread (lambda ()
|
||||
(let loop ([i Q])
|
||||
(semaphore-wait s1)
|
||||
(unless (zero? i)
|
||||
(semaphore-post s2)
|
||||
(loop (sub1 i)))))))
|
||||
(define t1 (make s1 s2))
|
||||
(define t2 (make s2 s1))
|
||||
(thread-wait t1)
|
||||
(thread-wait t2)))
|
||||
|
||||
'sema-ping-pong/prompts
|
||||
(times
|
||||
(let ([s1 (make-semaphore 1)]
|
||||
[s2 (make-semaphore 1)])
|
||||
(define (make s1 s2)
|
||||
(thread (lambda ()
|
||||
(let loop ([j 100])
|
||||
(if (zero? j)
|
||||
(let loop ([i Q])
|
||||
(semaphore-wait s1)
|
||||
(unless (zero? i)
|
||||
(semaphore-post s2)
|
||||
(loop (sub1 i))))
|
||||
(call-with-continuation-prompt
|
||||
(lambda ()
|
||||
(loop (sub1 j)))))))))
|
||||
(define t1 (make s1 s2))
|
||||
(define t2 (make s2 s1))
|
||||
(thread-wait t1)
|
||||
(thread-wait t2)))
|
||||
|
||||
'sema-ping-pong/marks
|
||||
(times
|
||||
(let ([s1 (make-semaphore 1)]
|
||||
[s2 (make-semaphore 1)])
|
||||
(define (make s1 s2)
|
||||
(thread (lambda ()
|
||||
(let loop ([j 100])
|
||||
(if (zero? j)
|
||||
(let loop ([i Q])
|
||||
(semaphore-wait s1)
|
||||
(unless (zero? i)
|
||||
(semaphore-post s2)
|
||||
(loop (sub1 i))))
|
||||
(with-continuation-mark
|
||||
'key j
|
||||
(loop (sub1 j))))))))
|
||||
(define t1 (make s1 s2))
|
||||
(define t2 (make s2 s1))
|
||||
(thread-wait t1)
|
||||
(thread-wait t2)))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user