From dbec8765e3af08895a533b53c616774866455c93 Mon Sep 17 00:00:00 2001 From: James Swaine Date: Mon, 9 Jul 2012 18:21:58 -0500 Subject: [PATCH] Futures visualizer - reorganize modules, expose formerly private stuff as public (and docs) --- .../racket/future/private/graph-drawing.rkt | 261 +--------- .../racket/future/private/visualizer-data.rkt | 48 +- .../future/private/visualizer-drawing.rkt | 167 +++---- .../racket/future/private/visualizer-gui.rkt | 29 +- collects/racket/future/trace.rkt | 22 + collects/racket/future/visualizer.rkt | 54 ++- collects/scribblings/guide/futures.scrbl | 453 +++++++++--------- .../scribblings/reference/concurrency.scrbl | 1 + .../scribblings/reference/futures-trace.scrbl | 207 ++++++++ .../reference/futures-visualizer.scrbl | 64 ++- collects/scribblings/reference/futures.scrbl | 116 ----- collects/tests/future/visualizer.rkt | 367 +++++++++++--- 12 files changed, 983 insertions(+), 806 deletions(-) create mode 100644 collects/racket/future/trace.rkt create mode 100644 collects/scribblings/reference/futures-trace.scrbl diff --git a/collects/racket/future/private/graph-drawing.rkt b/collects/racket/future/private/graph-drawing.rkt index 31f9d8de71..a2d822b303 100644 --- a/collects/racket/future/private/graph-drawing.rkt +++ b/collects/racket/future/private/graph-drawing.rkt @@ -1,14 +1,15 @@ #lang racket -(require rackunit) +(require rackunit + "constants.rkt") (provide (struct-out point) (struct-out node) (struct-out drawable-node) - (struct-out graph-layout) + (struct-out graph-layout) + (struct-out attributed-node) draw-tree - drawable-node-center) + drawable-node-center + build-attr-tree) -(define DEFAULT-WIDTH 10) -(define PADDING 5) (define-struct/contract point ([x integer?] [y integer?]) #:transparent) (struct node (data children)) (struct graph-layout (width height nodes) #:transparent) @@ -169,8 +170,8 @@ ;;draw-tree : node [symbol] [uint] [uint] [uint] -> tree-layout (define (draw-tree root #:style [style 'standard] - #:node-width [node-width DEFAULT-WIDTH] - #:padding [padding PADDING] + #:node-width [node-width CREATE-GRAPH-NODE-DIAMETER] + #:padding [padding CREATE-GRAPH-PADDING] #:zoom [zoom-level 1]) (let* ([scaled-node-w (* node-width zoom-level)] [scaled-padding (* padding zoom-level)] @@ -193,248 +194,4 @@ (error 'draw-tree "Invalid tree drawing style.")])]) (graph-layout (+ (graph-layout-width layout) scaled-padding) (+ (graph-layout-height layout) scaled-padding) - (graph-layout-nodes layout)))) - - -;Tests -(let* ([nodea (drawable-node (node 'a '()) 5 5 10 0 0 '() 10)] - [center (drawable-node-center nodea)]) - (check-equal? (point-x center) 10.0) - (check-equal? (point-y center) 10.0)) - - -(define test-padding 5) -(define test-width 10) - -(define (tree root-data . children) - (node root-data children)) - -(define (get-node data layout) - (first (filter (λ (dn) (equal? (node-data (drawable-node-node dn)) data)) (graph-layout-nodes layout)))) - -#| - a - | - b -|# -(define tree0 (tree 'a (tree 'b))) -(let* ([layout (draw-tree tree0 #:node-width test-width #:padding test-padding)] - [dnode-a (get-node 'a layout)] - [dnode-b (get-node 'b layout)]) - (check-equal? (graph-layout-width layout) (+ (* test-padding 2) test-width)) - (check-equal? (graph-layout-height layout) (+ (* test-padding 3) (* test-width 2))) - (check-equal? (drawable-node-x dnode-a) test-padding) - (check-equal? (drawable-node-y dnode-a) test-padding) - (check-equal? (drawable-node-x dnode-b) test-padding) - (check-equal? (drawable-node-y dnode-b) (+ test-padding test-width test-padding))) -(let ([atree (build-attr-tree tree0 0)]) - (check-equal? (attributed-node-num-leaves atree) 1)) - -#| - a - / \ - b c -|# -(define tree1 (tree 'a - (tree 'b) - (tree 'c))) -(define layout (draw-tree tree1 #:node-width test-width #:padding test-padding)) -(for ([dnode (in-list (graph-layout-nodes layout))]) - (check-equal? (drawable-node-width dnode) test-width)) -(define dnode-a (get-node 'a layout)) -(define dnode-b (get-node 'b layout)) -(define dnode-c (get-node 'c layout)) - -(define slot-one-pos (+ test-padding test-width test-padding)) -(define square-sz (+ (* test-padding 3) (* test-width 2))) -(check-equal? (graph-layout-width layout) square-sz) -(check-equal? (graph-layout-height layout) square-sz) -(check-equal? (drawable-node-x dnode-b) test-padding) -(check-equal? (drawable-node-y dnode-b) slot-one-pos) -(check-equal? (drawable-node-x dnode-c) slot-one-pos) -(check-equal? (drawable-node-y dnode-c) slot-one-pos) -(check-equal? (drawable-node-x dnode-a) (/ 25 2)) -(check-equal? (drawable-node-y dnode-a) test-padding) -(check-equal? (length (drawable-node-children dnode-a)) 2) -(let ([atree (build-attr-tree tree1 0)]) - (check-equal? (attributed-node-num-leaves atree) 2)) - -#| - a - / \ - b d - | / \ - c e f - | - g -|# -(define tree2 (tree 'a - (tree 'b - (tree 'c)) - (tree 'd - (tree 'e) - (tree 'f - (tree 'g))))) -(let* ([layout (draw-tree tree2 #:node-width test-width #:padding test-padding)] - [nodes (graph-layout-nodes layout)] - [dnode-a (get-node 'a layout)] - [dnode-b (get-node 'b layout)] - [dnode-c (get-node 'c layout)] - [dnode-d (get-node 'd layout)] - [dnode-e (get-node 'e layout)] - [dnode-f (get-node 'f layout)] - [dnode-g (get-node 'g layout)]) - (check-equal? (node-data (drawable-node-node dnode-a)) 'a) - (check-equal? (node-data (drawable-node-node dnode-b)) 'b) - (check-equal? (node-data (drawable-node-node dnode-c)) 'c) - (check-equal? (node-data (drawable-node-node dnode-d)) 'd) - (check-equal? (node-data (drawable-node-node dnode-e)) 'e) - (check-equal? (node-data (drawable-node-node dnode-f)) 'f) - (check-equal? (node-data (drawable-node-node dnode-g)) 'g) - (check-equal? (graph-layout-width layout) 50) - (check-equal? (graph-layout-height layout) 65) - (check-equal? (drawable-node-x dnode-a) (/ 65 4)) - (check-equal? (drawable-node-y dnode-a) test-padding) - (check-equal? (drawable-node-x dnode-b) test-padding) - (check-equal? (drawable-node-y dnode-b) (+ (* 2 test-padding) test-width)) - (check-equal? (drawable-node-x dnode-c) test-padding) - (check-equal? (drawable-node-y dnode-c) (+ (drawable-node-y dnode-b) test-width test-padding)) - (check-equal? (drawable-node-x dnode-e) (+ (* 2 test-padding) test-width)) - (check-equal? (drawable-node-y dnode-e) (+ (drawable-node-y dnode-d) test-width test-padding)) - (check-equal? (drawable-node-x dnode-f) (+ (drawable-node-x dnode-e) test-width test-padding)) - (check-equal? (drawable-node-y dnode-f) (drawable-node-y dnode-e)) - (check-equal? (drawable-node-x dnode-g) (drawable-node-x dnode-f)) - (check-equal? (drawable-node-y dnode-g) (+ (drawable-node-y dnode-f) test-width test-padding))) -(let ([atree (build-attr-tree tree2 0)]) - (check-equal? (attributed-node-num-leaves atree) 3)) - -#| - a - /|\ - b c e - | - d -|# -(define tree3 (tree 'a - (tree 'b) - (tree 'c - (tree 'd)) - (tree 'e))) -(let* ([layout (draw-tree tree3 #:node-width test-width #:padding test-padding)] - [nodes (graph-layout-nodes layout)] - [dnode-a (get-node 'a layout)] - [dnode-b (get-node 'b layout)] - [dnode-c (get-node 'c layout)] - [dnode-d (get-node 'd layout)] - [dnode-e (get-node 'e layout)]) - (check-equal? (graph-layout-width layout) 50) - (check-equal? (graph-layout-height layout) 50) - (check-equal? (drawable-node-x dnode-a) 20) - (check-equal? (drawable-node-y dnode-a) 5) - (check-equal? (drawable-node-x dnode-b) test-padding) - (check-equal? (drawable-node-y dnode-b) (+ (* 2 test-padding) test-width)) - (check-equal? (drawable-node-x dnode-c) (+ (* 2 test-padding) test-width)) - (check-equal? (drawable-node-y dnode-c) (drawable-node-y dnode-b)) - (check-equal? (drawable-node-x dnode-e) (+ (* 3 test-padding) (* 2 test-width))) - (check-equal? (drawable-node-y dnode-e) (drawable-node-y dnode-c)) - (check-equal? (drawable-node-x dnode-d) (drawable-node-x dnode-c)) - (check-equal? (drawable-node-y dnode-d) (+ (drawable-node-y dnode-c) test-padding test-width))) -(let ([atree (build-attr-tree tree3 0)]) - (check-equal? (attributed-node-num-leaves atree) 3)) - -#| - a - / | | \ - b c f g - / \ - d e -|# -(define tree4 (tree 'a - (tree 'b) - (tree 'c - (tree 'd) - (tree 'e)) - (tree 'f) - (tree 'g))) -(let* ([layout (draw-tree tree4 #:node-width test-width #:padding test-padding)] - [nodes (graph-layout-nodes layout)] - [dnode-a (get-node 'a layout)] - [dnode-b (get-node 'b layout)] - [dnode-c (get-node 'c layout)] - [dnode-d (get-node 'd layout)] - [dnode-e (get-node 'e layout)] - [dnode-f (get-node 'f layout)] - [dnode-g (get-node 'g layout)]) - (check-equal? (graph-layout-width layout) 80) - (check-equal? (graph-layout-height layout) 50) - (check-equal? (drawable-node-x dnode-b) test-padding) - (check-equal? (drawable-node-y dnode-b) (+ (drawable-node-y dnode-a) test-width test-padding)) - (check-equal? (drawable-node-y dnode-c) (drawable-node-y dnode-b)) - (check-equal? (drawable-node-x dnode-d) (+ (drawable-node-x dnode-b) test-width test-padding)) - (check-equal? (drawable-node-y dnode-d) (+ (drawable-node-y dnode-c) test-width test-padding)) - (check-equal? (drawable-node-x dnode-e) (+ (drawable-node-x dnode-d) test-width test-padding)) - (check-equal? (drawable-node-y dnode-e) (drawable-node-y dnode-d)) - (check-equal? (drawable-node-x dnode-f) (+ (drawable-node-x dnode-e) test-width test-padding)) - (check-equal? (drawable-node-y dnode-f) (drawable-node-y dnode-c)) - (check-equal? (drawable-node-x dnode-g) (+ (drawable-node-x dnode-f) test-width test-padding))) -(let ([atree (build-attr-tree tree4 0)]) - (check-equal? (attributed-node-num-leaves atree) 5)) - -#| -Layered-tree-draw example from Di Battista - a - / \ - b g - | / \ - c h k - | / \ - d i j - / \ - e f -|# -(define tree5 (tree 'a - (tree 'b - (tree 'c - (tree 'd - (tree 'e) - (tree 'f)))) - (tree 'g - (tree 'h - (tree 'i) - (tree 'j)) - (tree 'k)))) -(let* ([layout (draw-tree tree5 #:node-width test-width #:padding test-padding)] - [nodes (graph-layout-nodes layout)] - [dnode-a (get-node 'a layout)] - [dnode-b (get-node 'b layout)] - [dnode-c (get-node 'c layout)] - [dnode-d (get-node 'd layout)] - [dnode-e (get-node 'e layout)] - [dnode-f (get-node 'f layout)] - [dnode-g (get-node 'g layout)] - [dnode-h (get-node 'h layout)] - [dnode-i (get-node 'i layout)] - [dnode-j (get-node 'j layout)] - [dnode-k (get-node 'k layout)]) - (check-equal? (graph-layout-width layout) 80) - (check-equal? (graph-layout-height layout) 80) - (check-equal? (drawable-node-x dnode-e) test-padding) - (check-equal? (drawable-node-y dnode-e) 65) - (check-equal? (drawable-node-x dnode-f) (+ (drawable-node-x dnode-e) test-width test-padding)) - (check-equal? (drawable-node-x dnode-i) (+ (drawable-node-x dnode-f) test-width test-padding)) - (check-equal? (drawable-node-x dnode-j) (+ (drawable-node-x dnode-i) test-width test-padding)) - (check-equal? (drawable-node-x dnode-k) (+ (drawable-node-x dnode-j) test-width test-padding))) -(let ([atree (build-attr-tree tree5 0)]) - (check-equal? (attributed-node-num-leaves atree) 5)) - - - - - - - - - - - - \ No newline at end of file + (graph-layout-nodes layout)))) \ No newline at end of file diff --git a/collects/racket/future/private/visualizer-data.rkt b/collects/racket/future/private/visualizer-data.rkt index 94a054ba9b..6e6ded8172 100644 --- a/collects/racket/future/private/visualizer-data.rkt +++ b/collects/racket/future/private/visualizer-data.rkt @@ -8,15 +8,15 @@ "graph-drawing.rkt" (only-in '#%futures init-visualizer-tracking!)) -(provide (contract-out [start-performance-tracking! (-> void?)]) +(provide start-performance-tracking! (struct-out future-event) - (struct-out indexed-fevent) + (struct-out indexed-future-event) (struct-out trace) (struct-out process-timeline) (struct-out future-timeline) (struct-out event) (struct-out rtcall-info) - raw-log-output + timeline-events organize-output build-trace event-has-duration? @@ -44,7 +44,7 @@ ;Many future-events can be logged at what appears to be the same ;time, apparently because the time values don't have great enough precision ;to separate events which temporally occur close together. -(struct indexed-fevent (index fevent) #:transparent) +(struct indexed-future-event (index fevent) #:transparent) ;The whole trace, with a start/end time and list of process timelines (struct trace (start-time ;Absolute start time (in process milliseconds) @@ -68,12 +68,6 @@ sync-hash) ; op name --o--> number of syncs #:transparent) -;The timeline of events for a specific process -(struct timeline (id - start - end - events)) - ;(struct process-timeline timeline (proc-index)) (struct process-timeline (proc-id proc-index @@ -133,30 +127,30 @@ (define (relative-time trace abs-time) (- abs-time (trace-start-time trace))) -;Gets log output as a straight list, ordered according to when the -;message was logged -;;raw-log-output : uint -> (listof indexed-fevent) -(define (raw-log-output index) - (let ([info (sync/timeout 0 recv)]) +;Gets log events for an execution timeline +;;timeline-events : (listof indexed-future-event) +(define (timeline-events) + (let ([index 0] + [info (sync/timeout 0 recv)]) (if info (let ([v (vector-ref info 2)]) (if (future-event? v) - (cons (indexed-fevent index v) (raw-log-output (add1 index))) - (raw-log-output index))) + (cons (indexed-future-event index v) (timeline-events (add1 index))) + (timeline-events index))) '()))) ;Produces a vector of vectors, where each inner vector contains ;all the log output messages for a specific process -;;organize-output : (listof indexed-fevent) -> (vectorof (vectorof future-event)) +;;organize-output : (listof indexed-future-event) -> (vectorof (vectorof future-event)) (define (organize-output raw-log-output) (define unique-proc-ids (for/set ([ie (in-list raw-log-output)]) - (future-event-process-id (indexed-fevent-fevent ie)))) + (future-event-process-id (indexed-future-event-fevent ie)))) (for/vector ([procid (in-list (sort (set->list unique-proc-ids) <))]) (for/vector ([e (in-list raw-log-output)] - #:when (eq? procid (future-event-process-id (indexed-fevent-fevent e)))) + #:when (eq? procid (future-event-process-id (indexed-future-event-fevent e)))) e))) -;;build-trace : (listof indexed-fevent) -> trace +;;build-trace : (listof indexed-future-event) -> trace (define (build-trace log-output) (define data (organize-output log-output)) (define-values (start-time end-time unique-fids nblocks nsyncs) @@ -165,7 +159,7 @@ [unique-fids (set)] [nblocks 0] [nsyncs 0]) ([ie (in-list log-output)]) - (let* ([evt (indexed-fevent-fevent ie)] + (let* ([evt (indexed-future-event-fevent ie)] [fid (future-event-future-id evt)] [is-future-thread? (not (= (future-event-process-id evt) RT-THREAD-ID))]) (values @@ -190,16 +184,16 @@ (define tls (for/list ([proc-log-vec (in-vector data)] [i (in-naturals)]) (let* ([fst-ie (vector-ref proc-log-vec 0)] - [fst-log-msg (indexed-fevent-fevent fst-ie)]) + [fst-log-msg (indexed-future-event-fevent fst-ie)]) (process-timeline (future-event-process-id fst-log-msg) i (future-event-time fst-log-msg) - (future-event-time (indexed-fevent-fevent + (future-event-time (indexed-future-event-fevent (vector-ref proc-log-vec (sub1 (vector-length proc-log-vec))))) (for/list ([ie (in-vector proc-log-vec)] [j (in-naturals)]) - (let* ([evt (indexed-fevent-fevent ie)] + (let* ([evt (indexed-future-event-fevent ie)] [start (future-event-time evt)] [pos (cond [(zero? j) (if (= j (sub1 (vector-length proc-log-vec))) @@ -207,11 +201,11 @@ 'start)] [(= j (sub1 (vector-length proc-log-vec))) 'end] [else 'interior])]) - (event (indexed-fevent-index ie) + (event (indexed-future-event-index ie) start (if (or (equal? pos 'end) (equal? pos 'singleton)) start - (future-event-time (indexed-fevent-fevent + (future-event-time (indexed-future-event-fevent (vector-ref proc-log-vec (add1 j))))) (future-event-process-id evt) i diff --git a/collects/racket/future/private/visualizer-drawing.rkt b/collects/racket/future/private/visualizer-drawing.rkt index 98110b7d96..4b3ada59c2 100644 --- a/collects/racket/future/private/visualizer-drawing.rkt +++ b/collects/racket/future/private/visualizer-drawing.rkt @@ -10,19 +10,17 @@ "display.rkt" "constants.rkt") -(provide seg-in-vregion +(provide timeline-pict + timeline-pict-for-trace-data + timeline-overlay + seg-in-vregion calc-segments calc-ticks calc-row-mid-y find-seg-for-coords segment-edge segs-equal-or-later - build-timeline-pict - build-timeline-bmp-from-log - build-timeline-pict-from-log - build-timeline-overlay - build-timeline-with-overlay - build-timeline-bmp-with-overlay + creation-tree-pict draw-creategraph-pict zoom-level->factor graph-overlay-pict @@ -581,104 +579,59 @@ (loop next-targ-arr next) next-targ-arr))))))) - -;;timeline-bmp-from-log : (listof indexed-fevent) (or uint bool) (or uint bool) -> bitmap% -(define (build-timeline-bmp-from-log logs - #:max-width [max-width #f] - #:max-height [max-height #f]) - (define vregion (if (or (not max-width) (not max-height)) - #f - (viewable-region 0 - 0 - max-width - max-height))) - - (define p (build-timeline-pict-from-log logs vregion)) - (pict->bitmap p)) - -(define (truncate-bmp bmp width height) - (define w (min width (send bmp get-width))) - (define h (min height (send bmp get-height))) - (let ([buf (make-bytes (* width height 4))]) - (send bmp - get-argb-pixels - 0 - 0 - w - h - buf) - (let ([new-b (make-bitmap w h)]) - (send new-b - set-argb-pixels - 0 - 0 - w - h - buf) - new-b))) - -;;build-timeline-bmp-with-overlay : (listof indexed-fevent) uint vregion [uint] [uint] -> bitmap% -(define (build-timeline-bmp-with-overlay logs - event-index - vregion - #:max-width [max-width #f] - #:max-height [max-height #f]) - (define p (build-timeline-with-overlay logs event-index vregion)) - (define-values (w h) - (values (if max-width (min max-width (pict-width p)) (pict-width p)) - (if max-height (min max-height (pict-height p)) (pict-height p)))) - (truncate-bmp (pict->bitmap p) w h)) - - -;;build-timeline-pict-from-trace : trace viewable-region -> pict -(define (build-timeline-pict-from-trace tr vregion) +;;timeline-pict : (listof indexed-future-event) [viewable-region] [integer] -> pict +(define (timeline-pict logs + #:x [x #f] + #:y [y #f] + #:width [width #f] + #:height [height #f] + #:selected-event-index [selected-event-index #f]) + (define tr (build-trace logs)) (define-values (finfo segments) (calc-segments tr)) - (build-timeline-pict vregion - tr - finfo - segments)) + (define vregion (if x + (viewable-region x y width height) + (viewable-region 0 0 (frame-info-adjusted-width finfo) (frame-info-adjusted-height finfo)))) + (timeline-pict-for-trace-data vregion + tr + finfo + segments + #:selected-event-index selected-event-index)) -;;build-timeline-pict : (or viewable-region #f) trace frame-info (listof segment) -> pict -(define (build-timeline-pict vregion tr finfo segments) +;;timeline-pict : (or viewable-region #f) trace frame-info (listof segment) -> pict +(define (timeline-pict-for-trace-data vregion + tr + finfo + segments + #:selected-event-index [selected-event-index #f]) (define vr (if (not vregion) (viewable-region 0 0 (frame-info-adjusted-width finfo) (frame-info-adjusted-height finfo)) vregion)) - (for/fold ([pct (frame-bg vr finfo tr)]) - ([seg (in-list (filter (seg-in-vregion vr) segments))]) - (pin-over pct - (- (segment-x seg) (viewable-region-x vr)) - (- (segment-y seg) (viewable-region-y vr)) - (pict-for-segment seg)))) - -;;build-timeline-pict-from-log : (listof indexed-fevent) viewable-region -> pict -(define (build-timeline-pict-from-log logs vregion) - (build-timeline-pict-from-trace (build-trace logs) vregion)) - -;;build-timeline-with-overlay : (listof indexed-fevent) uint -> pict -(define (build-timeline-with-overlay logs event-index vregion) - (define tr (build-trace logs)) - (define-values (finfo segments) (calc-segments tr)) - (define timeline-p (build-timeline-pict vregion - tr - finfo - segments)) - (define overlay (build-timeline-overlay vregion - #f - (list-ref segments event-index) - finfo - tr)) - (pin-over timeline-p - 0 - 0 - overlay)) + (define tp (for/fold ([pct (frame-bg vr finfo tr)]) + ([seg (in-list (filter (seg-in-vregion vr) segments))]) + (pin-over pct + (- (segment-x seg) (viewable-region-x vr)) + (- (segment-y seg) (viewable-region-y vr)) + (pict-for-segment seg)))) + (cond + [selected-event-index + (define overlay (timeline-overlay vregion + #f + (list-ref segments selected-event-index) + finfo + tr)) + (pin-over tp + 0 + 0 + overlay)] + [else tp])) ;Draws the pict that is layered on top of the exec. timeline canvas ;to highlight a specific future's event sequence -;;build-timeline-overlay : uint uint (or segment #f) (or segment #f) frame-info trace -> pict -(define (build-timeline-overlay vregion tacked hovered finfo tr) +;;timeline-overlay : uint uint (or segment #f) (or segment #f) frame-info trace -> pict +(define (timeline-overlay vregion tacked hovered finfo tr) (define-values (width height) (values (viewable-region-width vregion) (viewable-region-height vregion))) (define base (blank (viewable-region-width vregion) @@ -755,6 +708,32 @@ (drawable-node-width dnode)) (colorize (text ntext) (create-graph-node-forecolor))))) +;;creation-tree-pict : (listof indexed-future-event) [enni] [enni] [enni] [enni] [enni] [enni] [enni] -> pict +(define (creation-tree-pict events + #:x [x #f] + #:y [y #f] + #:width [width #f] + #:height [height #f] + #:node-width [node-width #f] + #:padding [padding #f] + #:zoom [zoom CREATE-GRAPH-MIN-ZOOM]) + (define tr (build-trace events)) + (define node-diam (if node-width + node-width + CREATE-GRAPH-NODE-DIAMETER)) + (define graph-padding (if padding + padding + CREATE-GRAPH-PADDING)) + (define layout (draw-tree (trace-creation-tree tr) + #:node-width node-diam + #:padding graph-padding + #:zoom zoom)) + (define vregion (if x + (viewable-region x y width height) + #f)) + (draw-creategraph-pict vregion layout)) + + ;;draw-creategraph-pict : (or/c viewable-region #f) tree-layout -> pict ;; if vregion is #f, return a pict that includes the entire tree (define (draw-creategraph-pict vregion layout) diff --git a/collects/racket/future/private/visualizer-gui.rkt b/collects/racket/future/private/visualizer-gui.rkt index 7d51693c52..a9ce7c6589 100644 --- a/collects/racket/future/private/visualizer-gui.rkt +++ b/collects/racket/future/private/visualizer-gui.rkt @@ -9,8 +9,8 @@ "display.rkt" "constants.rkt") -(provide (contract-out [show-visualizer (-> void?)]) - show-visualizer-for-trace) +(provide show-visualizer + show-visualizer-for-events) ;;rebuild-mouse-index : frame-info trace (listof segment) -> interval-map of (range --> interval-map) (define (rebuild-mouse-index frameinfo tr segs) @@ -84,7 +84,8 @@ (values (min screen-w DEF-WINDOW-WIDTH) (min screen-h DEF-WINDOW-HEIGHT))) -(define (show-visualizer-for-trace logs) +;;show-visualizer-for-events : (listof indexed-fevent) -> void +(define (show-visualizer-for-events logs) ;If for some reason the log is empty, error (when (empty? logs) (error 'show-visualizer "No future log messages found.")) @@ -148,23 +149,21 @@ (define timeline-panel (new pict-canvas% [parent timeline-container] [redraw-on-resize #f] - [pict-builder (λ (vregion) (build-timeline-pict vregion the-trace frameinfo segments))] + [pict-builder (λ (vregion) (timeline-pict-for-trace-data vregion the-trace frameinfo segments))] [hover-handler (λ (x y vregion) - (let ([seg (find-seg-for-coords x y timeline-mouse-index)]) + (let ([seg (find-seg-for-coords x y timeline-mouse-index)]) (set! hover-seg seg) - ;(send timeline-panel set-redraw-overlay! #t) (post-event listener-table 'segment-hover timeline-panel seg)))] [click-handler (λ (x y vregion) (let ([seg (find-seg-for-coords x y timeline-mouse-index)]) - (set! tacked-seg seg) - ;(send timeline-panel set-redraw-overlay! #t) - (post-event listener-table 'segment-click timeline-panel seg)))] + (set! tacked-seg seg) + (post-event listener-table 'segment-click timeline-panel seg)))] [overlay-builder (λ (vregion scale-factor) - (build-timeline-overlay vregion - tacked-seg - hover-seg - frameinfo - the-trace))] + (timeline-overlay vregion + tacked-seg + hover-seg + frameinfo + the-trace))] [min-width 500] [min-height (inexact->exact (round (* winh .7)))] [style '(hscroll vscroll)] @@ -357,4 +356,4 @@ (send f show #t)) (define (show-visualizer) - (show-visualizer-for-trace (raw-log-output 0))) + (show-visualizer-for-events (timeline-events))) diff --git a/collects/racket/future/trace.rkt b/collects/racket/future/trace.rkt new file mode 100644 index 0000000000..1a84f75e9e --- /dev/null +++ b/collects/racket/future/trace.rkt @@ -0,0 +1,22 @@ +#lang racket/base +(require racket/contract + "private/visualizer-data.rkt") +(provide (struct-out future-event) + (struct-out indexed-future-event) + trace-futures + (contract-out + [start-performance-tracking! (-> void?)] + [timeline-events (-> (listof indexed-future-event?))] + [trace-futures-thunk ((-> any/c) . -> . (listof indexed-future-event?))])) + +(define-syntax-rule (trace-futures e ...) + (begin (start-performance-tracking!) + (begin (begin e ...) + (timeline-events)))) + +;;trace-futures-thunk : (-> any) -> (listof indexed-future-event) +(define (trace-futures-thunk thunk) + (start-performance-tracking!) + (begin + (thunk) + (timeline-events))) \ No newline at end of file diff --git a/collects/racket/future/visualizer.rkt b/collects/racket/future/visualizer.rkt index cbb8c5f7c4..e7974dc6b8 100644 --- a/collects/racket/future/visualizer.rkt +++ b/collects/racket/future/visualizer.rkt @@ -1,5 +1,51 @@ #lang racket/base -(require "private/visualizer-gui.rkt" - "private/visualizer-data.rkt") -(provide start-performance-tracking! - show-visualizer) \ No newline at end of file +(require racket/contract + slideshow/pict + racket/bool + racket/future/trace + "private/visualizer-gui.rkt" + "private/visualizer-drawing.rkt") +(provide visualize-futures + (contract-out + [show-visualizer (-> void?)] + [visualize-futures-thunk ((-> any/c) . -> . any/c)] + [show-visualizer-for-events ((listof indexed-future-event?) . -> . void?)] + [timeline-pict (->i ([indexed-fevents (listof indexed-future-event?)]) + (#:x [x (or/c #f exact-nonnegative-integer?)] + #:y [y (or/c #f exact-nonnegative-integer?)] + #:width [width (or/c #f exact-nonnegative-integer?)] + #:height [height (or/c #f exact-nonnegative-integer?)] + #:selected-event-index [i (or/c #f exact-nonnegative-integer?)]) + #:pre + (x y width height) + (implies (or x y width height) + (and x y width height)) + [p pict?])] + [creation-tree-pict (->i ([indexed-fevents (listof indexed-future-event?)]) + (#:x [x (or/c #f exact-nonnegative-integer?)] + #:y [y (or/c #f exact-nonnegative-integer?)] + #:width [width (or/c #f exact-nonnegative-integer?)] + #:height [height (or/c #f exact-nonnegative-integer?)] + #:node-width [node-width (or/c #f exact-nonnegative-integer?)] + #:padding [padding (or/c #f exact-nonnegative-integer?)] + #:zoom [zoom (between/c 1 5)]) + #:pre + (x y width height) + (implies (or x y width height) + (and x y width height)) + [p pict?])])) + +(define-syntax-rule (visualize-futures e ...) + (begin (start-performance-tracking!) + (begin0 (begin e ...) + (show-visualizer)))) + +;;visualize-futures-thunk : (-> any/c) -> any/c +(define (visualize-futures-thunk thunk) + (start-performance-tracking!) + (begin0 + (thunk) + (show-visualizer))) + + + \ No newline at end of file diff --git a/collects/scribblings/guide/futures.scrbl b/collects/scribblings/guide/futures.scrbl index 5ba685e522..ed78bed448 100644 --- a/collects/scribblings/guide/futures.scrbl +++ b/collects/scribblings/guide/futures.scrbl @@ -16,7 +16,7 @@ those constructs, however, is limited by several factors, and the current implementation is best suited to numerical tasks. @margin-note{Other functions, such as @racket[thread], support the -creation of reliably concurrent tasks. However, thread never run truly +creation of reliably concurrent tasks. However, threads never run truly in parallel, even if the hardware and operating system support parallelism.} @@ -109,13 +109,10 @@ To see why, use the @racketmodname[racket/future/visualizer], like this: @racketblock[ (require racket/future/visualizer) - (start-performance-tracking!) - - (let ([f (future (lambda () (mandelbrot 10000000 62 501 1000)))]) - (list (mandelbrot 10000000 62 500 1000) - (touch f))) - - (show-visualizer)] + (visualize-futures + (let ([f (future (lambda () (mandelbrot 10000000 62 501 1000)))]) + (list (mandelbrot 10000000 62 500 1000) + (touch f))))] This opens a window showing a graphical view of a trace of the computation. The upper-left portion of the window contains an execution timeline: @@ -123,113 +120,115 @@ The upper-left portion of the window contains an execution timeline: @(interaction-eval #:eval future-eval (define bad-log - (list (indexed-fevent 0 '#s(future-event #f 0 create 1334778390997.936 #f 1)) - (indexed-fevent 1 '#s(future-event 1 1 start-work 1334778390998.137 #f #f)) - (indexed-fevent 2 '#s(future-event 1 1 sync 1334778390998.145 #f #f)) - (indexed-fevent 3 '#s(future-event 1 0 sync 1334778391001.616 [allocate memory] #f)) - (indexed-fevent 4 '#s(future-event 1 0 result 1334778391001.629 #f #f)) - (indexed-fevent 5 '#s(future-event 1 1 result 1334778391001.643 #f #f)) - (indexed-fevent 6 '#s(future-event 1 1 block 1334778391001.653 #f #f)) - (indexed-fevent 7 '#s(future-event 1 1 suspend 1334778391001.658 #f #f)) - (indexed-fevent 8 '#s(future-event 1 1 end-work 1334778391001.658 #f #f)) - (indexed-fevent 9 '#s(future-event 1 0 block 1334778392134.226 > #f)) - (indexed-fevent 10 '#s(future-event 1 0 result 1334778392134.241 #f #f)) - (indexed-fevent 11 '#s(future-event 1 1 start-work 1334778392134.254 #f #f)) - (indexed-fevent 12 '#s(future-event 1 1 sync 1334778392134.339 #f #f)) - (indexed-fevent 13 '#s(future-event 1 0 sync 1334778392134.375 [allocate memory] #f)) - (indexed-fevent 14 '#s(future-event 1 0 result 1334778392134.38 #f #f)) - (indexed-fevent 15 '#s(future-event 1 1 result 1334778392134.387 #f #f)) - (indexed-fevent 16 '#s(future-event 1 1 block 1334778392134.39 #f #f)) - (indexed-fevent 17 '#s(future-event 1 1 suspend 1334778392134.391 #f #f)) - (indexed-fevent 18 '#s(future-event 1 1 end-work 1334778392134.391 #f #f)) - (indexed-fevent 19 '#s(future-event 1 0 touch-pause 1334778392134.432 #f #f)) - (indexed-fevent 20 '#s(future-event 1 0 touch-resume 1334778392134.433 #f #f)) - (indexed-fevent 21 '#s(future-event 1 0 block 1334778392134.533 * #f)) - (indexed-fevent 22 '#s(future-event 1 0 result 1334778392134.537 #f #f)) - (indexed-fevent 23 '#s(future-event 1 2 start-work 1334778392134.568 #f #f)) - (indexed-fevent 24 '#s(future-event 1 2 sync 1334778392134.57 #f #f)) - (indexed-fevent 25 '#s(future-event 1 0 touch-pause 1334778392134.587 #f #f)) - (indexed-fevent 26 '#s(future-event 1 0 touch-resume 1334778392134.587 #f #f)) - (indexed-fevent 27 '#s(future-event 1 0 block 1334778392134.6 [allocate memory] #f)) - (indexed-fevent 28 '#s(future-event 1 0 result 1334778392134.604 #f #f)) - (indexed-fevent 29 '#s(future-event 1 2 result 1334778392134.627 #f #f)) - (indexed-fevent 30 '#s(future-event 1 2 block 1334778392134.629 #f #f)) - (indexed-fevent 31 '#s(future-event 1 2 suspend 1334778392134.632 #f #f)) - (indexed-fevent 32 '#s(future-event 1 2 end-work 1334778392134.633 #f #f)) - (indexed-fevent 33 '#s(future-event 1 0 touch-pause 1334778392134.64 #f #f)) - (indexed-fevent 34 '#s(future-event 1 0 touch-resume 1334778392134.64 #f #f)) - (indexed-fevent 35 '#s(future-event 1 0 block 1334778392134.663 > #f)) - (indexed-fevent 36 '#s(future-event 1 0 result 1334778392134.666 #f #f)) - (indexed-fevent 37 '#s(future-event 1 1 start-work 1334778392134.673 #f #f)) - (indexed-fevent 38 '#s(future-event 1 1 block 1334778392134.676 #f #f)) - (indexed-fevent 39 '#s(future-event 1 1 suspend 1334778392134.677 #f #f)) - (indexed-fevent 40 '#s(future-event 1 1 end-work 1334778392134.677 #f #f)) - (indexed-fevent 41 '#s(future-event 1 0 touch-pause 1334778392134.704 #f #f)) - (indexed-fevent 42 '#s(future-event 1 0 touch-resume 1334778392134.704 #f #f)) - (indexed-fevent 43 '#s(future-event 1 0 block 1334778392134.727 * #f)) - (indexed-fevent 44 '#s(future-event 1 0 result 1334778392134.73 #f #f)) - (indexed-fevent 45 '#s(future-event 1 2 start-work 1334778392134.737 #f #f)) - (indexed-fevent 46 '#s(future-event 1 2 block 1334778392134.739 #f #f)) - (indexed-fevent 47 '#s(future-event 1 2 suspend 1334778392134.74 #f #f)) - (indexed-fevent 48 '#s(future-event 1 2 end-work 1334778392134.741 #f #f)) - (indexed-fevent 49 '#s(future-event 1 0 touch-pause 1334778392134.767 #f #f)) - (indexed-fevent 50 '#s(future-event 1 0 touch-resume 1334778392134.767 #f #f)) - (indexed-fevent 51 '#s(future-event 1 0 block 1334778392134.79 > #f)) - (indexed-fevent 52 '#s(future-event 1 0 result 1334778392134.793 #f #f)) - (indexed-fevent 53 '#s(future-event 1 1 start-work 1334778392134.799 #f #f)) - (indexed-fevent 54 '#s(future-event 1 1 block 1334778392134.801 #f #f)) - (indexed-fevent 55 '#s(future-event 1 1 suspend 1334778392134.802 #f #f)) - (indexed-fevent 56 '#s(future-event 1 1 end-work 1334778392134.803 #f #f)) - (indexed-fevent 57 '#s(future-event 1 0 touch-pause 1334778392134.832 #f #f)) - (indexed-fevent 58 '#s(future-event 1 0 touch-resume 1334778392134.832 #f #f)) - (indexed-fevent 59 '#s(future-event 1 0 block 1334778392134.854 * #f)) - (indexed-fevent 60 '#s(future-event 1 0 result 1334778392134.858 #f #f)) - (indexed-fevent 61 '#s(future-event 1 2 start-work 1334778392134.864 #f #f)) - (indexed-fevent 62 '#s(future-event 1 2 block 1334778392134.876 #f #f)) - (indexed-fevent 63 '#s(future-event 1 2 suspend 1334778392134.877 #f #f)) - (indexed-fevent 64 '#s(future-event 1 2 end-work 1334778392134.882 #f #f)) - (indexed-fevent 65 '#s(future-event 1 0 touch-pause 1334778392134.918 #f #f)) - (indexed-fevent 66 '#s(future-event 1 0 touch-resume 1334778392134.918 #f #f)) - (indexed-fevent 67 '#s(future-event 1 0 block 1334778392134.94 > #f)) - (indexed-fevent 68 '#s(future-event 1 0 result 1334778392134.943 #f #f)) - (indexed-fevent 69 '#s(future-event 1 1 start-work 1334778392134.949 #f #f)) - (indexed-fevent 70 '#s(future-event 1 1 block 1334778392134.952 #f #f)) - (indexed-fevent 71 '#s(future-event 1 1 suspend 1334778392134.953 #f #f)) - (indexed-fevent 72 '#s(future-event 1 1 end-work 1334778392134.96 #f #f)) - (indexed-fevent 73 '#s(future-event 1 0 touch-pause 1334778392134.991 #f #f)) - (indexed-fevent 74 '#s(future-event 1 0 touch-resume 1334778392134.991 #f #f)) - (indexed-fevent 75 '#s(future-event 1 0 block 1334778392135.013 * #f)) - (indexed-fevent 76 '#s(future-event 1 0 result 1334778392135.016 #f #f)) - (indexed-fevent 77 '#s(future-event 1 2 start-work 1334778392135.027 #f #f)) - (indexed-fevent 78 '#s(future-event 1 2 block 1334778392135.033 #f #f)) - (indexed-fevent 79 '#s(future-event 1 2 suspend 1334778392135.034 #f #f)) - (indexed-fevent 80 '#s(future-event 1 2 end-work 1334778392135.04 #f #f)) - (indexed-fevent 81 '#s(future-event 1 0 touch-pause 1334778392135.075 #f #f)) - (indexed-fevent 82 '#s(future-event 1 0 touch-resume 1334778392135.075 #f #f)) - (indexed-fevent 83 '#s(future-event 1 0 block 1334778392135.098 > #f)) - (indexed-fevent 84 '#s(future-event 1 0 result 1334778392135.101 #f #f)) - (indexed-fevent 85 '#s(future-event 1 1 start-work 1334778392135.107 #f #f)) - (indexed-fevent 86 '#s(future-event 1 1 block 1334778392135.117 #f #f)) - (indexed-fevent 87 '#s(future-event 1 1 suspend 1334778392135.118 #f #f)) - (indexed-fevent 88 '#s(future-event 1 1 end-work 1334778392135.123 #f #f)) - (indexed-fevent 89 '#s(future-event 1 0 touch-pause 1334778392135.159 #f #f)) - (indexed-fevent 90 '#s(future-event 1 0 touch-resume 1334778392135.159 #f #f)) - (indexed-fevent 91 '#s(future-event 1 0 block 1334778392135.181 * #f)) - (indexed-fevent 92 '#s(future-event 1 0 result 1334778392135.184 #f #f)) - (indexed-fevent 93 '#s(future-event 1 2 start-work 1334778392135.19 #f #f)) - (indexed-fevent 94 '#s(future-event 1 2 block 1334778392135.191 #f #f)) - (indexed-fevent 95 '#s(future-event 1 2 suspend 1334778392135.192 #f #f)) - (indexed-fevent 96 '#s(future-event 1 2 end-work 1334778392135.192 #f #f)) - (indexed-fevent 97 '#s(future-event 1 0 touch-pause 1334778392135.221 #f #f)) - (indexed-fevent 98 '#s(future-event 1 0 touch-resume 1334778392135.221 #f #f)) - (indexed-fevent 99 '#s(future-event 1 0 block 1334778392135.243 > #f)) + (list (indexed-future-event 0 '#s(future-event #f 0 create 1334778390997.936 #f 1)) + (indexed-future-event 1 '#s(future-event 1 1 start-work 1334778390998.137 #f #f)) + (indexed-future-event 2 '#s(future-event 1 1 sync 1334778390998.145 #f #f)) + (indexed-future-event 3 '#s(future-event 1 0 sync 1334778391001.616 [allocate memory] #f)) + (indexed-future-event 4 '#s(future-event 1 0 result 1334778391001.629 #f #f)) + (indexed-future-event 5 '#s(future-event 1 1 result 1334778391001.643 #f #f)) + (indexed-future-event 6 '#s(future-event 1 1 block 1334778391001.653 #f #f)) + (indexed-future-event 7 '#s(future-event 1 1 suspend 1334778391001.658 #f #f)) + (indexed-future-event 8 '#s(future-event 1 1 end-work 1334778391001.658 #f #f)) + (indexed-future-event 9 '#s(future-event 1 0 block 1334778392134.226 > #f)) + (indexed-future-event 10 '#s(future-event 1 0 result 1334778392134.241 #f #f)) + (indexed-future-event 11 '#s(future-event 1 1 start-work 1334778392134.254 #f #f)) + (indexed-future-event 12 '#s(future-event 1 1 sync 1334778392134.339 #f #f)) + (indexed-future-event 13 '#s(future-event 1 0 sync 1334778392134.375 [allocate memory] #f)) + (indexed-future-event 14 '#s(future-event 1 0 result 1334778392134.38 #f #f)) + (indexed-future-event 15 '#s(future-event 1 1 result 1334778392134.387 #f #f)) + (indexed-future-event 16 '#s(future-event 1 1 block 1334778392134.39 #f #f)) + (indexed-future-event 17 '#s(future-event 1 1 suspend 1334778392134.391 #f #f)) + (indexed-future-event 18 '#s(future-event 1 1 end-work 1334778392134.391 #f #f)) + (indexed-future-event 19 '#s(future-event 1 0 touch-pause 1334778392134.432 #f #f)) + (indexed-future-event 20 '#s(future-event 1 0 touch-resume 1334778392134.433 #f #f)) + (indexed-future-event 21 '#s(future-event 1 0 block 1334778392134.533 * #f)) + (indexed-future-event 22 '#s(future-event 1 0 result 1334778392134.537 #f #f)) + (indexed-future-event 23 '#s(future-event 1 2 start-work 1334778392134.568 #f #f)) + (indexed-future-event 24 '#s(future-event 1 2 sync 1334778392134.57 #f #f)) + (indexed-future-event 25 '#s(future-event 1 0 touch-pause 1334778392134.587 #f #f)) + (indexed-future-event 26 '#s(future-event 1 0 touch-resume 1334778392134.587 #f #f)) + (indexed-future-event 27 '#s(future-event 1 0 block 1334778392134.6 [allocate memory] #f)) + (indexed-future-event 28 '#s(future-event 1 0 result 1334778392134.604 #f #f)) + (indexed-future-event 29 '#s(future-event 1 2 result 1334778392134.627 #f #f)) + (indexed-future-event 30 '#s(future-event 1 2 block 1334778392134.629 #f #f)) + (indexed-future-event 31 '#s(future-event 1 2 suspend 1334778392134.632 #f #f)) + (indexed-future-event 32 '#s(future-event 1 2 end-work 1334778392134.633 #f #f)) + (indexed-future-event 33 '#s(future-event 1 0 touch-pause 1334778392134.64 #f #f)) + (indexed-future-event 34 '#s(future-event 1 0 touch-resume 1334778392134.64 #f #f)) + (indexed-future-event 35 '#s(future-event 1 0 block 1334778392134.663 > #f)) + (indexed-future-event 36 '#s(future-event 1 0 result 1334778392134.666 #f #f)) + (indexed-future-event 37 '#s(future-event 1 1 start-work 1334778392134.673 #f #f)) + (indexed-future-event 38 '#s(future-event 1 1 block 1334778392134.676 #f #f)) + (indexed-future-event 39 '#s(future-event 1 1 suspend 1334778392134.677 #f #f)) + (indexed-future-event 40 '#s(future-event 1 1 end-work 1334778392134.677 #f #f)) + (indexed-future-event 41 '#s(future-event 1 0 touch-pause 1334778392134.704 #f #f)) + (indexed-future-event 42 '#s(future-event 1 0 touch-resume 1334778392134.704 #f #f)) + (indexed-future-event 43 '#s(future-event 1 0 block 1334778392134.727 * #f)) + (indexed-future-event 44 '#s(future-event 1 0 result 1334778392134.73 #f #f)) + (indexed-future-event 45 '#s(future-event 1 2 start-work 1334778392134.737 #f #f)) + (indexed-future-event 46 '#s(future-event 1 2 block 1334778392134.739 #f #f)) + (indexed-future-event 47 '#s(future-event 1 2 suspend 1334778392134.74 #f #f)) + (indexed-future-event 48 '#s(future-event 1 2 end-work 1334778392134.741 #f #f)) + (indexed-future-event 49 '#s(future-event 1 0 touch-pause 1334778392134.767 #f #f)) + (indexed-future-event 50 '#s(future-event 1 0 touch-resume 1334778392134.767 #f #f)) + (indexed-future-event 51 '#s(future-event 1 0 block 1334778392134.79 > #f)) + (indexed-future-event 52 '#s(future-event 1 0 result 1334778392134.793 #f #f)) + (indexed-future-event 53 '#s(future-event 1 1 start-work 1334778392134.799 #f #f)) + (indexed-future-event 54 '#s(future-event 1 1 block 1334778392134.801 #f #f)) + (indexed-future-event 55 '#s(future-event 1 1 suspend 1334778392134.802 #f #f)) + (indexed-future-event 56 '#s(future-event 1 1 end-work 1334778392134.803 #f #f)) + (indexed-future-event 57 '#s(future-event 1 0 touch-pause 1334778392134.832 #f #f)) + (indexed-future-event 58 '#s(future-event 1 0 touch-resume 1334778392134.832 #f #f)) + (indexed-future-event 59 '#s(future-event 1 0 block 1334778392134.854 * #f)) + (indexed-future-event 60 '#s(future-event 1 0 result 1334778392134.858 #f #f)) + (indexed-future-event 61 '#s(future-event 1 2 start-work 1334778392134.864 #f #f)) + (indexed-future-event 62 '#s(future-event 1 2 block 1334778392134.876 #f #f)) + (indexed-future-event 63 '#s(future-event 1 2 suspend 1334778392134.877 #f #f)) + (indexed-future-event 64 '#s(future-event 1 2 end-work 1334778392134.882 #f #f)) + (indexed-future-event 65 '#s(future-event 1 0 touch-pause 1334778392134.918 #f #f)) + (indexed-future-event 66 '#s(future-event 1 0 touch-resume 1334778392134.918 #f #f)) + (indexed-future-event 67 '#s(future-event 1 0 block 1334778392134.94 > #f)) + (indexed-future-event 68 '#s(future-event 1 0 result 1334778392134.943 #f #f)) + (indexed-future-event 69 '#s(future-event 1 1 start-work 1334778392134.949 #f #f)) + (indexed-future-event 70 '#s(future-event 1 1 block 1334778392134.952 #f #f)) + (indexed-future-event 71 '#s(future-event 1 1 suspend 1334778392134.953 #f #f)) + (indexed-future-event 72 '#s(future-event 1 1 end-work 1334778392134.96 #f #f)) + (indexed-future-event 73 '#s(future-event 1 0 touch-pause 1334778392134.991 #f #f)) + (indexed-future-event 74 '#s(future-event 1 0 touch-resume 1334778392134.991 #f #f)) + (indexed-future-event 75 '#s(future-event 1 0 block 1334778392135.013 * #f)) + (indexed-future-event 76 '#s(future-event 1 0 result 1334778392135.016 #f #f)) + (indexed-future-event 77 '#s(future-event 1 2 start-work 1334778392135.027 #f #f)) + (indexed-future-event 78 '#s(future-event 1 2 block 1334778392135.033 #f #f)) + (indexed-future-event 79 '#s(future-event 1 2 suspend 1334778392135.034 #f #f)) + (indexed-future-event 80 '#s(future-event 1 2 end-work 1334778392135.04 #f #f)) + (indexed-future-event 81 '#s(future-event 1 0 touch-pause 1334778392135.075 #f #f)) + (indexed-future-event 82 '#s(future-event 1 0 touch-resume 1334778392135.075 #f #f)) + (indexed-future-event 83 '#s(future-event 1 0 block 1334778392135.098 > #f)) + (indexed-future-event 84 '#s(future-event 1 0 result 1334778392135.101 #f #f)) + (indexed-future-event 85 '#s(future-event 1 1 start-work 1334778392135.107 #f #f)) + (indexed-future-event 86 '#s(future-event 1 1 block 1334778392135.117 #f #f)) + (indexed-future-event 87 '#s(future-event 1 1 suspend 1334778392135.118 #f #f)) + (indexed-future-event 88 '#s(future-event 1 1 end-work 1334778392135.123 #f #f)) + (indexed-future-event 89 '#s(future-event 1 0 touch-pause 1334778392135.159 #f #f)) + (indexed-future-event 90 '#s(future-event 1 0 touch-resume 1334778392135.159 #f #f)) + (indexed-future-event 91 '#s(future-event 1 0 block 1334778392135.181 * #f)) + (indexed-future-event 92 '#s(future-event 1 0 result 1334778392135.184 #f #f)) + (indexed-future-event 93 '#s(future-event 1 2 start-work 1334778392135.19 #f #f)) + (indexed-future-event 94 '#s(future-event 1 2 block 1334778392135.191 #f #f)) + (indexed-future-event 95 '#s(future-event 1 2 suspend 1334778392135.192 #f #f)) + (indexed-future-event 96 '#s(future-event 1 2 end-work 1334778392135.192 #f #f)) + (indexed-future-event 97 '#s(future-event 1 0 touch-pause 1334778392135.221 #f #f)) + (indexed-future-event 98 '#s(future-event 1 0 touch-resume 1334778392135.221 #f #f)) + (indexed-future-event 99 '#s(future-event 1 0 block 1334778392135.243 > #f)) ))) @interaction-eval-show[ #:eval future-eval - (build-timeline-bmp-from-log bad-log - #:max-width 600 - #:max-height 300) + (timeline-pict bad-log + #:x 0 + #:y 0 + #:width 600 + #:height 300) ] Each horizontal row represents an OS-level thread, and the colored @@ -262,10 +261,12 @@ This image shows those connections for our future. @interaction-eval-show[ #:eval future-eval - (build-timeline-bmp-with-overlay bad-log - 6 - #:max-width 600 - #:max-height 300) + (timeline-pict bad-log + #:x 0 + #:y 0 + #:width 600 + #:height 300 + #:selected-event-index 6) ] The dotted orange line connects the first event in the future to @@ -303,112 +304,116 @@ slow-path operation limiting our parallelism (orange dots): @interaction-eval[ #:eval future-eval (define better-log - (list (indexed-fevent 0 '#s(future-event #f 0 create 1334779296782.22 #f 2)) - (indexed-fevent 1 '#s(future-event 2 2 start-work 1334779296782.265 #f #f)) - (indexed-fevent 2 '#s(future-event 2 2 sync 1334779296782.378 #f #f)) - (indexed-fevent 3 '#s(future-event 2 0 sync 1334779296795.582 [allocate memory] #f)) - (indexed-fevent 4 '#s(future-event 2 0 result 1334779296795.587 #f #f)) - (indexed-fevent 5 '#s(future-event 2 2 result 1334779296795.6 #f #f)) - (indexed-fevent 6 '#s(future-event 2 2 sync 1334779296795.689 #f #f)) - (indexed-fevent 7 '#s(future-event 2 0 sync 1334779296795.807 [allocate memory] #f)) - (indexed-fevent 8 '#s(future-event 2 0 result 1334779296795.812 #f #f)) - (indexed-fevent 9 '#s(future-event 2 2 result 1334779296795.818 #f #f)) - (indexed-fevent 10 '#s(future-event 2 2 sync 1334779296795.827 #f #f)) - (indexed-fevent 11 '#s(future-event 2 0 sync 1334779296806.627 [allocate memory] #f)) - (indexed-fevent 12 '#s(future-event 2 0 result 1334779296806.635 #f #f)) - (indexed-fevent 13 '#s(future-event 2 2 result 1334779296806.646 #f #f)) - (indexed-fevent 14 '#s(future-event 2 2 sync 1334779296806.879 #f #f)) - (indexed-fevent 15 '#s(future-event 2 0 sync 1334779296806.994 [allocate memory] #f)) - (indexed-fevent 16 '#s(future-event 2 0 result 1334779296806.999 #f #f)) - (indexed-fevent 17 '#s(future-event 2 2 result 1334779296807.007 #f #f)) - (indexed-fevent 18 '#s(future-event 2 2 sync 1334779296807.023 #f #f)) - (indexed-fevent 19 '#s(future-event 2 0 sync 1334779296814.198 [allocate memory] #f)) - (indexed-fevent 20 '#s(future-event 2 0 result 1334779296814.206 #f #f)) - (indexed-fevent 21 '#s(future-event 2 2 result 1334779296814.221 #f #f)) - (indexed-fevent 22 '#s(future-event 2 2 sync 1334779296814.29 #f #f)) - (indexed-fevent 23 '#s(future-event 2 0 sync 1334779296820.796 [allocate memory] #f)) - (indexed-fevent 24 '#s(future-event 2 0 result 1334779296820.81 #f #f)) - (indexed-fevent 25 '#s(future-event 2 2 result 1334779296820.835 #f #f)) - (indexed-fevent 26 '#s(future-event 2 2 sync 1334779296821.089 #f #f)) - (indexed-fevent 27 '#s(future-event 2 0 sync 1334779296825.217 [allocate memory] #f)) - (indexed-fevent 28 '#s(future-event 2 0 result 1334779296825.226 #f #f)) - (indexed-fevent 29 '#s(future-event 2 2 result 1334779296825.242 #f #f)) - (indexed-fevent 30 '#s(future-event 2 2 sync 1334779296825.305 #f #f)) - (indexed-fevent 31 '#s(future-event 2 0 sync 1334779296832.541 [allocate memory] #f)) - (indexed-fevent 32 '#s(future-event 2 0 result 1334779296832.549 #f #f)) - (indexed-fevent 33 '#s(future-event 2 2 result 1334779296832.562 #f #f)) - (indexed-fevent 34 '#s(future-event 2 2 sync 1334779296832.667 #f #f)) - (indexed-fevent 35 '#s(future-event 2 0 sync 1334779296836.269 [allocate memory] #f)) - (indexed-fevent 36 '#s(future-event 2 0 result 1334779296836.278 #f #f)) - (indexed-fevent 37 '#s(future-event 2 2 result 1334779296836.326 #f #f)) - (indexed-fevent 38 '#s(future-event 2 2 sync 1334779296836.396 #f #f)) - (indexed-fevent 39 '#s(future-event 2 0 sync 1334779296843.481 [allocate memory] #f)) - (indexed-fevent 40 '#s(future-event 2 0 result 1334779296843.49 #f #f)) - (indexed-fevent 41 '#s(future-event 2 2 result 1334779296843.501 #f #f)) - (indexed-fevent 42 '#s(future-event 2 2 sync 1334779296843.807 #f #f)) - (indexed-fevent 43 '#s(future-event 2 0 sync 1334779296847.291 [allocate memory] #f)) - (indexed-fevent 44 '#s(future-event 2 0 result 1334779296847.3 #f #f)) - (indexed-fevent 45 '#s(future-event 2 2 result 1334779296847.312 #f #f)) - (indexed-fevent 46 '#s(future-event 2 2 sync 1334779296847.375 #f #f)) - (indexed-fevent 47 '#s(future-event 2 0 sync 1334779296854.487 [allocate memory] #f)) - (indexed-fevent 48 '#s(future-event 2 0 result 1334779296854.495 #f #f)) - (indexed-fevent 49 '#s(future-event 2 2 result 1334779296854.507 #f #f)) - (indexed-fevent 50 '#s(future-event 2 2 sync 1334779296854.656 #f #f)) - (indexed-fevent 51 '#s(future-event 2 0 sync 1334779296857.374 [allocate memory] #f)) - (indexed-fevent 52 '#s(future-event 2 0 result 1334779296857.383 #f #f)) - (indexed-fevent 53 '#s(future-event 2 2 result 1334779296857.421 #f #f)) - (indexed-fevent 54 '#s(future-event 2 2 sync 1334779296857.488 #f #f)) - (indexed-fevent 55 '#s(future-event 2 0 sync 1334779296869.919 [allocate memory] #f)) - (indexed-fevent 56 '#s(future-event 2 0 result 1334779296869.947 #f #f)) - (indexed-fevent 57 '#s(future-event 2 2 result 1334779296869.981 #f #f)) - (indexed-fevent 58 '#s(future-event 2 2 sync 1334779296870.32 #f #f)) - (indexed-fevent 59 '#s(future-event 2 0 sync 1334779296879.438 [allocate memory] #f)) - (indexed-fevent 60 '#s(future-event 2 0 result 1334779296879.446 #f #f)) - (indexed-fevent 61 '#s(future-event 2 2 result 1334779296879.463 #f #f)) - (indexed-fevent 62 '#s(future-event 2 2 sync 1334779296879.526 #f #f)) - (indexed-fevent 63 '#s(future-event 2 0 sync 1334779296882.928 [allocate memory] #f)) - (indexed-fevent 64 '#s(future-event 2 0 result 1334779296882.935 #f #f)) - (indexed-fevent 65 '#s(future-event 2 2 result 1334779296882.944 #f #f)) - (indexed-fevent 66 '#s(future-event 2 2 sync 1334779296883.311 #f #f)) - (indexed-fevent 67 '#s(future-event 2 0 sync 1334779296890.471 [allocate memory] #f)) - (indexed-fevent 68 '#s(future-event 2 0 result 1334779296890.479 #f #f)) - (indexed-fevent 69 '#s(future-event 2 2 result 1334779296890.517 #f #f)) - (indexed-fevent 70 '#s(future-event 2 2 sync 1334779296890.581 #f #f)) - (indexed-fevent 71 '#s(future-event 2 0 sync 1334779296894.362 [allocate memory] #f)) - (indexed-fevent 72 '#s(future-event 2 0 result 1334779296894.369 #f #f)) - (indexed-fevent 73 '#s(future-event 2 2 result 1334779296894.382 #f #f)) - (indexed-fevent 74 '#s(future-event 2 2 sync 1334779296894.769 #f #f)) - (indexed-fevent 75 '#s(future-event 2 0 sync 1334779296901.501 [allocate memory] #f)) - (indexed-fevent 76 '#s(future-event 2 0 result 1334779296901.51 #f #f)) - (indexed-fevent 77 '#s(future-event 2 2 result 1334779296901.556 #f #f)) - (indexed-fevent 78 '#s(future-event 2 2 sync 1334779296901.62 #f #f)) - (indexed-fevent 79 '#s(future-event 2 0 sync 1334779296905.428 [allocate memory] #f)) - (indexed-fevent 80 '#s(future-event 2 0 result 1334779296905.434 #f #f)) - (indexed-fevent 81 '#s(future-event 2 2 result 1334779296905.447 #f #f)) - (indexed-fevent 82 '#s(future-event 2 2 sync 1334779296905.743 #f #f)) - (indexed-fevent 83 '#s(future-event 2 0 sync 1334779296912.538 [allocate memory] #f)) - (indexed-fevent 84 '#s(future-event 2 0 result 1334779296912.547 #f #f)) - (indexed-fevent 85 '#s(future-event 2 2 result 1334779296912.564 #f #f)) - (indexed-fevent 86 '#s(future-event 2 2 sync 1334779296912.625 #f #f)) - (indexed-fevent 87 '#s(future-event 2 0 sync 1334779296916.094 [allocate memory] #f)) - (indexed-fevent 88 '#s(future-event 2 0 result 1334779296916.1 #f #f)) - (indexed-fevent 89 '#s(future-event 2 2 result 1334779296916.108 #f #f)) - (indexed-fevent 90 '#s(future-event 2 2 sync 1334779296916.243 #f #f)) - (indexed-fevent 91 '#s(future-event 2 0 sync 1334779296927.233 [allocate memory] #f)) - (indexed-fevent 92 '#s(future-event 2 0 result 1334779296927.242 #f #f)) - (indexed-fevent 93 '#s(future-event 2 2 result 1334779296927.262 #f #f)) - (indexed-fevent 94 '#s(future-event 2 2 sync 1334779296927.59 #f #f)) - (indexed-fevent 95 '#s(future-event 2 0 sync 1334779296934.603 [allocate memory] #f)) - (indexed-fevent 96 '#s(future-event 2 0 result 1334779296934.612 #f #f)) - (indexed-fevent 97 '#s(future-event 2 2 result 1334779296934.655 #f #f)) - (indexed-fevent 98 '#s(future-event 2 2 sync 1334779296934.72 #f #f)) - (indexed-fevent 99 '#s(future-event 2 0 sync 1334779296938.773 [allocate memory] #f)) + (list (indexed-future-event 0 '#s(future-event #f 0 create 1334779296782.22 #f 2)) + (indexed-future-event 1 '#s(future-event 2 2 start-work 1334779296782.265 #f #f)) + (indexed-future-event 2 '#s(future-event 2 2 sync 1334779296782.378 #f #f)) + (indexed-future-event 3 '#s(future-event 2 0 sync 1334779296795.582 [allocate memory] #f)) + (indexed-future-event 4 '#s(future-event 2 0 result 1334779296795.587 #f #f)) + (indexed-future-event 5 '#s(future-event 2 2 result 1334779296795.6 #f #f)) + (indexed-future-event 6 '#s(future-event 2 2 sync 1334779296795.689 #f #f)) + (indexed-future-event 7 '#s(future-event 2 0 sync 1334779296795.807 [allocate memory] #f)) + (indexed-future-event 8 '#s(future-event 2 0 result 1334779296795.812 #f #f)) + (indexed-future-event 9 '#s(future-event 2 2 result 1334779296795.818 #f #f)) + (indexed-future-event 10 '#s(future-event 2 2 sync 1334779296795.827 #f #f)) + (indexed-future-event 11 '#s(future-event 2 0 sync 1334779296806.627 [allocate memory] #f)) + (indexed-future-event 12 '#s(future-event 2 0 result 1334779296806.635 #f #f)) + (indexed-future-event 13 '#s(future-event 2 2 result 1334779296806.646 #f #f)) + (indexed-future-event 14 '#s(future-event 2 2 sync 1334779296806.879 #f #f)) + (indexed-future-event 15 '#s(future-event 2 0 sync 1334779296806.994 [allocate memory] #f)) + (indexed-future-event 16 '#s(future-event 2 0 result 1334779296806.999 #f #f)) + (indexed-future-event 17 '#s(future-event 2 2 result 1334779296807.007 #f #f)) + (indexed-future-event 18 '#s(future-event 2 2 sync 1334779296807.023 #f #f)) + (indexed-future-event 19 '#s(future-event 2 0 sync 1334779296814.198 [allocate memory] #f)) + (indexed-future-event 20 '#s(future-event 2 0 result 1334779296814.206 #f #f)) + (indexed-future-event 21 '#s(future-event 2 2 result 1334779296814.221 #f #f)) + (indexed-future-event 22 '#s(future-event 2 2 sync 1334779296814.29 #f #f)) + (indexed-future-event 23 '#s(future-event 2 0 sync 1334779296820.796 [allocate memory] #f)) + (indexed-future-event 24 '#s(future-event 2 0 result 1334779296820.81 #f #f)) + (indexed-future-event 25 '#s(future-event 2 2 result 1334779296820.835 #f #f)) + (indexed-future-event 26 '#s(future-event 2 2 sync 1334779296821.089 #f #f)) + (indexed-future-event 27 '#s(future-event 2 0 sync 1334779296825.217 [allocate memory] #f)) + (indexed-future-event 28 '#s(future-event 2 0 result 1334779296825.226 #f #f)) + (indexed-future-event 29 '#s(future-event 2 2 result 1334779296825.242 #f #f)) + (indexed-future-event 30 '#s(future-event 2 2 sync 1334779296825.305 #f #f)) + (indexed-future-event 31 '#s(future-event 2 0 sync 1334779296832.541 [allocate memory] #f)) + (indexed-future-event 32 '#s(future-event 2 0 result 1334779296832.549 #f #f)) + (indexed-future-event 33 '#s(future-event 2 2 result 1334779296832.562 #f #f)) + (indexed-future-event 34 '#s(future-event 2 2 sync 1334779296832.667 #f #f)) + (indexed-future-event 35 '#s(future-event 2 0 sync 1334779296836.269 [allocate memory] #f)) + (indexed-future-event 36 '#s(future-event 2 0 result 1334779296836.278 #f #f)) + (indexed-future-event 37 '#s(future-event 2 2 result 1334779296836.326 #f #f)) + (indexed-future-event 38 '#s(future-event 2 2 sync 1334779296836.396 #f #f)) + (indexed-future-event 39 '#s(future-event 2 0 sync 1334779296843.481 [allocate memory] #f)) + (indexed-future-event 40 '#s(future-event 2 0 result 1334779296843.49 #f #f)) + (indexed-future-event 41 '#s(future-event 2 2 result 1334779296843.501 #f #f)) + (indexed-future-event 42 '#s(future-event 2 2 sync 1334779296843.807 #f #f)) + (indexed-future-event 43 '#s(future-event 2 0 sync 1334779296847.291 [allocate memory] #f)) + (indexed-future-event 44 '#s(future-event 2 0 result 1334779296847.3 #f #f)) + (indexed-future-event 45 '#s(future-event 2 2 result 1334779296847.312 #f #f)) + (indexed-future-event 46 '#s(future-event 2 2 sync 1334779296847.375 #f #f)) + (indexed-future-event 47 '#s(future-event 2 0 sync 1334779296854.487 [allocate memory] #f)) + (indexed-future-event 48 '#s(future-event 2 0 result 1334779296854.495 #f #f)) + (indexed-future-event 49 '#s(future-event 2 2 result 1334779296854.507 #f #f)) + (indexed-future-event 50 '#s(future-event 2 2 sync 1334779296854.656 #f #f)) + (indexed-future-event 51 '#s(future-event 2 0 sync 1334779296857.374 [allocate memory] #f)) + (indexed-future-event 52 '#s(future-event 2 0 result 1334779296857.383 #f #f)) + (indexed-future-event 53 '#s(future-event 2 2 result 1334779296857.421 #f #f)) + (indexed-future-event 54 '#s(future-event 2 2 sync 1334779296857.488 #f #f)) + (indexed-future-event 55 '#s(future-event 2 0 sync 1334779296869.919 [allocate memory] #f)) + (indexed-future-event 56 '#s(future-event 2 0 result 1334779296869.947 #f #f)) + (indexed-future-event 57 '#s(future-event 2 2 result 1334779296869.981 #f #f)) + (indexed-future-event 58 '#s(future-event 2 2 sync 1334779296870.32 #f #f)) + (indexed-future-event 59 '#s(future-event 2 0 sync 1334779296879.438 [allocate memory] #f)) + (indexed-future-event 60 '#s(future-event 2 0 result 1334779296879.446 #f #f)) + (indexed-future-event 61 '#s(future-event 2 2 result 1334779296879.463 #f #f)) + (indexed-future-event 62 '#s(future-event 2 2 sync 1334779296879.526 #f #f)) + (indexed-future-event 63 '#s(future-event 2 0 sync 1334779296882.928 [allocate memory] #f)) + (indexed-future-event 64 '#s(future-event 2 0 result 1334779296882.935 #f #f)) + (indexed-future-event 65 '#s(future-event 2 2 result 1334779296882.944 #f #f)) + (indexed-future-event 66 '#s(future-event 2 2 sync 1334779296883.311 #f #f)) + (indexed-future-event 67 '#s(future-event 2 0 sync 1334779296890.471 [allocate memory] #f)) + (indexed-future-event 68 '#s(future-event 2 0 result 1334779296890.479 #f #f)) + (indexed-future-event 69 '#s(future-event 2 2 result 1334779296890.517 #f #f)) + (indexed-future-event 70 '#s(future-event 2 2 sync 1334779296890.581 #f #f)) + (indexed-future-event 71 '#s(future-event 2 0 sync 1334779296894.362 [allocate memory] #f)) + (indexed-future-event 72 '#s(future-event 2 0 result 1334779296894.369 #f #f)) + (indexed-future-event 73 '#s(future-event 2 2 result 1334779296894.382 #f #f)) + (indexed-future-event 74 '#s(future-event 2 2 sync 1334779296894.769 #f #f)) + (indexed-future-event 75 '#s(future-event 2 0 sync 1334779296901.501 [allocate memory] #f)) + (indexed-future-event 76 '#s(future-event 2 0 result 1334779296901.51 #f #f)) + (indexed-future-event 77 '#s(future-event 2 2 result 1334779296901.556 #f #f)) + (indexed-future-event 78 '#s(future-event 2 2 sync 1334779296901.62 #f #f)) + (indexed-future-event 79 '#s(future-event 2 0 sync 1334779296905.428 [allocate memory] #f)) + (indexed-future-event 80 '#s(future-event 2 0 result 1334779296905.434 #f #f)) + (indexed-future-event 81 '#s(future-event 2 2 result 1334779296905.447 #f #f)) + (indexed-future-event 82 '#s(future-event 2 2 sync 1334779296905.743 #f #f)) + (indexed-future-event 83 '#s(future-event 2 0 sync 1334779296912.538 [allocate memory] #f)) + (indexed-future-event 84 '#s(future-event 2 0 result 1334779296912.547 #f #f)) + (indexed-future-event 85 '#s(future-event 2 2 result 1334779296912.564 #f #f)) + (indexed-future-event 86 '#s(future-event 2 2 sync 1334779296912.625 #f #f)) + (indexed-future-event 87 '#s(future-event 2 0 sync 1334779296916.094 [allocate memory] #f)) + (indexed-future-event 88 '#s(future-event 2 0 result 1334779296916.1 #f #f)) + (indexed-future-event 89 '#s(future-event 2 2 result 1334779296916.108 #f #f)) + (indexed-future-event 90 '#s(future-event 2 2 sync 1334779296916.243 #f #f)) + (indexed-future-event 91 '#s(future-event 2 0 sync 1334779296927.233 [allocate memory] #f)) + (indexed-future-event 92 '#s(future-event 2 0 result 1334779296927.242 #f #f)) + (indexed-future-event 93 '#s(future-event 2 2 result 1334779296927.262 #f #f)) + (indexed-future-event 94 '#s(future-event 2 2 sync 1334779296927.59 #f #f)) + (indexed-future-event 95 '#s(future-event 2 0 sync 1334779296934.603 [allocate memory] #f)) + (indexed-future-event 96 '#s(future-event 2 0 result 1334779296934.612 #f #f)) + (indexed-future-event 97 '#s(future-event 2 2 result 1334779296934.655 #f #f)) + (indexed-future-event 98 '#s(future-event 2 2 sync 1334779296934.72 #f #f)) + (indexed-future-event 99 '#s(future-event 2 0 sync 1334779296938.773 [allocate memory] #f)) )) ] @interaction-eval-show[ #:eval future-eval - (build-timeline-bmp-from-log better-log #:max-width 600 #:max-height 300) + (timeline-pict better-log + #:x 0 + #:y 0 + #:width 600 + #:height 300) ] The problem is that most every arithmetic operation in this example @@ -424,10 +429,10 @@ much less allocation: @interaction-eval[ #:eval future-eval (define good-log - (list (indexed-fevent 0 '#s(future-event #f 0 create 1334778395768.733 #f 3)) - (indexed-fevent 1 '#s(future-event 3 2 start-work 1334778395768.771 #f #f)) - (indexed-fevent 2 '#s(future-event 3 2 complete 1334778395864.648 #f #f)) - (indexed-fevent 3 '#s(future-event 3 2 end-work 1334778395864.652 #f #f)) + (list (indexed-future-event 0 '#s(future-event #f 0 create 1334778395768.733 #f 3)) + (indexed-future-event 1 '#s(future-event 3 2 start-work 1334778395768.771 #f #f)) + (indexed-future-event 2 '#s(future-event 3 2 complete 1334778395864.648 #f #f)) + (indexed-future-event 3 '#s(future-event 3 2 end-work 1334778395864.652 #f #f)) )) ] @@ -454,9 +459,11 @@ Executing this program yields the following in the visualizer: @interaction-eval-show[ #:eval future-eval - (build-timeline-bmp-from-log good-log - #:max-width 600 - #:max-height 300) + (timeline-pict good-log + #:x 0 + #:y 0 + #:width 600 + #:height 300) ] Notice that only one green bar is shown here because one of the diff --git a/collects/scribblings/reference/concurrency.scrbl b/collects/scribblings/reference/concurrency.scrbl index bb544e7a20..5f9824a637 100644 --- a/collects/scribblings/reference/concurrency.scrbl +++ b/collects/scribblings/reference/concurrency.scrbl @@ -18,5 +18,6 @@ support for parallelism to improve performance. @include-section["thread-local.scrbl"] @include-section["futures.scrbl"] @include-section["futures-visualizer.scrbl"] +@include-section["futures-trace.scrbl"] @include-section["places.scrbl"] @include-section["distributed.scrbl"] diff --git a/collects/scribblings/reference/futures-trace.scrbl b/collects/scribblings/reference/futures-trace.scrbl new file mode 100644 index 0000000000..235bd7c278 --- /dev/null +++ b/collects/scribblings/reference/futures-trace.scrbl @@ -0,0 +1,207 @@ +#lang scribble/doc +@(require "mz.rkt" (for-label racket/future racket/future/trace)) + +@title[#:tag "futures-trace"]{Futures Tracing} + +@guideintro["effective-futures"]{the future visualizer} + +@defmodule[racket/future/trace] + +The @deftech{futures trace} module exposes low-level information about +the execution of parallel programs written using @racket[future]. + +@deftogether[( + @defform[(trace-futures e ...)] + @defproc[(trace-futures-thunk [thunk (-> any)]) (listof indexed-future-event?)] +)]{ + The @racket[trace-futures] macro and @racket[trace-futures-thunk] function + track the execution of a program using futures and return the program + trace as a list of @racket[indexed-future-event] structures. + + This program: + + @racketblock[ + (require racket/future + racket/future/trace) + + (trace-futures + (let ([f (future (lambda () ...))]) + ... + (touch f))) + ] + + Is equivalent to: + + @racketblock[ + (require racket/future + racket/future/trace) + + (start-performance-tracking!) + (let ([f (future (lambda () ...))]) + ... + (touch f)) + + (timeline-events) + ] +} + +@deftogether[( + @defproc[(start-performance-tracking!) void?] + @defproc[(timeline-events) (listof indexed-future-event?)] +)]{ + The @racket[start-performance-tracking!] procedure enables the collection + of future-related execution data. This function should be called immediately + prior to executing code the programmer wishes to profile. + + The @racket[timeline-events] procedure returns the program trace as + a list of @racket[indexed-future-event] structures. +} + +@defstruct[indexed-future-event ([index exact-nonnegative-integer?] + [event future-event?])]{ + Represents an individual log message in a program trace. Because multiple + @racket[future-event] structures may contain identical timestamps, the + @racket[index] field ranks them in the order in which they were recorded + in the log output. +} + +@; ------------------------------------------------------------ + +@section[#:tag "future-logging"]{Future Performance Logging} + +Racket traces use logging (see @secref["logging"]) extensively to +report information about how futures are evaluated. Logging output is +useful for debugging the performance of programs that use futures. + +Though textual log output can be viewed directly (or retrieved in +code via @racket[trace-futures]), it is much +easier to use the graphical profiler tool provided by +@racketmodname[racket/future/visualizer]. + +In addition to its string message, each event logged for a future has +a data value that is an instance of a @racket[future-event] +@tech{prefab} structure: + +@defstruct[future-event ([future-id (or exact-nonnegative-integer? #f)] + [proc-id exact-nonnegative-integer?] + [action symbol?] + [time-id real?] + [prim-name (or symbol? #f)] + [user-data (or #f symbol? exact-nonnegative-integer?)]) + #:prefab] + +The @racket[future-id] field is an exact integer that identifies a +future, or it is @racket[#f] when @racket[action] is +@racket['missing]. The @racket[future-id] field is particularly useful +for correlating logged events. + +The @racket[proc-id] fields is an exact, non-negative integer that +identifies a parallel process. Process 0 is the main Racket process, +where all expressions other than future thunks evaluate. + +The @racket[time-id] field is an inexact number that represents time in +the same way as @racket[current-inexact-milliseconds]. + +The @racket[action] field is a symbol: + +@itemlist[ + + @item{@racket['create]: a future was created.} + + @item{@racket['complete]: a future's thunk evaluated successfully, so + that @racket[touch] will produce a value for the future + immediately.} + + @item{@racket['start-work] and @racket['end-work]: a particular + process started and ended working on a particular future.} + + @item{@racket['start-0-work]: like @racket['start-work], but for a + future thunk that for some structural reason could not be + started in a process other than 0 (e.g., the thunk requires too + much local storage to start).} + + @item{@racket['start-overflow-work]: like @racket['start-work], where + the future thunk's work was previously stopped due to an + internal stack overflow.} + + @item{@racket['sync]: blocking (processes other than 0) or initiation + of handing (process 0) for an ``unsafe'' operation in a future + thunk's evaluation; the operation must run in process 0.} + + @item{@racket['block]: like @racket['sync], but for a part of + evaluation that must be delayed until the future is + @racket[touch]ed, because the evaluation may depend on the + current continuation.} + + @item{@racket['touch] (never in process 0): like @racket['sync] or + @racket['block], but for a @racket[touch] operation within a + future thunk.} + + @item{@racket['overflow] (never in process 0): like @racket['sync] or + @racket['block], but for the case that a process encountered an + internal stack overflow while evaluating a future thunk.} + + @item{@racket['result] or @racket['abort]: waiting or handling for + @racket['sync], @racket['block], or @racket['touch] ended with + a value or an error, respectively.} + + @item{@racket['suspend] (never in process 0): a process blocked by + @racket['sync], @racket['block], or @racket['touch] abandoned + evaluation of a future; some other process may pick up the + future later.} + + @item{@racket['touch-pause] and @racket['touch-resume] (in process 0, + only): waiting in @racket[touch] for a future whose thunk is + being evaluated in another process.} + + @item{@racket['missing]: one or more events for the process were lost + due to internal buffer limits before they could be reported, + and the @racket[time-id] field reports an upper limit on the time + of the missing events; this kind of event is rare.} + +] + +Assuming no @racket['missing] events, then @racket['start-work], +@racket['start-0-work], @racket['start-overflow-work] is always paired with @racket['end-work]; +@racket['sync], @racket['block], and @racket['touch] are always paired +with @racket['result], @racket['abort], or @racket['suspend]; and +@racket['touch-pause] is always paired with @racket['touch-resume]. + +In process 0, some event pairs can be nested within other event pairs: +@racket['sync], @racket['block], or @racket['touch] with +@racket['result] or @racket['abort]; and @racket['touch-pause] with +@racket['touch-resume]. + +An @racket['block] in process 0 is generated when an unsafe operation +is handled. This type of event will contain a symbol in the +@racket[unsafe-op-name] field that is the name of the operation. In all +other cases, this field contains @racket[#f]. + +The @racket[prim-name] field will always be @racket[#f] unless the event occurred +on process 0 and its @racket[action] is either @racket['block] or @racket['sync]. If +these conditions are met, @racket[prim-name] will contain the name +of the Racket primitive which required the future to synchronize with the runtime +thread (represented as a symbol). + +The @racket[user-data] field may take on a number of different +values depending on both the @racket[action] and @racket[prim-name] fields: + +@itemlist[ + + @item{@racket['touch] on process 0: contains the integer ID of the future + being touched.} + + @item{@racket['sync] and @racket[prim-name] = @racket[|allocate memory|]: + The size (in bytes) of the requested allocation.} + + @item{@racket['sync] and @racket[prim-name] = @racket[|jit_on_demand|]: + The runtime thread is performing a JIT compilation on behalf of the + future @racket[future-id]. The field contains the name of the function + being JIT compiled (as a symbol).} + + @item{@racket['create]: A new future was created. The field contains the integer ID + of the newly created future.} + + ] + +@; ---------------------------------------------------------------------- \ No newline at end of file diff --git a/collects/scribblings/reference/futures-visualizer.scrbl b/collects/scribblings/reference/futures-visualizer.scrbl index 0d33d4a29f..3212b74702 100644 --- a/collects/scribblings/reference/futures-visualizer.scrbl +++ b/collects/scribblings/reference/futures-visualizer.scrbl @@ -1,5 +1,5 @@ #lang scribble/doc -@(require "mz.rkt" #;(for-label racket/future/visualizer)) +@(require "mz.rkt" (for-label racket/future/trace racket/future)) @title[#:tag "futures-visualizer"]{Futures Visualizer} @@ -14,19 +14,32 @@ events, as well as the overall amount of processor utilization at any point during the program's lifetime. @deftogether[( - @defproc[(start-performance-tracking!) void?] - @defproc[(show-visualizer) void?] + @defform[(visualize-futures e ...)] + @defproc[(visualize-futures-thunk [thunk (-> any)]) any] )]{ - The @racket[start-performance-tracking!] procedure enables the collection - of data required by the visualizer. This function should be called immediately - prior to executing code the programmer wishes to profile. - - The @racket[show-visualizer] procedure displays the profiler window. + The @racket[visualize-futures] macro enables the collection + of data required by the visualizer and displays a profiler + window showing the corresponding trace. The @racket[visualize-futures-thunk] + provides similar functionality where program code is contained + within @racket[thunk]. A typical program using profiling might look like the following: + @racketblock[ + (require racket/future + racket/future/visualizer) + + (visualize-futures + (let ([f (future (lambda () ...))]) + ... + (touch f))) + ] + + The preceding program is equivalent to: + @racketblock[ (require racket/future + racket/future/trace racket/future/visualizer) (start-performance-tracking!) @@ -38,6 +51,12 @@ at any point during the program's lifetime. ] } +@defproc[(show-visualizer) void?]{ + Displays the profiler window. Calls to this + function must be preceded by a call to @racket[start-performance-tracking!] (or can + be avoided altogether by using either @racket[visualize-futures] or @racket[visualize-futures-thunk]). +} + @section[#:tag "future-visualizer-timeline"]{Execution Timeline} The @deftech{execution timeline}, shown in the top left-hand corner of the @@ -74,6 +93,19 @@ though the time interval is fixed, the pixel distance between lines varies based on the event density for any given time range to prevent overlapping event circles. +@defproc[(timeline-pict [events (listof indexed-future-event?)] + [#:x x (or #f exact-nonnegative-integer?) #f] + [#:y y (or #f exact-nonnegative-integer?) #f] + [#:width width (or #f exact-nonnegative-integer?) #f] + [#:height height (or #f exact-nonnegative-integer?) #f] + [#:selected-event-index selected-event-index (or #f exact-nonnegative-integer?) #f]) pict?]{ + Returns a @racket[pict] showing the execution timeline for the trace in @racket[events]. The optional + arguments @racket[x], @racket[y], @racket[width], and @racket[height] can be used to obtain a specific + area (in pixels) of the timeline image. The @racket[selected-event-index] argument, if specified, shows + the timeline image as if the user placed the mouse pointer over the @racket[indexed-future-event] with + the corresponding index. +} + @section[#:tag "future-visualizer-tree"]{Future Creation Tree} The @deftech{creation tree} shows a tree with a single node per @@ -84,3 +116,19 @@ of that node represent futures which were created by that future (within the scope of its thunk). For all programs, the root of the tree is a special node representing the main computation thread (the runtime thread), and is denoted @deftech{RTT}. + +@defproc[(creation-tree-pict [events (listof indexed-future-event?)] + [#:x x (or #f exact-nonnegative-integer?) #f] + [#:y y (or #f exact-nonnegative-integer?) #f] + [#:width width (or #f exact-nonnegative-integer?) #f] + [#:node-width node-width (or #f exact-nonnegative-integer?) #f] + [#:height height (or #f exact-nonnegative-integer?) #f] + [#:padding padding (or #f exact-nonnegative-integer?) #f] + [#:zoom zoom exact-nonnegative-integer? 1]) pict?]{ + Returns a @racket[pict] showing the future creation tree for the trace in @racket[events]. The optional + arguments @racket[x], @racket[y], @racket[width], and @racket[height] can be used to obtain a specific + area (in pixels) of the creation tree image. The @racket[node-width] argument + specifies (in pixels) the diameter of each node. The @racket[padding] argument specifies the minimum space vertically + between each depth and horizontally between siblings. The @racket[zoom] argument specifies the zoom factor for the + tree image in the range 1-5, where 5 returns a 500% zoom. +} diff --git a/collects/scribblings/reference/futures.scrbl b/collects/scribblings/reference/futures.scrbl index eec3b5a565..dd7802e5d2 100644 --- a/collects/scribblings/reference/futures.scrbl +++ b/collects/scribblings/reference/futures.scrbl @@ -175,120 +175,4 @@ execute through a call to @racket[touch], however. } -@; ------------------------------------------------------------ - -@section[#:tag "future-logging"]{Future Performance Logging} - -Racket futures use logging (see @secref["logging"]) extensively to -report information about how futures are evaluated. Logging output is -useful for debugging the performance of programs that use futures. - -Though textual log output can be viewed directly, it is much -easier to use the graphical profiler tool provided by -@racketmodname[racket/future/visualizer]. - -In addition to its string message, each event logged for a future has -a data value that is an instance of a @racket[future-event] -@tech{prefab} structure: - -@racketblock[ -(define-struct future-event (future-id proc-id action time unsafe-op-name target-fid) - #:prefab) -] - -The @racket[future-id] field is an exact integer that identifies a -future, or it is @racket[#f] when @racket[action] is -@racket['missing]. The @racket[future-id] field is particularly useful -for correlating logged events. - -The @racket[proc-id] fields is an exact, non-negative integer that -identifies a parallel process. Process 0 is the main Racket process, -where all expressions other than future thunks evaluate. - -The @|time-id| field is an inexact number that represents time in -the same way as @racket[current-inexact-milliseconds]. - -The @racket[action] field is a symbol: - -@itemlist[ - - @item{@racket['create]: a future was created.} - - @item{@racket['complete]: a future's thunk evaluated successfully, so - that @racket[touch] will produce a value for the future - immediately.} - - @item{@racket['start-work] and @racket['end-work]: a particular - process started and ended working on a particular future.} - - @item{@racket['start-0-work]: like @racket['start-work], but for a - future thunk that for some structural reason could not be - started in a process other than 0 (e.g., the thunk requires too - much local storage to start).} - - @item{@racket['start-overflow-work]: like @racket['start-work], where - the future thunk's work was previously stopped due to an - internal stack overflow.} - - @item{@racket['sync]: blocking (processes other than 0) or initiation - of handing (process 0) for an ``unsafe'' operation in a future - thunk's evaluation; the operation must run in process 0.} - - @item{@racket['block]: like @racket['sync], but for a part of - evaluation that must be delayed until the future is - @racket[touch]ed, because the evaluation may depend on the - current continuation.} - - @item{@racket['touch] (never in process 0): like @racket['sync] or - @racket['block], but for a @racket[touch] operation within a - future thunk.} - - @item{@racket['overflow] (never in process 0): like @racket['sync] or - @racket['block], but for the case that a process encountered an - internal stack overflow while evaluating a future thunk.} - - @item{@racket['result] or @racket['abort]: waiting or handling for - @racket['sync], @racket['block], or @racket['touch] ended with - a value or an error, respectively.} - - @item{@racket['suspend] (never in process 0): a process blocked by - @racket['sync], @racket['block], or @racket['touch] abandoned - evaluation of a future; some other process may pick up the - future later.} - - @item{@racket['touch-pause] and @racket['touch-resume] (in process 0, - only): waiting in @racket[touch] for a future whose thunk is - being evaluated in another process.} - - @item{@racket['missing]: one or more events for the process were lost - due to internal buffer limits before they could be reported, - and the @|time-id| field reports an upper limit on the time - of the missing events; this kind of event is rare.} - -] - -Assuming no @racket['missing] events, then @racket['start-work], -@racket['start-0-work], @racket['start-overflow-work] is always paired with @racket['end-work]; -@racket['sync], @racket['block], and @racket['touch] are always paired -with @racket['result], @racket['abort], or @racket['suspend]; and -@racket['touch-pause] is always paired with @racket['touch-resume]. - -In process 0, some event pairs can be nested within other event pairs: -@racket['sync], @racket['block], or @racket['touch] with -@racket['result] or @racket['abort]; and @racket['touch-pause] with -@racket['touch-resume]. - -An @racket[block] in process 0 is generated when an unsafe operation -is handled. This type of event will contain a symbol in the -@racket[unsafe-op-name] field that is the name of the operation. In all -other cases, this field contains @racket[#f]. - -The @racket[target-fid] field contains an exact integer value in certain -cases where the @racket[action] occurs in one future but is being -performed on another (e.g. @racket['create] or @racket['touch]). In such -cases, the integer value is the identifier of the future on which the action -is being performed. In all other cases, this field contains @racket[#f]. - -@; ---------------------------------------------------------------------- - @close-eval[future-eval] diff --git a/collects/tests/future/visualizer.rkt b/collects/tests/future/visualizer.rkt index 915979b7d5..77aa4739cc 100644 --- a/collects/tests/future/visualizer.rkt +++ b/collects/tests/future/visualizer.rkt @@ -1,9 +1,11 @@ #lang racket/base (require rackunit + racket/list racket/vector racket/future/private/visualizer-drawing racket/future/private/visualizer-data - racket/future/private/display) + racket/future/private/display + racket/future/private/graph-drawing) (define (compile-trace-data logs) (define tr (build-trace logs)) @@ -50,10 +52,10 @@ (check-equal? (length in-vr) 5)) ;Trace compilation tests -(let* ([future-log (list (indexed-fevent 0 (future-event 0 0 'create 0 #f 0)) - (indexed-fevent 1 (future-event 0 1 'start-work 1 #f #f)) - (indexed-fevent 2 (future-event 0 1 'end-work 2 #f #f)) - (indexed-fevent 3 (future-event 0 0 'complete 3 #f #f)))] +(let* ([future-log (list (indexed-future-event 0 (future-event 0 0 'create 0 #f 0)) + (indexed-future-event 1 (future-event 0 1 'start-work 1 #f #f)) + (indexed-future-event 2 (future-event 0 1 'end-work 2 #f #f)) + (indexed-future-event 3 (future-event 0 0 'complete 3 #f #f)))] [organized (organize-output future-log)]) (check-equal? (vector-length organized) 2) (let ([proc0log (vector-ref organized 0)] @@ -61,10 +63,10 @@ (check-equal? (vector-length proc0log) 2) (check-equal? (vector-length proc1log) 2))) -(let* ([future-log (list (indexed-fevent 0 (future-event #f 0 'create 0 #f 0)) - (indexed-fevent 1 (future-event 0 1 'start-work 1 #f #f)) - (indexed-fevent 2 (future-event 0 1 'end-work 2 #f #f)) - (indexed-fevent 3 (future-event 0 0 'complete 3 #f #f)))] +(let* ([future-log (list (indexed-future-event 0 (future-event #f 0 'create 0 #f 0)) + (indexed-future-event 1 (future-event 0 1 'start-work 1 #f #f)) + (indexed-future-event 2 (future-event 0 1 'end-work 2 #f #f)) + (indexed-future-event 3 (future-event 0 0 'complete 3 #f #f)))] [trace (build-trace future-log)] [evts (trace-all-events trace)]) (check-equal? (length evts) 4) @@ -72,14 +74,14 @@ (check-equal? (length (filter (λ (e) (event-next-targ-future-event e)) evts)) 1) (check-equal? (length (filter (λ (e) (event-prev-targ-future-event e)) evts)) 1)) -(let* ([future-log (list (indexed-fevent 0 (future-event 0 0 'create 0 #f 0)) - (indexed-fevent 1 (future-event 1 0 'create 1 #f 1)) - (indexed-fevent 2 (future-event 0 1 'start-work 2 #f #f)) - (indexed-fevent 3 (future-event 1 2 'start-work 2 #f #f)) - (indexed-fevent 4 (future-event 0 1 'end-work 4 #f #f)) - (indexed-fevent 5 (future-event 0 0 'complete 5 #f #f)) - (indexed-fevent 6 (future-event 1 2 'end-work 5 #f #f)) - (indexed-fevent 7 (future-event 1 0 'complete 7 #f #f)))] +(let* ([future-log (list (indexed-future-event 0 (future-event 0 0 'create 0 #f 0)) + (indexed-future-event 1 (future-event 1 0 'create 1 #f 1)) + (indexed-future-event 2 (future-event 0 1 'start-work 2 #f #f)) + (indexed-future-event 3 (future-event 1 2 'start-work 2 #f #f)) + (indexed-future-event 4 (future-event 0 1 'end-work 4 #f #f)) + (indexed-future-event 5 (future-event 0 0 'complete 5 #f #f)) + (indexed-future-event 6 (future-event 1 2 'end-work 5 #f #f)) + (indexed-future-event 7 (future-event 1 0 'complete 7 #f #f)))] [organized (organize-output future-log)]) (check-equal? (vector-length organized) 3) (let ([proc0log (vector-ref organized 0)] @@ -88,18 +90,18 @@ (check-equal? (vector-length proc0log) 4) (check-equal? (vector-length proc1log) 2) (check-equal? (vector-length proc2log) 2) - (for ([msg (in-vector (vector-map indexed-fevent-fevent proc0log))]) + (for ([msg (in-vector (vector-map indexed-future-event-fevent proc0log))]) (check-equal? (future-event-process-id msg) 0)) - (for ([msg (in-vector (vector-map indexed-fevent-fevent proc1log))]) + (for ([msg (in-vector (vector-map indexed-future-event-fevent proc1log))]) (check-equal? (future-event-process-id msg) 1)) - (for ([msg (in-vector (vector-map indexed-fevent-fevent proc2log))]) + (for ([msg (in-vector (vector-map indexed-future-event-fevent proc2log))]) (check-equal? (future-event-process-id msg) 2)))) ;Drawing calculation tests -(let* ([future-log (list (indexed-fevent 0 (future-event #f 0 'create 0 #f 0)) - (indexed-fevent 1 (future-event 0 1 'start-work 1 #f #f)) - (indexed-fevent 2 (future-event 0 1 'end-work 2 #f #f)) - (indexed-fevent 3 (future-event 0 0 'complete 3 #f #f)))] +(let* ([future-log (list (indexed-future-event 0 (future-event #f 0 'create 0 #f 0)) + (indexed-future-event 1 (future-event 0 1 'start-work 1 #f #f)) + (indexed-future-event 2 (future-event 0 1 'end-work 2 #f #f)) + (indexed-future-event 3 (future-event 0 0 'complete 3 #f #f)))] [trace (build-trace future-log)]) (let-values ([(finfo segments) (calc-segments trace)]) (check-equal? (length segments) 4) @@ -108,10 +110,10 @@ (check-equal? (length (filter (λ (s) (segment-prev-targ-future-seg s)) segments)) 1))) ;Future=42 -(let* ([future-log (list (indexed-fevent 0 (future-event #f 0 'create 0.05 #f 42)) - (indexed-fevent 1 (future-event 42 1 'start-work 0.07 #f #f)) - (indexed-fevent 2 (future-event 42 1 'end-work 0.3 #f #f)) - (indexed-fevent 3 (future-event 42 0 'complete 1.2 #f #f)))] +(let* ([future-log (list (indexed-future-event 0 (future-event #f 0 'create 0.05 #f 42)) + (indexed-future-event 1 (future-event 42 1 'start-work 0.07 #f #f)) + (indexed-future-event 2 (future-event 42 1 'end-work 0.3 #f #f)) + (indexed-future-event 3 (future-event 42 0 'complete 1.2 #f #f)))] [tr (build-trace future-log)]) (define-values (finfo segs) (calc-segments tr)) (define ticks (frame-info-timeline-ticks finfo)) @@ -158,25 +160,25 @@ [(> evt-rel-time ttime) (do-seg-check tr seg tick >= "after")])))) -(let* ([future-log (list (indexed-fevent 0 (future-event #f 0 'create 0.05 #f 42)) - (indexed-fevent 1 (future-event 42 1 'start-work 0.09 #f #f)) - (indexed-fevent 2 (future-event 42 1 'suspend 1.1 #f #f)) - (indexed-fevent 3 (future-event 42 1 'resume 1.101 #f #f)) - (indexed-fevent 4 (future-event 42 1 'suspend 1.102 #f #f)) - (indexed-fevent 5 (future-event 42 1 'resume 1.103 #f #f)) - (indexed-fevent 6 (future-event 42 1 'start-work 1.104 #f #f)) - (indexed-fevent 7 (future-event 42 1 'complete 1.41 #f #f)) - (indexed-fevent 8 (future-event 42 1 'end-work 1.42 #f #f)) - (indexed-fevent 9 (future-event 42 0 'result 1.43 #f #f)))] +(let* ([future-log (list (indexed-future-event 0 (future-event #f 0 'create 0.05 #f 42)) + (indexed-future-event 1 (future-event 42 1 'start-work 0.09 #f #f)) + (indexed-future-event 2 (future-event 42 1 'suspend 1.1 #f #f)) + (indexed-future-event 3 (future-event 42 1 'resume 1.101 #f #f)) + (indexed-future-event 4 (future-event 42 1 'suspend 1.102 #f #f)) + (indexed-future-event 5 (future-event 42 1 'resume 1.103 #f #f)) + (indexed-future-event 6 (future-event 42 1 'start-work 1.104 #f #f)) + (indexed-future-event 7 (future-event 42 1 'complete 1.41 #f #f)) + (indexed-future-event 8 (future-event 42 1 'end-work 1.42 #f #f)) + (indexed-future-event 9 (future-event 42 0 'result 1.43 #f #f)))] [tr (build-trace future-log)]) (define-values (finfo segs) (calc-segments tr)) (define ticks (frame-info-timeline-ticks finfo)) (check-seg-layout tr segs ticks)) -(let* ([future-log (list (indexed-fevent 0 (future-event #f 0 'create 0 #f 0)) - (indexed-fevent 1 (future-event 0 1 'start-work 1 #f #f)) - (indexed-fevent 2 (future-event 0 1 'end-work 2 #f #f)) - (indexed-fevent 3 (future-event 0 0 'complete 3 #f #f)))] +(let* ([future-log (list (indexed-future-event 0 (future-event #f 0 'create 0 #f 0)) + (indexed-future-event 1 (future-event 0 1 'start-work 1 #f #f)) + (indexed-future-event 2 (future-event 0 1 'end-work 2 #f #f)) + (indexed-future-event 3 (future-event 0 0 'complete 3 #f #f)))] [trace (build-trace future-log)]) (check-equal? (trace-start-time trace) 0) (check-equal? (trace-end-time trace) 3) @@ -244,9 +246,9 @@ (check-equal? (length (segs-equal-or-later 4.0 segs)) 0)) ;Tick drawing -(let ([l (list (indexed-fevent 0 (future-event #f 0 'create 10.0 #f 0)) - (indexed-fevent 1 (future-event 0 0 'start-work 11.0 #f #f)) - (indexed-fevent 2 (future-event 0 0 'end-work 20.0 #f #f)))]) +(let ([l (list (indexed-future-event 0 (future-event #f 0 'create 10.0 #f 0)) + (indexed-future-event 1 (future-event 0 0 'start-work 11.0 #f #f)) + (indexed-future-event 2 (future-event 0 0 'end-work 20.0 #f #f)))]) (define-values (tr finfo segs ticks) (compile-trace-data l)) ;Check that number of ticks stays constant whatever the time->pixel modifier (check-equal? (length ticks) 100) @@ -257,43 +259,274 @@ (format "Wrong number of ticks for time->pix mod ~a\n" i))) (check-seg-layout tr segs ticks)) -(let ([l (list (indexed-fevent 0 '#s(future-event #f 0 create 1334778395768.733 #f 3)) - (indexed-fevent 1 '#s(future-event 3 2 start-work 1334778395768.771 #f #f)) - (indexed-fevent 2 '#s(future-event 3 2 complete 1334778395864.648 #f #f)) - (indexed-fevent 3 '#s(future-event 3 2 end-work 1334778395864.652 #f #f)))]) +(let ([l (list (indexed-future-event 0 '#s(future-event #f 0 create 1334778395768.733 #f 3)) + (indexed-future-event 1 '#s(future-event 3 2 start-work 1334778395768.771 #f #f)) + (indexed-future-event 2 '#s(future-event 3 2 complete 1334778395864.648 #f #f)) + (indexed-future-event 3 '#s(future-event 3 2 end-work 1334778395864.652 #f #f)))]) (define-values (tr finfo segs ticks) (compile-trace-data l)) - (define last-evt (indexed-fevent-fevent (list-ref l 3))) - (define first-evt (indexed-fevent-fevent (list-ref l 0))) + (define last-evt (indexed-future-event-fevent (list-ref l 3))) + (define first-evt (indexed-future-event-fevent (list-ref l 0))) (define total-time (- (future-event-time last-evt) (future-event-time first-evt))) (check-equal? (length ticks) (inexact->exact (floor (* 10 total-time))))) (define mand-first - (list (indexed-fevent 0 '#s(future-event #f 0 create 1334779294212.415 #f 1)) - (indexed-fevent 1 '#s(future-event 1 1 start-work 1334779294212.495 #f #f)) - (indexed-fevent 2 '#s(future-event 1 1 sync 1334779294212.501 #f #f)) - (indexed-fevent 3 (future-event 1 0 'sync 1334779294221.128 'allocate_memory #f)) - (indexed-fevent 4 '#s(future-event 1 0 result 1334779294221.138 #f #f)) - (indexed-fevent 5 '#s(future-event 1 1 result 1334779294221.15 #f #f)))) + (list (indexed-future-event 0 '#s(future-event #f 0 create 1334779294212.415 #f 1)) + (indexed-future-event 1 '#s(future-event 1 1 start-work 1334779294212.495 #f #f)) + (indexed-future-event 2 '#s(future-event 1 1 sync 1334779294212.501 #f #f)) + (indexed-future-event 3 (future-event 1 0 'sync 1334779294221.128 'allocate_memory #f)) + (indexed-future-event 4 '#s(future-event 1 0 result 1334779294221.138 #f #f)) + (indexed-future-event 5 '#s(future-event 1 1 result 1334779294221.15 #f #f)))) (let-values ([(tr finfo segs ticks) (compile-trace-data mand-first)]) (check-seg-layout tr segs ticks)) (define single-block-log (list - (indexed-fevent 0 '#s(future-event #f 0 create 1339469018856.55 #f 1)) - (indexed-fevent 1 '#s(future-event 1 1 start-work 1339469018856.617 #f 0)) - (indexed-fevent 2 '#s(future-event 1 1 block 1339469018856.621 #f 0)) - (indexed-fevent 3 '#s(future-event 1 1 suspend 1339469018856.891 #f 0)) - (indexed-fevent 4 '#s(future-event 1 1 end-work 1339469018856.891 #f 0)) - (indexed-fevent 5 '#s(future-event 1 0 block 1339469019057.609 printf 0)) - (indexed-fevent 6 '#s(future-event 1 0 result 1339469019057.783 #f 0)) - (indexed-fevent 7 '#s(future-event 1 2 start-work 1339469019057.796 #f 0)) - (indexed-fevent 8 '#s(future-event 1 2 complete 1339469019057.799 #f 0)) - (indexed-fevent 9 '#s(future-event 1 2 end-work 1339469019057.801 #f 0)))) + (indexed-future-event 0 '#s(future-event #f 0 create 1339469018856.55 #f 1)) + (indexed-future-event 1 '#s(future-event 1 1 start-work 1339469018856.617 #f 0)) + (indexed-future-event 2 '#s(future-event 1 1 block 1339469018856.621 #f 0)) + (indexed-future-event 3 '#s(future-event 1 1 suspend 1339469018856.891 #f 0)) + (indexed-future-event 4 '#s(future-event 1 1 end-work 1339469018856.891 #f 0)) + (indexed-future-event 5 '#s(future-event 1 0 block 1339469019057.609 printf 0)) + (indexed-future-event 6 '#s(future-event 1 0 result 1339469019057.783 #f 0)) + (indexed-future-event 7 '#s(future-event 1 2 start-work 1339469019057.796 #f 0)) + (indexed-future-event 8 '#s(future-event 1 2 complete 1339469019057.799 #f 0)) + (indexed-future-event 9 '#s(future-event 1 2 end-work 1339469019057.801 #f 0)))) (let ([tr (build-trace single-block-log)]) (check-equal? (length (hash-keys (trace-block-counts tr))) 1) (check-equal? (length (hash-keys (trace-sync-counts tr))) 0) (check-equal? (length (hash-keys (trace-future-rtcalls tr))) 1)) +;Graph drawing tests +(let* ([nodea (drawable-node (node 'a '()) 5 5 10 0 0 '() 10)] + [center (drawable-node-center nodea)]) + (check-equal? (point-x center) 10.0) + (check-equal? (point-y center) 10.0)) + + +(define test-padding 5) +(define test-width 10) + +(define (tree root-data . children) + (node root-data children)) + +(define (get-node data layout) + (first (filter (λ (dn) (equal? (node-data (drawable-node-node dn)) data)) (graph-layout-nodes layout)))) + +#| + a + | + b +|# +(define tree0 (tree 'a (tree 'b))) +(let* ([layout (draw-tree tree0 #:node-width test-width #:padding test-padding)] + [dnode-a (get-node 'a layout)] + [dnode-b (get-node 'b layout)]) + (check-equal? (graph-layout-width layout) (+ (* test-padding 2) test-width)) + (check-equal? (graph-layout-height layout) (+ (* test-padding 3) (* test-width 2))) + (check-equal? (drawable-node-x dnode-a) test-padding) + (check-equal? (drawable-node-y dnode-a) test-padding) + (check-equal? (drawable-node-x dnode-b) test-padding) + (check-equal? (drawable-node-y dnode-b) (+ test-padding test-width test-padding))) +(let ([atree (build-attr-tree tree0 0)]) + (check-equal? (attributed-node-num-leaves atree) 1)) + +#| + a + / \ + b c +|# +(define tree1 (tree 'a + (tree 'b) + (tree 'c))) +(define layout (draw-tree tree1 #:node-width test-width #:padding test-padding)) +(for ([dnode (in-list (graph-layout-nodes layout))]) + (check-equal? (drawable-node-width dnode) test-width)) +(define dnode-a (get-node 'a layout)) +(define dnode-b (get-node 'b layout)) +(define dnode-c (get-node 'c layout)) + +(define slot-one-pos (+ test-padding test-width test-padding)) +(define square-sz (+ (* test-padding 3) (* test-width 2))) +(check-equal? (graph-layout-width layout) square-sz) +(check-equal? (graph-layout-height layout) square-sz) +(check-equal? (drawable-node-x dnode-b) test-padding) +(check-equal? (drawable-node-y dnode-b) slot-one-pos) +(check-equal? (drawable-node-x dnode-c) slot-one-pos) +(check-equal? (drawable-node-y dnode-c) slot-one-pos) +(check-equal? (drawable-node-x dnode-a) (/ 25 2)) +(check-equal? (drawable-node-y dnode-a) test-padding) +(check-equal? (length (drawable-node-children dnode-a)) 2) +(let ([atree (build-attr-tree tree1 0)]) + (check-equal? (attributed-node-num-leaves atree) 2)) + +#| + a + / \ + b d + | / \ + c e f + | + g +|# +(define tree2 (tree 'a + (tree 'b + (tree 'c)) + (tree 'd + (tree 'e) + (tree 'f + (tree 'g))))) +(let* ([layout (draw-tree tree2 #:node-width test-width #:padding test-padding)] + [nodes (graph-layout-nodes layout)] + [dnode-a (get-node 'a layout)] + [dnode-b (get-node 'b layout)] + [dnode-c (get-node 'c layout)] + [dnode-d (get-node 'd layout)] + [dnode-e (get-node 'e layout)] + [dnode-f (get-node 'f layout)] + [dnode-g (get-node 'g layout)]) + (check-equal? (node-data (drawable-node-node dnode-a)) 'a) + (check-equal? (node-data (drawable-node-node dnode-b)) 'b) + (check-equal? (node-data (drawable-node-node dnode-c)) 'c) + (check-equal? (node-data (drawable-node-node dnode-d)) 'd) + (check-equal? (node-data (drawable-node-node dnode-e)) 'e) + (check-equal? (node-data (drawable-node-node dnode-f)) 'f) + (check-equal? (node-data (drawable-node-node dnode-g)) 'g) + (check-equal? (graph-layout-width layout) 50) + (check-equal? (graph-layout-height layout) 65) + (check-equal? (drawable-node-x dnode-a) (/ 65 4)) + (check-equal? (drawable-node-y dnode-a) test-padding) + (check-equal? (drawable-node-x dnode-b) test-padding) + (check-equal? (drawable-node-y dnode-b) (+ (* 2 test-padding) test-width)) + (check-equal? (drawable-node-x dnode-c) test-padding) + (check-equal? (drawable-node-y dnode-c) (+ (drawable-node-y dnode-b) test-width test-padding)) + (check-equal? (drawable-node-x dnode-e) (+ (* 2 test-padding) test-width)) + (check-equal? (drawable-node-y dnode-e) (+ (drawable-node-y dnode-d) test-width test-padding)) + (check-equal? (drawable-node-x dnode-f) (+ (drawable-node-x dnode-e) test-width test-padding)) + (check-equal? (drawable-node-y dnode-f) (drawable-node-y dnode-e)) + (check-equal? (drawable-node-x dnode-g) (drawable-node-x dnode-f)) + (check-equal? (drawable-node-y dnode-g) (+ (drawable-node-y dnode-f) test-width test-padding))) +(let ([atree (build-attr-tree tree2 0)]) + (check-equal? (attributed-node-num-leaves atree) 3)) + +#| + a + /|\ + b c e + | + d +|# +(define tree3 (tree 'a + (tree 'b) + (tree 'c + (tree 'd)) + (tree 'e))) +(let* ([layout (draw-tree tree3 #:node-width test-width #:padding test-padding)] + [nodes (graph-layout-nodes layout)] + [dnode-a (get-node 'a layout)] + [dnode-b (get-node 'b layout)] + [dnode-c (get-node 'c layout)] + [dnode-d (get-node 'd layout)] + [dnode-e (get-node 'e layout)]) + (check-equal? (graph-layout-width layout) 50) + (check-equal? (graph-layout-height layout) 50) + (check-equal? (drawable-node-x dnode-a) 20) + (check-equal? (drawable-node-y dnode-a) 5) + (check-equal? (drawable-node-x dnode-b) test-padding) + (check-equal? (drawable-node-y dnode-b) (+ (* 2 test-padding) test-width)) + (check-equal? (drawable-node-x dnode-c) (+ (* 2 test-padding) test-width)) + (check-equal? (drawable-node-y dnode-c) (drawable-node-y dnode-b)) + (check-equal? (drawable-node-x dnode-e) (+ (* 3 test-padding) (* 2 test-width))) + (check-equal? (drawable-node-y dnode-e) (drawable-node-y dnode-c)) + (check-equal? (drawable-node-x dnode-d) (drawable-node-x dnode-c)) + (check-equal? (drawable-node-y dnode-d) (+ (drawable-node-y dnode-c) test-padding test-width))) +(let ([atree (build-attr-tree tree3 0)]) + (check-equal? (attributed-node-num-leaves atree) 3)) + +#| + a + / | | \ + b c f g + / \ + d e +|# +(define tree4 (tree 'a + (tree 'b) + (tree 'c + (tree 'd) + (tree 'e)) + (tree 'f) + (tree 'g))) +(let* ([layout (draw-tree tree4 #:node-width test-width #:padding test-padding)] + [nodes (graph-layout-nodes layout)] + [dnode-a (get-node 'a layout)] + [dnode-b (get-node 'b layout)] + [dnode-c (get-node 'c layout)] + [dnode-d (get-node 'd layout)] + [dnode-e (get-node 'e layout)] + [dnode-f (get-node 'f layout)] + [dnode-g (get-node 'g layout)]) + (check-equal? (graph-layout-width layout) 80) + (check-equal? (graph-layout-height layout) 50) + (check-equal? (drawable-node-x dnode-b) test-padding) + (check-equal? (drawable-node-y dnode-b) (+ (drawable-node-y dnode-a) test-width test-padding)) + (check-equal? (drawable-node-y dnode-c) (drawable-node-y dnode-b)) + (check-equal? (drawable-node-x dnode-d) (+ (drawable-node-x dnode-b) test-width test-padding)) + (check-equal? (drawable-node-y dnode-d) (+ (drawable-node-y dnode-c) test-width test-padding)) + (check-equal? (drawable-node-x dnode-e) (+ (drawable-node-x dnode-d) test-width test-padding)) + (check-equal? (drawable-node-y dnode-e) (drawable-node-y dnode-d)) + (check-equal? (drawable-node-x dnode-f) (+ (drawable-node-x dnode-e) test-width test-padding)) + (check-equal? (drawable-node-y dnode-f) (drawable-node-y dnode-c)) + (check-equal? (drawable-node-x dnode-g) (+ (drawable-node-x dnode-f) test-width test-padding))) +(let ([atree (build-attr-tree tree4 0)]) + (check-equal? (attributed-node-num-leaves atree) 5)) + +#| +Layered-tree-draw example from Di Battista + a + / \ + b g + | / \ + c h k + | / \ + d i j + / \ + e f +|# +(define tree5 (tree 'a + (tree 'b + (tree 'c + (tree 'd + (tree 'e) + (tree 'f)))) + (tree 'g + (tree 'h + (tree 'i) + (tree 'j)) + (tree 'k)))) +(let* ([layout (draw-tree tree5 #:node-width test-width #:padding test-padding)] + [nodes (graph-layout-nodes layout)] + [dnode-a (get-node 'a layout)] + [dnode-b (get-node 'b layout)] + [dnode-c (get-node 'c layout)] + [dnode-d (get-node 'd layout)] + [dnode-e (get-node 'e layout)] + [dnode-f (get-node 'f layout)] + [dnode-g (get-node 'g layout)] + [dnode-h (get-node 'h layout)] + [dnode-i (get-node 'i layout)] + [dnode-j (get-node 'j layout)] + [dnode-k (get-node 'k layout)]) + (check-equal? (graph-layout-width layout) 80) + (check-equal? (graph-layout-height layout) 80) + (check-equal? (drawable-node-x dnode-e) test-padding) + (check-equal? (drawable-node-y dnode-e) 65) + (check-equal? (drawable-node-x dnode-f) (+ (drawable-node-x dnode-e) test-width test-padding)) + (check-equal? (drawable-node-x dnode-i) (+ (drawable-node-x dnode-f) test-width test-padding)) + (check-equal? (drawable-node-x dnode-j) (+ (drawable-node-x dnode-i) test-width test-padding)) + (check-equal? (drawable-node-x dnode-k) (+ (drawable-node-x dnode-j) test-width test-padding))) +(let ([atree (build-attr-tree tree5 0)]) + (check-equal? (attributed-node-num-leaves atree) 5)) +