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

Fix block/sync counts in future visualizer and per-future block counts in creation graph mouseover

Browse Source
This commit is contained in:
James Swaine 2012-07-22 19:52:13 -05:00
parent 1355c711a8
commit 087ec3890c
4 changed files with 56 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/future-visualizer/private/pict-canvas.rkt
View File

@ -42,7 +42,11 @@
(when (or (not cached-base-bitmap) (not only-the-overlay?)) (when (or (not cached-base-bitmap) (not only-the-overlay?))
(set! cached-base-bitmap (pict->bitmap (scale (bp vregion) scale-factor)))) (set! cached-base-bitmap (pict->bitmap (scale (bp vregion) scale-factor))))
(when ob (when ob
(set! cached-overlay-bitmap (pict->bitmap (ob vregion scale-factor))))) (define overlay-pict (ob vregion scale-factor))
(set! cached-overlay-bitmap
(if overlay-pict
(pict->bitmap overlay-pict)
#f))))
;Rebuilds the pict and stashes in a bitmap ;Rebuilds the pict and stashes in a bitmap
;to be drawn to the canvas later ;to be drawn to the canvas later

42
collects/future-visualizer/private/visualizer-data.rkt
View File

@ -148,10 +148,22 @@
[(block sync) #t] [(block sync) #t]
[else #f])) [else #f]))
;;runtime-thread-evt? : (or event indexed-future-event future-event) -> bool
(define (runtime-thread-evt? evt)
(= (process-id evt) RT-THREAD-ID))
;;runtime-synchronization-event? : (or event indexed-future-event future-event) -> bool ;;runtime-synchronization-event? : (or event indexed-future-event future-event) -> bool
(define (runtime-synchronization-event? evt) (define (runtime-synchronization-event? evt)
(and (synchronization-event? evt) (= (process-id evt) RT-THREAD-ID))) (and (synchronization-event? evt) (= (process-id evt) RT-THREAD-ID)))
;;runtime-block-evt? : (or event indexed-future-event future-event) -> bool
(define (runtime-block-evt? evt)
(and (runtime-thread-evt? evt) (equal? (what evt) 'block)))
;;runtime-sync-evt? : (or event indexed-future-event future-event) -> bool
(define (runtime-sync-evt? evt)
(and (runtime-thread-evt? evt) (equal? (what evt) 'sync)))
;;final-event? : event -> bool ;;final-event? : event -> bool
(define (final-event? evt) (define (final-event? evt)
(case (event-timeline-position evt) (case (event-timeline-position evt)
@ -311,18 +323,13 @@
(define block-hash (make-hash)) (define block-hash (make-hash))
(define sync-hash (make-hash)) (define sync-hash (make-hash))
(define rt-hash (make-hash)) (define rt-hash (make-hash))
(for ([evt (in-list (filter (λ (e) (and (= (event-proc-id e) RT-THREAD-ID) (for ([evt (in-list (filter runtime-synchronization-event? evts))])
(or (equal? (event-type e) 'block) (define isblock (runtime-block-evt? evt))
(equal? (event-type e) 'sync))))
evts))])
(define isblock (case (event-type evt)
[(block) #t]
[else #f]))
(define ophash (if isblock block-hash sync-hash)) (define ophash (if isblock block-hash sync-hash))
(hash-update! ophash (hash-update! ophash
(event-prim-name evt) (event-prim-name evt)
(λ (old) (add1 old)) (λ (old) (+ old 1))
1) 0)
(hash-update! rt-hash (hash-update! rt-hash
(event-future-id evt) (event-future-id evt)
(λ (old) (λ (old)
@ -331,19 +338,10 @@
(rtcall-info-sync-hash old))]) (rtcall-info-sync-hash old))])
(hash-update! h (hash-update! h
(event-prim-name evt) (event-prim-name evt)
(λ (o) (add1 o)) (λ (o) (+ o 1))
(λ () 1))) 0))
old) old)
(λ () (rtcall-info (event-future-id evt) (make-hash) (make-hash))))
(let* ([ri (rtcall-info (event-future-id evt) (make-hash) (make-hash))]
[h (if isblock
(rtcall-info-block-hash ri)
(rtcall-info-sync-hash ri))])
(hash-update! h
(event-prim-name evt)
(λ (o) (add1 o))
(λ () 1))
ri))))
(values block-hash sync-hash rt-hash)) (values block-hash sync-hash rt-hash))
;;connect-event-chains! : trace -> void ;;connect-event-chains! : trace -> void

17
collects/future-visualizer/private/visualizer-drawing.rkt
View File

@ -777,11 +777,16 @@
;;graph-overlay-pict : drawable-node trace graph-layout -> pict ;;graph-overlay-pict : drawable-node trace graph-layout -> pict
(define (graph-overlay-pict hover-node tr layout vregion scale-factor) (define (graph-overlay-pict hover-node tr layout vregion scale-factor)
(when hover-node (define (root-sym-or-first-evt n) (node-data (drawable-node-node n)))
(unless (equal? (node-data (drawable-node-node hover-node)) 'runtime-thread) (cond
(define fid (event-user-data (node-data (drawable-node-node hover-node)))) [(or (not hover-node) (equal? (root-sym-or-first-evt hover-node) 'runtime-thread))
(define ri (hash-ref (trace-future-rtcalls tr) fid (λ () #f))) #f]
(when ri [else
(define fid (event-user-data (root-sym-or-first-evt hover-node)))
(define ri (hash-ref (trace-future-rtcalls tr) fid #f))
(cond
[(not ri) #f]
[else
(define block-ops (sort (hash-keys (rtcall-info-block-hash ri)) (define block-ops (sort (hash-keys (rtcall-info-block-hash ri))
> >
#:key (λ (p) #:key (λ (p)
@ -831,5 +836,5 @@
TOOLTIP-MARGIN TOOLTIP-MARGIN
txtp)) txtp))
(+ yacc (pict-height txtbg) CREATE-GRAPH-PADDING)))) (+ yacc (pict-height txtbg) CREATE-GRAPH-PADDING))))
pct)))) pct])]))

34
collects/future-visualizer/private/visualizer-gui.rkt
View File

@ -106,14 +106,12 @@
[parent (send f get-area-container)])) [parent (send f get-area-container)]))
(define left-panel (new panel:horizontal-dragable% [parent main-panel] (define left-panel (new panel:horizontal-dragable% [parent main-panel]
[stretchable-width #t] [stretchable-width #t]))
[min-width 0]))
(define hlist-ctl (new hierarchical-list% (define hlist-ctl (new hierarchical-list%
[parent left-panel] [parent left-panel]
[stretchable-width #t] [stretchable-width #t]
[stretchable-height #t] [stretchable-height #t]
[style '(control-border)] [style '(control-border)]))
[min-width 0]))
;Build up items in the hierlist ;Build up items in the hierlist
(define block-node (send hlist-ctl new-list)) (define block-node (send hlist-ctl new-list))
@ -193,22 +191,30 @@
[pict-builder (λ (vregion) [pict-builder (λ (vregion)
(draw-creategraph-pict vregion (draw-creategraph-pict vregion
creation-tree-layout))] creation-tree-layout))]
#;[hover-handler #f (λ (x y vregion) [hover-handler (λ (x y vregion)
(define hovered (find-node-for-coords x y
(graph-layout-nodes creation-tree-layout)))
(cond
[(eq? hovered hovered-graph-node) #f]
[else
(set! hovered-graph-node (set! hovered-graph-node
(find-node-for-coords x (find-node-for-coords x
y y
(graph-layout-nodes creation-tree-layout))))] (graph-layout-nodes creation-tree-layout)))
[click-handler (λ (x y vregion) hovered-graph-node]))]
#;[click-handler (λ (x y vregion)
(define fid (find-fid-for-coords (define fid (find-fid-for-coords
x y (graph-layout-nodes creation-tree-layout) x y (graph-layout-nodes creation-tree-layout)
vregion)) vregion))
(when fid (cond
(define seg (first-seg-for-fid fid segments)) [(not fid) #f]
(set! tacked-seg seg) [else
(send timeline-panel set-redraw-overlay! #t) (define seg (first-seg-for-fid fid segments))
(send timeline-panel refresh) (set! tacked-seg seg)
(post-event listener-table 'segment-click timeline-panel seg)))] (send timeline-panel redraw-everything)
#;[overlay-builder (λ (vregion scale-factor) (post-event listener-table 'segment-click timeline-panel seg)
#t]))]
[overlay-builder (λ (vregion scale-factor)
(graph-overlay-pict hovered-graph-node (graph-overlay-pict hovered-graph-node
the-trace the-trace
creation-tree-layout creation-tree-layout