diff --git a/collects/future-visualizer/private/visualizer-data.rkt b/collects/future-visualizer/private/visualizer-data.rkt index 38b36b084a..ff5fb3b3e4 100644 --- a/collects/future-visualizer/private/visualizer-data.rkt +++ b/collects/future-visualizer/private/visualizer-data.rkt @@ -32,6 +32,7 @@ synchronization-event? runtime-synchronization-event? gc-event? + work-event? final-event? relative-time event-or-gc-time @@ -64,7 +65,7 @@ end-time ;Absolute end time proc-timelines ;(listof process-timeline) future-timelines ;Hash of (future id --o--> (listof event)) - gc-timeline ;(listof event), where each event is a GC + gc-timeline ;process-timeline where proc-id == 'gc, and each event is a GC all-events ;(listof event) real-time ;Total amount of time for the trace (in ms) num-futures ;Number of futures created @@ -168,6 +169,12 @@ [(block sync) #t] [else #f])) +;;work-event : (or event indexed-future-event future-event) -> bool +(define (work-event? evt) + (case (what evt) + [(start-work start-0-work) #t] + [else #f])) + ;;runtime-thread-evt? : (or event indexed-future-event future-event) -> bool (define (runtime-thread-evt? evt) (= (process-id evt) RT-THREAD-ID)) @@ -428,7 +435,7 @@ (build-creation-graph future-tl-hash))) (connect-event-chains! tr) (connect-target-fid-events! tr) - tr) + tr) ;;build-rtcall-hash : (listof event) -> (values (blocking_prim -o-> count) (sync_prim -o-> count) (fid -o-> rtcall-info) (define (build-rtcall-hashes evts) diff --git a/collects/future-visualizer/private/visualizer-drawing.rkt b/collects/future-visualizer/private/visualizer-drawing.rkt index 5ed5684426..d26b4134a8 100644 --- a/collects/future-visualizer/private/visualizer-drawing.rkt +++ b/collects/future-visualizer/private/visualizer-drawing.rkt @@ -294,25 +294,32 @@ ;;Set pixel widths of segments with variable widths, e.g. ;;work and GC events -;;adjust-variable-width-segs! : (listof segment) -> void -(define (adjust-variable-width-segs! segs) +;;adjust-variable-width-segs! : (listof segment) uint -> void +(define (adjust-variable-width-segs! segs max-x) (cond [(empty? segs) void] [else (define cur (car segs)) (case (event-type (segment-event cur)) [(start-work start-0-work) + (define next-seg (segment-next-proc-seg cur)) + ;Because we are truncating logs after they reach a certain size, + ;next-seg could be #f (where before it was safe to assume that a work segment + ;was always followed by another segment). + (define x-end (if next-seg + (segment-x next-seg) + max-x)) (set-segment-width! cur (max MIN-SEG-WIDTH - (- (segment-x (segment-next-proc-seg cur)) (segment-x cur)))) - (adjust-variable-width-segs! (cdr segs))] + (- x-end (segment-x cur)))) + (adjust-variable-width-segs! (cdr segs) max-x)] [(gc) (cond [(empty? (cdr segs)) void] [else (set-segment-width! cur (max MIN-SEG-WIDTH (- (segment-x (car (cdr segs))) (segment-x cur)))) - (adjust-variable-width-segs! (cdr segs))])] - [else (adjust-variable-width-segs! (cdr segs))])])) + (adjust-variable-width-segs! (cdr segs) max-x)])] + [else (adjust-variable-width-segs! (cdr segs) max-x)])])) ;;connect-segments! : (listof segment) -> void (define (connect-segments! segs) @@ -381,8 +388,6 @@ (values (cons seg segs) new-delta (max largest-x (+ offset segw) #;last-right-edge)))) - (for ([s (in-list sgs)]) - (printf "seg x: ~a, seg y: ~a\n" (segment-x s) (segment-y s))) (values sgs x-extent)) ;;calc-segments : trace uint uint -> (values frame-info (listof segment)) @@ -392,11 +397,11 @@ (define max-y (* TIMELINE-ROW-HEIGHT (length (trace-proc-timelines tr)))) (define-values (segments x) (build-seg-layout timeToPixModifier evts tr max-y)) + (define max-x (+ MIN-SEG-WIDTH (round x))) (define ordered-segs (reverse segments)) (connect-segments! ordered-segs) - (adjust-variable-width-segs! ordered-segs) + (adjust-variable-width-segs! ordered-segs max-x) (define ticks (calc-ticks ordered-segs timeToPixModifier tr)) - (define max-x (+ MIN-SEG-WIDTH (round x))) (values (frame-info max-x max-y TIMELINE-ROW-HEIGHT diff --git a/collects/future-visualizer/private/visualizer-gui.rkt b/collects/future-visualizer/private/visualizer-gui.rkt index c1d4913fbb..28f8cb3a20 100644 --- a/collects/future-visualizer/private/visualizer-gui.rkt +++ b/collects/future-visualizer/private/visualizer-gui.rkt @@ -97,19 +97,10 @@ (values (min screen-w DEF-WINDOW-WIDTH) (min screen-h DEF-WINDOW-HEIGHT))) -(define COMFORTABLE-TL-LEN 5000) - (define (show-visualizer #:timeline [timeline #f]) (define the-tl (if timeline timeline (timeline-events))) - (printf "trace length: ~a\n" (length the-tl)) (when (empty? the-tl) (error 'show-visualizer "No future log messages found.")) - (when (> (length the-tl) COMFORTABLE-TL-LEN) - (log-warning (format - "show-visualizer: truncating log to ~a, dropped ~a messages" - COMFORTABLE-TL-LEN - (- (length the-tl) COMFORTABLE-TL-LEN))) - (set! the-tl (take the-tl COMFORTABLE-TL-LEN))) (define the-trace (build-trace the-tl)) (define-values (winw winh) (get-window-size)) ;The event segment we are currently mousing over diff --git a/collects/tests/future/visualizer.rkt b/collects/tests/future/visualizer.rkt index 71c65aaa92..9e390b8401 100644 --- a/collects/tests/future/visualizer.rkt +++ b/collects/tests/future/visualizer.rkt @@ -304,7 +304,9 @@ (indexed-future-event 4 (future-event 1 1 'end-work 15.0 #f 0)))) (let ([tr (build-trace gc-log1)]) (check-true (not (findf gc-event? (trace-all-events tr)))) - (check-equal? (trace-num-gcs tr) 0)) + (check-equal? (trace-num-gcs tr) 0) + (check-equal? (process-timeline-proc-id (trace-gc-timeline tr)) 'gc) + (check-equal? (length (process-timeline-events (trace-gc-timeline tr))) 0)) (define gc-log2 (list @@ -315,6 +317,8 @@ (indexed-future-event 4 (future-event 1 1 'end-work 21.0 #f 0)))) (let ([tr (build-trace gc-log2)]) (check-equal? (length (filter gc-event? (trace-all-events tr))) 1) + (check-equal? (process-timeline-proc-id (trace-gc-timeline tr)) 'gc) + (check-equal? (length (process-timeline-events (trace-gc-timeline tr))) 1) (check-equal? (trace-num-gcs tr) 1)) (define gc-log3 @@ -328,12 +332,19 @@ (let-values ([(tr finfo segs ticks) (compile-trace-data gc-log3)]) (check-equal? (length (filter gc-event? (trace-all-events tr))) 2) (check-equal? (trace-num-gcs tr) 2) + (check-equal? (length (trace-proc-timelines tr)) 2) + (check-equal? (process-timeline-proc-id (trace-gc-timeline tr)) 'gc) + (check-equal? (length (process-timeline-events (trace-gc-timeline tr))) 2) (let ([gc-segs (filter (λ (s) (gc-event? (segment-event s))) segs)]) (check-equal? (length gc-segs) 2) (for ([gs (in-list gc-segs)]) (check-true (= (segment-height gs) (frame-info-adjusted-height finfo))) (check-true (> (segment-width gs) 10))))) +(check-true (work-event? (future-event #f 0 'start-work 1.0 #f 0))) +(check-true (work-event? (future-event #f 0 'start-0-work 2.0 #f 0))) +(check-false (work-event? (future-event #f 0 'end-work 1.0 #f 0))) + ;Graph drawing tests (let* ([nodea (drawable-node (node 'a '()) 5 5 10 0 0 '() 10)] [center (drawable-node-center nodea)])