suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Futures visualizer - reorganize modules, expose formerly private stuff as public (and docs)

Browse Source
This commit is contained in:
James Swaine 2012-07-09 18:21:58 -05:00
parent 2b2070f7b2
commit dbec8765e3
12 changed files with 983 additions and 806 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

261
collects/racket/future/private/graph-drawing.rkt
View File

@ -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))
(graph-layout-nodes layout))))

48
collects/racket/future/private/visualizer-data.rkt
View File

@ -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

167
collects/racket/future/private/visualizer-drawing.rkt
View File

@ -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)

29
collects/racket/future/private/visualizer-gui.rkt
View File

@ -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)))

22
collects/racket/future/trace.rkt Normal file
View File

@ -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)))

54
collects/racket/future/visualizer.rkt
View File

@ -1,5 +1,51 @@
#lang racket/base
(require "private/visualizer-gui.rkt"
"private/visualizer-data.rkt")
(provide start-performance-tracking!
show-visualizer)
(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)))

453
collects/scribblings/guide/futures.scrbl
View File

@ -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

1
collects/scribblings/reference/concurrency.scrbl
View File

@ -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"]

207
collects/scribblings/reference/futures-trace.scrbl Normal file
View File

@ -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.}
]
@; ----------------------------------------------------------------------

64
collects/scribblings/reference/futures-visualizer.scrbl
View File

@ -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.
}

116
collects/scribblings/reference/futures.scrbl
View File

@ -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]

367
collects/tests/future/visualizer.rkt
View File

@ -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))