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

Clean up code in futures visualizer

Browse Source 
Remove mouseover display for creation graph nodes (for now)
This commit is contained in:
James Swaine 2012-07-08 16:42:43 -05:00
parent 39f42b753d
commit 2b2070f7b2
5 changed files with 26 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -47,16 +47,16 @@
(struct indexed-fevent (index fevent) #:transparent)
;The whole trace, with a start/end time and list of process timelines
(struct trace (start-time
end-time
proc-timelines
future-timelines
all-events
real-time ;TODO: What is this
num-futures ;TODO: (length future-timelines)
num-blocks
num-syncs
blocked-futures
(struct trace (start-time ;Absolute start time (in process milliseconds)
end-time ;Absolute end time
proc-timelines ;(listof process-timeline)
future-timelines ;Hash of (future id --o--> (listof event))
all-events ;(listof event)
real-time ;Total amount of time for the trace (in ms)
num-futures ;Number of futures created
num-blocks ;Number of barricades hit
num-syncs ;Number of 'atomic' ops done
blocked-futures ;Number of futures which encountered a barricade at some point
avg-syncs-per-future
block-counts ;prim name --o--> number of blocks
sync-counts ;op name --o--> number of syncs
@ -73,12 +73,14 @@
start
end
events))
;(struct process-timeline timeline (proc-index))
(struct process-timeline (proc-id
proc-index ;Why do we need this
proc-index
start-time
end-time
events))
;(struct future-timeline timeline ())
(struct future-timeline (future-id
start-time
@ -90,12 +92,12 @@
start-time
end-time
proc-id
proc-index ;TODO: why here?
proc-index ;The id of the process in which this event occurred
future-id
user-data
type
prim-name
timeline-position ;TODO: what is this
timeline-position ;The event's position among all events occurring in its process (sorted by time)
[prev-proc-event #:mutable]
[next-proc-event #:mutable]
[prev-future-event #:mutable]
@ -117,6 +119,7 @@
(define (allocation-event? evt)
(equal? (event-prim-name evt) '|[allocate memory|))
;;jitcompile-event : event -> bool
(define (jitcompile-event? evt)
(equal? (event-prim-name evt) '|[jit_on_demand]|))
@ -126,13 +129,6 @@
[(end singleton) #t]
[else #f]))
(define (get-log-events)
(let ([info (sync/timeout 0 recv)])
(if info
(let ([v (vector-ref info 2)])
(cons v (get-log-events)))
'())))
;;get-relative-start-time : trace float -> float
(define (relative-time trace abs-time)
(- abs-time (trace-start-time trace)))
@ -149,29 +145,16 @@
(raw-log-output index)))
'())))
(define (print-blocks raw-output)
(for ([fe (in-list raw-output)])
(when (equal? (future-event-what fe) 'block)
(printf "~a\n" (future-event-prim-name fe)))))
;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))
(define (organize-output raw-log-output)
;TODO: Try using for/set here, does calling code depend on ordering
#;(define unique-proc-ids (for/set ([ie (in-list raw-log-output)])
(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))))
(let ([unique-proc-ids (sort (for/fold ([ids '()]) ([ie (in-list raw-log-output)])
(let* ([evt (indexed-fevent-fevent ie)]
[procid (future-event-process-id evt)])
(if (member procid ids)
ids
(cons procid ids))))
<)])
(for/vector ([procid (in-list unique-proc-ids)])
(for/vector ([e (in-list raw-log-output)]
#:when (eq? procid (future-event-process-id (indexed-fevent-fevent e))))
e))))
(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))))
e)))
;;build-trace : (listof indexed-fevent) -> trace
(define (build-trace log-output)
@ -315,9 +298,7 @@
(λ () 1))
ri))))
(values block-hash sync-hash rt-hash))
;;connect-event-chains! : trace -> void
(define (connect-event-chains! trace)
(for ([tl (in-list (trace-proc-timelines trace))])

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

@ -302,8 +302,6 @@
(event-segment (event-next-targ-future-event evt))
#f)))))
(struct acc (delta last-right-edge) #:transparent)
;;build-seg-layout : flonum (listof event) trace -> (values (listof segment) uint uint)
(define (build-seg-layout timeToPixModifier events tr)
(define last-right-edges (build-vector (length (trace-proc-timelines tr)) (λ (n) 0)))
@ -545,7 +543,6 @@
;;draw-arrows : pict viewable-region segment -> pict
(define (draw-arrows base-pct vregion seg)
(let ([fst (get-seg-previous-to-vregion vregion seg)])
;(printf "~s ~s\n" (event-index (segment-event fst)) (event-type (segment-event fst)))
(let loop ([pct base-pct]
[cur-seg fst])
(if (not cur-seg)
@ -758,9 +755,6 @@
(drawable-node-width dnode))
(colorize (text ntext) (create-graph-node-forecolor)))))
;Cache the creation graph pict after first drawing
(define cg-pict #f)
;;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)

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

@ -85,8 +85,7 @@
(min screen-h DEF-WINDOW-HEIGHT)))
(define (show-visualizer-for-trace logs)
;TODO: Just set initial sizes, not minimum sizes
;If for some reason the log is empty, error?
;If for some reason the log is empty, error
(when (empty? logs)
(error 'show-visualizer "No future log messages found."))
(define the-trace (build-trace logs))
@ -191,7 +190,7 @@
[pict-builder (λ (vregion)
(draw-creategraph-pict vregion
creation-tree-layout))]
[hover-handler (λ (x y vregion)
[hover-handler #f #;(λ (x y vregion)
(set! hovered-graph-node
(find-node-for-coords x
y

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

@ -3,8 +3,7 @@
racket/vector
racket/future/private/visualizer-drawing
racket/future/private/visualizer-data
racket/future/private/display
"bad-trace1.rkt")
racket/future/private/display)
(define (compile-trace-data logs)
(define tr (build-trace logs))
@ -158,11 +157,6 @@
(do-seg-check tr seg tick = "equal to")]
[(> evt-rel-time ttime)
(do-seg-check tr seg tick >= "after")]))))
;Test layout for 'bad' mandelbrot trace
(let-values ([(tr finfo segs ticks) (compile-trace-data BAD-TRACE-1)])
(sanity-check-ticks ticks)
(check-seg-layout tr segs ticks))
(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))

6
src/racket/src/future.c
View File

@ -1856,10 +1856,6 @@ static int future_in_runtime(Scheme_Future_State *fs, future_t * volatile ft, in
future_t * volatile old_ft;
int done;
//FUTURE_ASSERT((!scheme_future_thread_state && !p->current_ft) || scheme_future_thread_state);
//FUTURE_ASSERT(scheme_future_thread_state->thread == p);
//FUTURE_ASSERT(scheme_future_thread_state->thread->current_ft == p->current_ft);
old_ft = p->current_ft;
p->current_ft = ft;
@ -2739,8 +2735,6 @@ static void future_do_runtimecall(Scheme_Future_Thread_State *fts,
runtime thread so we can log all of its primitive applications). */
{
future_t *future;
future_t *targ_future;
Scheme_Object **prim_argv;
Scheme_Future_State *fs = scheme_future_state;
void *storage[4];
int insist_to_suspend, prefer_to_suspend, fid;