diff --git a/collects/tests/stress/racket/vector.rkt b/collects/tests/stress/racket/vector.rkt index a5cd79b161..1369d7da93 100644 --- a/collects/tests/stress/racket/vector.rkt +++ b/collects/tests/stress/racket/vector.rkt @@ -3,17 +3,18 @@ racket/unsafe/ops) ; vector-set*! -(local [(define vec (make-vector 8001 #t)) - (define-syntax (inlined-vector-set*! stx) - (syntax-case stx () - [(_ vec 0) #'(void)] - [(_ vec n) #`(begin (inlined-vector-set*! vec #,(sub1 (syntax->datum #'n))) (vector-set! vec n #f))])) - (define-syntax (fun-vector-set*! stx) - (syntax-case stx () - [(_ vec n) - #`(vector-set*! vec #,@(apply append - (for/list ([i (in-range (syntax->datum #'n))]) - (list i #f))))]))] +(define-syntax (inlined-vector-set*! stx) + (syntax-case stx () + [(_ vec 0) #'(void)] + [(_ vec n) #`(begin (inlined-vector-set*! vec #,(sub1 (syntax->datum #'n))) (vector-set! vec n #f))])) +(define-syntax (fun-vector-set*! stx) + (syntax-case stx () + [(_ vec n) + #`(vector-set*! vec #,@(apply append + (for/list ([i (in-range (syntax->datum #'n))]) + (list i #f))))])) + +(local [(define vec (make-vector 8001 #t))] (stress 20 ; XXX if there was an unsafe-vector-set!/bounds, we could test vector? once @@ -30,3 +31,12 @@ (unsafe-vector*-set! vec i #f))] ["vector-set*!" (fun-vector-set*! vec 8000)])) + +(fit "vector-set*!" + 80000 + (λ (n) + (define vec (make-vector n #t)) + (apply vector-set*! vec + (for/fold ([l empty]) + ([i (in-range n)]) + (list* i #f l))))) diff --git a/collects/tests/stress/stress.rkt b/collects/tests/stress/stress.rkt index b0f30131bf..8b9893e4e2 100644 --- a/collects/tests/stress/stress.rkt +++ b/collects/tests/stress/stress.rkt @@ -1,5 +1,31 @@ #lang racket -(provide stress) +(provide stress + fit) + +(define (fit label max f #:slices [slices 20]) + (fit-display + label + (for/list ([slice-n (in-range 1 (add1 slices))]) + (define i (round (* slice-n (/ max slices)))) + (define-values (cpu real gc) + (isolate slice-n (λ () (f i)))) + (collect-garbage) (collect-garbage) + (vector i cpu)))) + +(define (fit-display label l) + (define baseline (vector-ref (findf (λ (v) (not (zero? (vector-ref v 1)))) l) 1)) + (printf "~a: baseline = ~a\n" label baseline) + (for ([v (in-list l)]) + (match-define (vector n val) v) + (printf "\t~a: ~ax\n" n (/ val baseline)))) + +(define (isolate trial-n thunk) + (define exp-cust (make-custodian)) + (define-values (_ cpu real gc) + (parameterize ([current-custodian exp-cust]) + (time-apply thunk empty))) + (custodian-shutdown-all exp-cust) + (values cpu real gc)) (define-syntax-rule (stress trials-expr [label body ...] ...) (stress* trials-expr @@ -17,11 +43,8 @@ [real0 0.0] [gc0 0.0]) ([trial-n (in-range how-many)]) - (define exp-cust (make-custodian)) - (define-values (_ cpu1 real1 gc1) - (parameterize ([current-custodian exp-cust]) - (time-apply thunk empty))) - (custodian-shutdown-all exp-cust) + (define-values (cpu1 real1 gc1) + (isolate trial-n thunk)) (when (zero? (modulo trial-n 5)) (collect-garbage) (collect-garbage)) (values (cumulative-average cpu0 cpu1 trial-n) @@ -32,15 +55,17 @@ (define (stress* how-many . experiments) (stress-display how-many - (sort + (sort-experiments (for/list ([exp (in-list experiments)]) - (run-experiment how-many exp)) - <= - #:key (λ (v) (vector-ref v 1))))) + (run-experiment how-many exp))))) + +(define (sort-experiments l) + (sort l <= + #:key (λ (v) (vector-ref v 1)))) (define (stress-display how-many res) (for ([v (in-list res)]) (match-define (vector label cpu real gc) v) - (printf "~a: cpu time: ~a real time: ~a gc time: ~a (averaged over ~a runs)\n" + (printf "~a: cpu: ~a real: ~a gc: ~a (averaged over ~a runs)\n" label cpu real gc how-many)) (newline)) \ No newline at end of file