Add GC display to future visualizer
This commit is contained in:
James Swaine
parent
0c37d094da
commit
6271556e1d
|
|
@ -1,6 +1,7 @@
|
|||
#lang racket/base
|
||||
(provide get-event-color
|
||||
get-event-forecolor
|
||||
get-event-opacity
|
||||
header-forecolor
|
||||
header-backcolor
|
||||
timeline-event-baseline-color
|
||||
|
|
@ -89,7 +90,14 @@
|
|||
[(touch-pause) "blue"]
|
||||
[(result abort suspend) "white"]
|
||||
[(complete end-work) "white"]
|
||||
[else "black"]))
|
||||
[(gc) "maroon"]
|
||||
[else "black"]))
|
||||
|
||||
;;get-event-opacity : symbol -> real [0 .. 1]
|
||||
(define (get-event-opacity type)
|
||||
(case type
|
||||
[(gc) 0.15]
|
||||
[else 1]))
|
||||
|
||||
;;get-event-forecolor : symbol -> string
|
||||
(define (get-event-forecolor type)
|
||||
|
|
|
|||
|
|
@ -6,6 +6,7 @@
|
|||
racket/set
|
||||
"constants.rkt"
|
||||
"graph-drawing.rkt"
|
||||
"display.rkt"
|
||||
(only-in '#%futures
|
||||
reset-future-logs-for-tracing!
|
||||
mark-future-trace-end!))
|
||||
|
|
@ -13,6 +14,7 @@
|
|||
(provide start-future-tracing!
|
||||
stop-future-tracing!
|
||||
(struct-out future-event)
|
||||
(struct-out gc-info)
|
||||
(struct-out indexed-future-event)
|
||||
(struct-out trace)
|
||||
(struct-out process-timeline)
|
||||
|
|
@ -29,13 +31,25 @@
|
|||
allocation-event?
|
||||
jitcompile-event?
|
||||
synchronization-event?
|
||||
runtime-synchronization-event?
|
||||
runtime-synchronization-event?
|
||||
gc-event?
|
||||
final-event?
|
||||
relative-time)
|
||||
|
||||
(define-struct future-event (future-id process-id what time prim-name user-data)
|
||||
#:prefab)
|
||||
|
||||
(define-struct gc-info (major?
|
||||
pre-used
|
||||
pre-admin
|
||||
code-page-total
|
||||
post-used
|
||||
post-admin
|
||||
start-time
|
||||
end-time
|
||||
start-real-time
|
||||
end-real-time) #:prefab)
|
||||
|
||||
;Contains an index and a future-event,
|
||||
;so we can preserve the order in which future-events
|
||||
;were logged.
|
||||
|
|
@ -53,7 +67,8 @@
|
|||
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
|
||||
num-syncs ;Number of 'atomic' ops done
|
||||
num-gcs ;Number of GC's that occurred during the trace
|
||||
blocked-futures ;Number of futures which encountered a barricade at some point
|
||||
avg-syncs-per-future
|
||||
block-counts ;prim name --o--> number of blocks
|
||||
|
|
@ -101,7 +116,7 @@
|
|||
;;event-has-duration? : event -> bool
|
||||
(define (event-has-duration? evt)
|
||||
(case (event-type evt)
|
||||
[(start-work start-0-work) #t]
|
||||
[(start-work start-0-work gc) #t]
|
||||
[else #f]))
|
||||
|
||||
(define (missing-data? log)
|
||||
|
|
@ -120,8 +135,9 @@
|
|||
(define (what evt)
|
||||
(cond
|
||||
[(event? evt) (event-type evt)]
|
||||
[(indexed-future-event? evt) (future-event-what (indexed-future-event-fevent evt))]
|
||||
[(future-event? evt) (future-event-what evt)]))
|
||||
[(indexed-future-event? evt) (what (indexed-future-event-fevent evt))]
|
||||
[(future-event? evt) (future-event-what evt)]
|
||||
[(gc-info? evt) 'gc]))
|
||||
|
||||
;;process-id : (or event indexed-future-event future-event) -> exact-nonnegative-integer
|
||||
(define (process-id evt)
|
||||
|
|
@ -164,6 +180,10 @@
|
|||
(define (runtime-sync-evt? evt)
|
||||
(and (runtime-thread-evt? evt) (equal? (what evt) 'sync)))
|
||||
|
||||
;;gc-event? : (or event indexed-future-event future-event) -> bool
|
||||
(define (gc-event? evt)
|
||||
(equal? (what evt) 'gc))
|
||||
|
||||
;;final-event? : event -> bool
|
||||
(define (final-event? evt)
|
||||
(case (event-timeline-position evt)
|
||||
|
|
@ -187,16 +207,30 @@
|
|||
(define (stop-future-tracing!)
|
||||
(mark-future-trace-end!))
|
||||
|
||||
;;event-or-gc-time : (or future-event gc-info) -> float
|
||||
(define (event-or-gc-time evt)
|
||||
(if (future-event? evt)
|
||||
(future-event-time evt)
|
||||
(gc-info-start-real-time evt)))
|
||||
|
||||
;;process-id-or-gc : (or future-event gc-info) -> (or nonnegative-integer 'gc)
|
||||
(define (process-id-or-gc evt)
|
||||
(if (future-event? evt)
|
||||
(future-event-process-id evt)
|
||||
'gc))
|
||||
|
||||
;;timeline-events/private : -> void
|
||||
(define (timeline-events/private)
|
||||
(let ([info (sync/timeout 0 recv)])
|
||||
(if info
|
||||
(let ([v (vector-ref info 2)])
|
||||
(if (future-event? v)
|
||||
(case (future-event-what v)
|
||||
[(stop-trace) '()]
|
||||
[else (cons v (timeline-events/private))])
|
||||
(timeline-events/private)))
|
||||
(cond
|
||||
[(future-event? v)
|
||||
(case (future-event-what v)
|
||||
[(stop-trace) '()]
|
||||
[else (cons v (timeline-events/private))])]
|
||||
[(gc-info? v) (cons v (timeline-events/private))]
|
||||
[else (timeline-events/private)]))
|
||||
(timeline-events/private))))
|
||||
|
||||
;Gets log events for an execution timeline
|
||||
|
|
@ -206,90 +240,147 @@
|
|||
[(not (futures-enabled?)) '()]
|
||||
[else
|
||||
(define sorted (sort (timeline-events/private)
|
||||
#:key future-event-time
|
||||
#:key event-or-gc-time
|
||||
<))
|
||||
(for/list ([fe (in-list sorted)]
|
||||
(for/list ([evt (in-list sorted)]
|
||||
[i (in-naturals)])
|
||||
(indexed-future-event i fe))]))
|
||||
(indexed-future-event i evt))]))
|
||||
|
||||
;;proc-id-or-gc<? : (or number symbol) (or number symbol) -> bool
|
||||
(define (proc-id-or-gc<? a b)
|
||||
(cond
|
||||
[(equal? a 'gc) #t]
|
||||
[(equal? b 'gc) #t]
|
||||
[else (< a b)]))
|
||||
|
||||
;Produces a vector of vectors, where each inner vector contains
|
||||
;all the log output messages for a specific process
|
||||
;;organize-output : (listof indexed-future-event) -> (vectorof (vectorof future-event))
|
||||
(define (organize-output raw-log-output)
|
||||
;;organize-output : (listof indexed-future-event) real real -> (vectorof (vectorof future-event))
|
||||
(define (organize-output raw-log-output start-time end-time)
|
||||
(define unique-proc-ids (for/set ([ie (in-list raw-log-output)])
|
||||
(future-event-process-id (indexed-future-event-fevent ie))))
|
||||
(for/vector ([procid (in-list (sort (set->list unique-proc-ids) <))])
|
||||
(process-id-or-gc (indexed-future-event-fevent ie))))
|
||||
(for/vector ([procid (in-list (sort (set->list unique-proc-ids) proc-id-or-gc<?))])
|
||||
(for/vector ([e (in-list raw-log-output)]
|
||||
#:when (eq? procid (future-event-process-id (indexed-future-event-fevent e))))
|
||||
#:when (and (equal? procid (process-id-or-gc (indexed-future-event-fevent e)))
|
||||
(between (event-or-gc-time (indexed-future-event-fevent e))
|
||||
start-time
|
||||
end-time)))
|
||||
e)))
|
||||
|
||||
|
||||
;;Grab the first and last future events in the trace.
|
||||
;;first-and-last-fevents : (listof (or future-event gc-info)) -> (values future-event future-event)
|
||||
(define (first-and-last-fevents log)
|
||||
(let loop ([fst #f]
|
||||
[last #f]
|
||||
[remaining-log log])
|
||||
(cond
|
||||
[(empty? remaining-log) (values fst last)]
|
||||
[else
|
||||
(define f (indexed-future-event-fevent (car remaining-log)))
|
||||
(define rest (cdr remaining-log))
|
||||
(cond
|
||||
[fst (if (future-event? f)
|
||||
(loop fst f rest)
|
||||
(loop fst last rest))]
|
||||
[else (if (future-event? f)
|
||||
(loop f last rest)
|
||||
(loop fst last rest))])])))
|
||||
|
||||
;;build-trace : (listof indexed-future-event) -> trace
|
||||
(define (build-trace log-output)
|
||||
(when (empty? log-output)
|
||||
(error 'build-trace "Empty timeline in log-output"))
|
||||
(define data (organize-output log-output))
|
||||
(define start-time (future-event-time (indexed-future-event-fevent (car log-output))))
|
||||
(define end-time (future-event-time (indexed-future-event-fevent (last log-output))))
|
||||
(define-values (unique-fids nblocks nsyncs)
|
||||
(define-values (fst last) (first-and-last-fevents log-output))
|
||||
(define start-time (future-event-time fst))
|
||||
(define end-time (future-event-time last))
|
||||
(define data (organize-output log-output start-time end-time))
|
||||
(define-values (unique-fids nblocks nsyncs ngcs)
|
||||
(for/fold ([unique-fids (set)]
|
||||
[nblocks 0]
|
||||
[nsyncs 0]) ([ie (in-list log-output)])
|
||||
(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
|
||||
(if fid
|
||||
(set-add unique-fids fid)
|
||||
unique-fids)
|
||||
(if (and is-future-thread?
|
||||
(case (future-event-what evt)
|
||||
[(block touch) #t]
|
||||
[else #f]))
|
||||
(add1 nblocks)
|
||||
nblocks)
|
||||
(if (and is-future-thread? (symbol=? (future-event-what evt) 'sync))
|
||||
(add1 nsyncs)
|
||||
nsyncs)))))
|
||||
[nsyncs 0]
|
||||
[ngcs 0]) ([ie (in-list log-output)])
|
||||
(define evt (indexed-future-event-fevent ie))
|
||||
(cond
|
||||
[(gc-info? evt)
|
||||
(cond
|
||||
[(between (event-or-gc-time evt) start-time end-time)
|
||||
(values unique-fids nblocks nsyncs (add1 ngcs))]
|
||||
[else (values unique-fids nblocks nsyncs ngcs)])]
|
||||
[else
|
||||
(define fid (future-event-future-id evt))
|
||||
(define is-future-thread? (not (= (future-event-process-id evt) RT-THREAD-ID)))
|
||||
(values
|
||||
(if fid
|
||||
(set-add unique-fids fid)
|
||||
unique-fids)
|
||||
(if (and is-future-thread?
|
||||
(case (future-event-what evt)
|
||||
[(block touch) #t]
|
||||
[else #f]))
|
||||
(add1 nblocks)
|
||||
nblocks)
|
||||
(if (and is-future-thread? (symbol=? (future-event-what evt) 'sync))
|
||||
(add1 nsyncs)
|
||||
nsyncs)
|
||||
ngcs)])))
|
||||
(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-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-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-future-event-fevent ie)]
|
||||
[start (future-event-time evt)]
|
||||
[pos (cond
|
||||
[(zero? j) (if (= j (sub1 (vector-length proc-log-vec)))
|
||||
'singleton
|
||||
'start)]
|
||||
[(= j (sub1 (vector-length proc-log-vec))) 'end]
|
||||
[else 'interior])])
|
||||
(event (indexed-future-event-index ie)
|
||||
start
|
||||
(if (or (equal? pos 'end) (equal? pos 'singleton))
|
||||
(cond
|
||||
[(= (vector-length proc-log-vec) 0)
|
||||
(process-timeline 'gc
|
||||
0
|
||||
start-time
|
||||
end-time
|
||||
'())]
|
||||
[else
|
||||
(let* ([fst-ie (vector-ref proc-log-vec 0)]
|
||||
[fst-log-msg (indexed-future-event-fevent fst-ie)])
|
||||
(process-timeline (process-id-or-gc fst-log-msg)
|
||||
i
|
||||
(event-or-gc-time fst-log-msg)
|
||||
(event-or-gc-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)])
|
||||
(define evt (indexed-future-event-fevent ie))
|
||||
(define start (event-or-gc-time evt))
|
||||
(define pos (cond
|
||||
[(zero? j) (if (= j (sub1 (vector-length proc-log-vec)))
|
||||
'singleton
|
||||
'start)]
|
||||
[(= j (sub1 (vector-length proc-log-vec))) 'end]
|
||||
[else 'interior]))
|
||||
(define end (cond
|
||||
[(gc-info? evt) (gc-info-end-real-time evt)]
|
||||
[else
|
||||
(if (or (equal? pos 'end) (equal? pos 'singleton))
|
||||
start
|
||||
(future-event-time (indexed-future-event-fevent
|
||||
(vector-ref proc-log-vec (add1 j)))))]))
|
||||
(cond
|
||||
[(gc-info? evt)
|
||||
(event (indexed-future-event-index ie)
|
||||
start
|
||||
(future-event-time (indexed-future-event-fevent
|
||||
(vector-ref proc-log-vec (add1 j)))))
|
||||
(future-event-process-id evt)
|
||||
i
|
||||
(future-event-future-id evt)
|
||||
(future-event-user-data evt)
|
||||
(future-event-what evt)
|
||||
(future-event-prim-name evt)
|
||||
pos
|
||||
#f
|
||||
#f
|
||||
#f
|
||||
#f
|
||||
#f
|
||||
#f
|
||||
#f)))))))
|
||||
end
|
||||
'gc
|
||||
i
|
||||
#f
|
||||
#f
|
||||
'gc
|
||||
#f
|
||||
pos #f #f #f #f #f #f #f)]
|
||||
[else
|
||||
(event (indexed-future-event-index ie)
|
||||
start
|
||||
end
|
||||
(process-id-or-gc evt)
|
||||
i
|
||||
(future-event-future-id evt)
|
||||
(future-event-user-data evt)
|
||||
(future-event-what evt)
|
||||
(future-event-prim-name evt)
|
||||
pos #f #f #f #f #f #f #f)]))))])))
|
||||
(define all-evts (sort (flatten (for/list ([tl (in-list tls)]) (process-timeline-events tl)))
|
||||
#:key event-index
|
||||
<))
|
||||
|
|
@ -310,7 +401,8 @@
|
|||
(- end-time start-time) ;real time
|
||||
(set-count unique-fids) ;num-futures
|
||||
nblocks ;num-blocks
|
||||
nsyncs ;num-syncs
|
||||
nsyncs ;num-syncs
|
||||
ngcs
|
||||
0
|
||||
0
|
||||
block-hash
|
||||
|
|
|
|||
|
|
@ -29,7 +29,8 @@
|
|||
(struct-out timeline-tick)
|
||||
find-node-for-coords
|
||||
find-fid-for-coords
|
||||
first-seg-for-fid)
|
||||
first-seg-for-fid
|
||||
print-seg)
|
||||
|
||||
;Represents a dot or square on the timeline
|
||||
(struct segment (event
|
||||
|
|
@ -38,6 +39,7 @@
|
|||
width
|
||||
height
|
||||
color
|
||||
opacity
|
||||
p
|
||||
prev-future-seg
|
||||
next-future-seg
|
||||
|
|
@ -46,7 +48,6 @@
|
|||
prev-targ-future-seg
|
||||
next-targ-future-seg) #:transparent #:mutable)
|
||||
|
||||
|
||||
;General information about the timeline image
|
||||
(struct frame-info (adjusted-width
|
||||
adjusted-height
|
||||
|
|
@ -68,6 +69,16 @@
|
|||
(frame-info-adjusted-width finfo)
|
||||
(frame-info-adjusted-height finfo)))
|
||||
|
||||
;;print-seg : segment -> void
|
||||
(define (print-seg seg)
|
||||
(printf "(segment type:~a x:~a y:~a width:~a height:~a color:~a\n"
|
||||
(event-type (segment-event seg))
|
||||
(segment-x seg)
|
||||
(segment-y seg)
|
||||
(segment-width seg)
|
||||
(segment-height seg)
|
||||
(segment-color seg)))
|
||||
|
||||
;;seg-in-vregion : viewable-region segment -> bool
|
||||
(define (seg-in-vregion vregion)
|
||||
(λ (seg)
|
||||
|
|
@ -141,12 +152,17 @@
|
|||
x)))
|
||||
(- (- w (- max-x-extent w)) MIN-SEG-WIDTH))
|
||||
|
||||
;;calc-row-mid-y : uint uint -> uint
|
||||
(define (calc-row-mid-y proc-index row-height)
|
||||
(floor (- (+ (* proc-index
|
||||
row-height)
|
||||
(/ row-height 2))
|
||||
2)))
|
||||
;;calc-row-mid-y : uint (or uint symbol) uint uint -> uint
|
||||
(define (calc-row-mid-y proc-index proc-id row-height num-tls)
|
||||
(define PADDING 2)
|
||||
;GC events span the entire height of the execution timeline
|
||||
(cond
|
||||
[(symbol? proc-id) 0]
|
||||
[else
|
||||
(floor (- (+ (* (- proc-index 1)
|
||||
row-height)
|
||||
(/ row-height 2))
|
||||
PADDING))]))
|
||||
|
||||
;Gets the center of a circle with (xleft, ytop) as the top-left coordinate.
|
||||
;;calc-center : uint uint uint -> (values uint uint)
|
||||
|
|
@ -242,16 +258,19 @@
|
|||
ticks
|
||||
new-label-x-extent
|
||||
r-segs))))
|
||||
tks)
|
||||
tks)
|
||||
|
||||
;;calc-process-timespan-lines : trace (listof segment) -> (listof (uint . uint))
|
||||
(define (calc-process-timespan-lines trace segs)
|
||||
;;calc-process-timespan-lines : trace (listof segment) uint -> (listof (uint . uint))
|
||||
(define (calc-process-timespan-lines trace segs max-x)
|
||||
(for/list ([tl (in-list (trace-proc-timelines trace))])
|
||||
(let ([segs (filter (λ (s) (= (process-timeline-proc-id tl)
|
||||
(event-proc-id (segment-event s))))
|
||||
segs)])
|
||||
(cons (segment-x (car segs))
|
||||
(segment-x (last segs))))))
|
||||
(define sgs (filter (λ (s) (equal? (process-timeline-proc-id tl)
|
||||
(event-proc-id (segment-event s))))
|
||||
segs))
|
||||
(cond
|
||||
[(empty? sgs) (cons 0 max-x)]
|
||||
[else
|
||||
(cons (segment-x (car sgs))
|
||||
(segment-x (last sgs)))])))
|
||||
|
||||
;;get-first-future-seg : seg -> seg
|
||||
(define (get-first-future-seg seg)
|
||||
|
|
@ -274,16 +293,28 @@
|
|||
(cond
|
||||
[(or (not prev) (not ((seg-in-vregion vregion) cur))) cur]
|
||||
[else (loop prev)])))
|
||||
|
||||
;;adjust-work-segs! : (listof segment) -> void
|
||||
(define (adjust-work-segs! segs)
|
||||
(for ([seg (in-list segs)])
|
||||
(case (event-type (segment-event seg))
|
||||
[(start-work start-0-work)
|
||||
(set-segment-width! seg (max MIN-SEG-WIDTH
|
||||
(- (segment-x (segment-next-proc-seg seg)) (segment-x seg))))]
|
||||
[else
|
||||
void])))
|
||||
|
||||
;;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)
|
||||
(cond
|
||||
[(empty? segs) void]
|
||||
[else
|
||||
(define cur (car segs))
|
||||
(case (event-type (segment-event cur))
|
||||
[(start-work start-0-work)
|
||||
(set-segment-width! cur (max MIN-SEG-WIDTH
|
||||
(- (segment-x (segment-next-proc-seg cur)) (segment-x cur))))
|
||||
(adjust-variable-width-segs! (cdr segs))]
|
||||
[(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))])]))
|
||||
|
||||
;;connect-segments! : (listof segment) -> void
|
||||
(define (connect-segments! segs)
|
||||
|
|
@ -309,13 +340,18 @@
|
|||
#f)))))
|
||||
|
||||
;;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)))
|
||||
(define (build-seg-layout timeToPixModifier events tr max-y)
|
||||
(define num-tls (length (trace-proc-timelines tr)))
|
||||
(define last-right-edges (build-vector num-tls (λ (n) 0)))
|
||||
(define-values (sgs d x-extent)
|
||||
(for/fold ([segs '()]
|
||||
[delta 0]
|
||||
[largest-x 0]) ([evt (in-list events)])
|
||||
(define last-right-edge (vector-ref last-right-edges (event-proc-index evt)))
|
||||
(define is-gc-evt? (equal? (event-type evt) 'gc))
|
||||
(define last-right-edge (if is-gc-evt?
|
||||
largest-x
|
||||
(vector-ref last-right-edges (event-proc-index evt))))
|
||||
#;(define last-right-edge (vector-ref last-right-edges (event-proc-index evt)))
|
||||
(define wanted-offset (+ delta (* DEFAULT-TIMELINE-WIDTH
|
||||
(inexact->exact
|
||||
(/ (- (event-start-time evt) (trace-start-time tr))
|
||||
|
|
@ -324,14 +360,18 @@
|
|||
(if (last-right-edge . <= . wanted-offset)
|
||||
(values wanted-offset delta)
|
||||
(values last-right-edge (+ delta (- last-right-edge wanted-offset)))))
|
||||
(define radius (/ MIN-SEG-WIDTH 2))
|
||||
(define radius (if is-gc-evt? 0 (/ MIN-SEG-WIDTH 2)))
|
||||
(define segw MIN-SEG-WIDTH)
|
||||
(define segh (cond
|
||||
[is-gc-evt? max-y]
|
||||
[else MIN-SEG-WIDTH]))
|
||||
(define seg (segment evt
|
||||
(round offset)
|
||||
(- (calc-row-mid-y (event-proc-index evt) TIMELINE-ROW-HEIGHT) radius)
|
||||
(- (calc-row-mid-y (event-proc-index evt) (event-proc-id evt) TIMELINE-ROW-HEIGHT num-tls) radius)
|
||||
segw
|
||||
MIN-SEG-WIDTH
|
||||
segh
|
||||
(get-event-color (event-type evt))
|
||||
(get-event-opacity (event-type evt))
|
||||
#f
|
||||
#f
|
||||
#f
|
||||
|
|
@ -343,40 +383,45 @@
|
|||
(vector-set! last-right-edges (event-proc-index evt) (+ offset segw))
|
||||
(values (cons seg segs)
|
||||
new-delta
|
||||
(max largest-x last-right-edge))))
|
||||
(max largest-x (+ offset segw) #;last-right-edge))))
|
||||
(values sgs x-extent))
|
||||
|
||||
;;calc-segments : trace uint uint -> (values frame-info (listof segment))
|
||||
(define (calc-segments tr)
|
||||
(define evts (trace-all-events tr))
|
||||
(define timeToPixModifier (/ DEFAULT-TIMELINE-WIDTH (- (trace-end-time tr) (trace-start-time tr))))
|
||||
(define max-y (* TIMELINE-ROW-HEIGHT (sub1 (length (trace-proc-timelines tr)))))
|
||||
(define-values (segments x)
|
||||
(build-seg-layout timeToPixModifier evts tr))
|
||||
(build-seg-layout timeToPixModifier evts tr max-y))
|
||||
(define ordered-segs (reverse segments))
|
||||
(connect-segments! ordered-segs)
|
||||
(adjust-work-segs! ordered-segs)
|
||||
(adjust-variable-width-segs! ordered-segs)
|
||||
(define ticks (calc-ticks ordered-segs timeToPixModifier tr))
|
||||
(values (frame-info (+ MIN-SEG-WIDTH (round x))
|
||||
(* TIMELINE-ROW-HEIGHT (length (trace-proc-timelines tr)))
|
||||
(define max-x (+ MIN-SEG-WIDTH (round x)))
|
||||
(values (frame-info max-x
|
||||
max-y
|
||||
TIMELINE-ROW-HEIGHT
|
||||
timeToPixModifier
|
||||
ticks
|
||||
(calc-process-timespan-lines tr ordered-segs))
|
||||
(calc-process-timespan-lines tr ordered-segs max-x))
|
||||
ordered-segs))
|
||||
|
||||
;;pict-for-segment : segment -> pict
|
||||
(define (pict-for-segment seg)
|
||||
(unless (segment-p seg)
|
||||
(set-segment-p! seg (if (event-has-duration? (segment-event seg))
|
||||
(rect-pict (segment-color seg)
|
||||
(timeline-event-strokecolor)
|
||||
(segment-width seg)
|
||||
MIN-SEG-WIDTH
|
||||
#:stroke-width .5)
|
||||
(circle-pict (segment-color seg)
|
||||
(timeline-event-strokecolor)
|
||||
MIN-SEG-WIDTH
|
||||
#:stroke-width .5))))
|
||||
(define p (if (event-has-duration? (segment-event seg))
|
||||
(rect-pict (segment-color seg)
|
||||
(timeline-event-strokecolor)
|
||||
(segment-width seg)
|
||||
(segment-height seg)
|
||||
#:stroke-width .5)
|
||||
(circle-pict (segment-color seg)
|
||||
(timeline-event-strokecolor)
|
||||
MIN-SEG-WIDTH
|
||||
#:stroke-width .5)))
|
||||
(set-segment-p! seg (if (< (segment-opacity seg) 1)
|
||||
(cellophane p (segment-opacity seg))
|
||||
p)))
|
||||
(segment-p seg))
|
||||
|
||||
;;draw-ruler-on : pict viewable-region frameinfo -> pict
|
||||
|
|
@ -401,16 +446,22 @@
|
|||
|
||||
;;draw-row-lines-on : pict viewable-region trace frameinfo -> pict
|
||||
(define (draw-row-lines-on base vregion tr finfo opacity)
|
||||
(define num-tls (length (trace-proc-timelines tr)))
|
||||
(pin-over base
|
||||
0
|
||||
0
|
||||
(for/fold ([pct base]) ([tl (in-list (filter (λ (tline)
|
||||
(define midy (calc-row-mid-y (process-timeline-proc-index tline)
|
||||
(frame-info-row-height finfo)))
|
||||
(define topy (- midy (frame-info-row-height finfo)))
|
||||
(define boty (+ midy (frame-info-row-height finfo)))
|
||||
(or (in-viewable-region-vert? vregion topy)
|
||||
(in-viewable-region-vert? vregion boty)))
|
||||
(for/fold ([pct base]) ([tl (in-list (filter (λ (tline)
|
||||
(cond
|
||||
[(equal? (process-timeline-proc-id tline) 'gc) #f]
|
||||
[else
|
||||
(define midy (calc-row-mid-y (process-timeline-proc-index tline)
|
||||
(process-timeline-proc-id tline)
|
||||
(frame-info-row-height finfo)
|
||||
num-tls))
|
||||
(define topy (- midy (frame-info-row-height finfo)))
|
||||
(define boty (+ midy (frame-info-row-height finfo)))
|
||||
(or (in-viewable-region-vert? vregion topy)
|
||||
(in-viewable-region-vert? vregion boty))]))
|
||||
(trace-proc-timelines tr)))])
|
||||
(let* ([line-coords (list-ref (frame-info-process-line-coords finfo)
|
||||
(process-timeline-proc-index tl))]
|
||||
|
|
@ -429,7 +480,7 @@
|
|||
(- line-end vregion-start)]
|
||||
[else vregion-end])]
|
||||
[index (process-timeline-proc-index tl)]
|
||||
[proc-name (if (zero? index)
|
||||
[proc-name (if (= 1 index)
|
||||
"Thread 0 (Runtime Thread)"
|
||||
(format "Thread ~a" (process-timeline-proc-id tl)))]
|
||||
[proc-title (text-block-pict proc-name
|
||||
|
|
@ -440,15 +491,18 @@
|
|||
#:width (viewable-region-width vregion))])
|
||||
(draw-stack-onto pct
|
||||
(at 0
|
||||
(- (* (add1 index) (frame-info-row-height finfo)) (viewable-region-y vregion))
|
||||
(- (* index (frame-info-row-height finfo)) (viewable-region-y vregion))
|
||||
(colorize (hline (viewable-region-width vregion) 1) (timeline-baseline-color)))
|
||||
(at 0
|
||||
(+ (+ (- (* index (frame-info-row-height finfo)) (viewable-region-y vregion))
|
||||
(+ (+ (- (* (sub1 index) (frame-info-row-height finfo)) (viewable-region-y vregion))
|
||||
(- (frame-info-row-height finfo) (pict-height proc-title)))
|
||||
1)
|
||||
proc-title)
|
||||
(at start-x
|
||||
(- (calc-row-mid-y index (frame-info-row-height finfo))
|
||||
(- (calc-row-mid-y index
|
||||
(process-timeline-proc-id tl)
|
||||
(frame-info-row-height finfo)
|
||||
num-tls)
|
||||
(viewable-region-y vregion))
|
||||
(colorize (hline (- end-x start-x) 1)
|
||||
(timeline-event-baseline-color))))))))
|
||||
|
|
@ -459,6 +513,7 @@
|
|||
(define (make-stand-out-pict seg)
|
||||
(case (event-type (segment-event seg))
|
||||
[(start-work start-0-work) (scale (pict-for-segment seg) 1 2)]
|
||||
[(gc) (cellophane (pict-for-segment seg) 1)]
|
||||
[else (scale (pict-for-segment seg) 2)]))
|
||||
|
||||
;;frame-bg : viewable-region frame-info trace -> pict
|
||||
|
|
@ -515,10 +570,10 @@
|
|||
(cond
|
||||
[selected-event-index
|
||||
(define overlay (timeline-overlay vregion
|
||||
#f
|
||||
(list-ref segments selected-event-index)
|
||||
finfo
|
||||
tr))
|
||||
#f
|
||||
(list-ref segments selected-event-index)
|
||||
finfo
|
||||
tr))
|
||||
(pin-over tp
|
||||
0
|
||||
0
|
||||
|
|
@ -572,33 +627,7 @@
|
|||
color
|
||||
#:width width
|
||||
#:with-arrow with-arrow
|
||||
#:style style))))
|
||||
|
||||
#;(define (get-seg-left-of-vregion vregion seg)
|
||||
(define prev-in-time (segment-prev-future-seg seg))
|
||||
(cond
|
||||
[(not prev-in-time) seg]
|
||||
[((segment-edge prev-in-time) . < . (viewable-region-x vregion)) prev-in-time]
|
||||
[else (get-seg-left-of-vregion vregion prev-in-time)]))
|
||||
|
||||
#;(define (draw-arrows base-pct vregion seg)
|
||||
(define fst (get-seg-left-of-vregion vregion seg))
|
||||
(let loop ([p base-pct]
|
||||
[cur-seg fst])
|
||||
(define next-seg (segment-next-future-seg cur-seg))
|
||||
(cond
|
||||
[(not next-seg) p]
|
||||
[else
|
||||
(define new-p (draw-connection vregion
|
||||
cur-seg
|
||||
next-seg
|
||||
p
|
||||
(event-connection-line-color)
|
||||
#:width 1))
|
||||
(if (not (in-viewable-region-horiz vregion (segment-x next-seg)))
|
||||
new-p
|
||||
(loop new-p next-seg))])))
|
||||
|
||||
#:style style))))
|
||||
|
||||
;;draw-arrows : pict viewable-region segment -> pict
|
||||
(define (draw-arrows base-pct vregion seg)
|
||||
|
|
@ -649,43 +678,48 @@
|
|||
(viewable-region-height vregion)))
|
||||
(define base (blank (viewable-region-width vregion)
|
||||
(viewable-region-height vregion)))
|
||||
(define-values (seg-with-arrows showing-tacked)
|
||||
(define-values (picked-seg showing-tacked)
|
||||
(if tacked (values tacked #t) (values hovered #f)))
|
||||
(if seg-with-arrows
|
||||
(let* ([bg base]
|
||||
[aseg-rel-x (- (segment-x seg-with-arrows) (viewable-region-x vregion))]
|
||||
[aseg-rel-y (- (segment-y seg-with-arrows) (viewable-region-y vregion))]
|
||||
[line (pin-over bg
|
||||
(- (+ aseg-rel-x
|
||||
(/ (segment-width seg-with-arrows) 2))
|
||||
2)
|
||||
0
|
||||
(colorize (vline 1 height) (hover-tickline-color)))]
|
||||
[bigger (make-stand-out-pict seg-with-arrows)]
|
||||
[width-dif (/ (- (pict-width bigger) (segment-width seg-with-arrows)) 2)]
|
||||
[height-dif (/ (- (pict-height bigger) (segment-height seg-with-arrows)) 2)]
|
||||
[magnified (pin-over line
|
||||
(- aseg-rel-x width-dif)
|
||||
(- aseg-rel-y height-dif)
|
||||
bigger)]
|
||||
[hover-magnified (if (and showing-tacked
|
||||
hovered
|
||||
(not (eq? hovered tacked)))
|
||||
(let* ([hmag (make-stand-out-pict hovered)]
|
||||
[hwidth-dif (/ (- (pict-width hmag)
|
||||
(pict-width (pict-for-segment hovered)))
|
||||
2)]
|
||||
[hheight-dif (/ (- (pict-height hmag)
|
||||
(pict-height (pict-for-segment hovered)))
|
||||
2)])
|
||||
(pin-over magnified
|
||||
(- (- (segment-x hovered) (viewable-region-x vregion)) hwidth-dif)
|
||||
(- (- (segment-y hovered) (viewable-region-y vregion)) hheight-dif)
|
||||
hmag))
|
||||
magnified)]
|
||||
[arrows (draw-arrows hover-magnified vregion seg-with-arrows)])
|
||||
arrows)
|
||||
base))
|
||||
(cond
|
||||
[picked-seg
|
||||
(define bg base)
|
||||
(define aseg-rel-x (- (segment-x picked-seg) (viewable-region-x vregion)))
|
||||
(define aseg-rel-y (- (segment-y picked-seg) (viewable-region-y vregion)))
|
||||
(define emphasized (make-stand-out-pict picked-seg))
|
||||
(case (event-type (segment-event picked-seg))
|
||||
[(gc)
|
||||
(pin-over bg aseg-rel-x aseg-rel-y emphasized)]
|
||||
[else
|
||||
(let* ([line (pin-over bg
|
||||
(- (+ aseg-rel-x
|
||||
(/ (segment-width picked-seg) 2))
|
||||
2)
|
||||
0
|
||||
(colorize (vline 1 height) (hover-tickline-color)))]
|
||||
[width-dif (/ (- (pict-width emphasized) (segment-width picked-seg)) 2)]
|
||||
[height-dif (/ (- (pict-height emphasized) (segment-height picked-seg)) 2)]
|
||||
[magnified (pin-over line
|
||||
(- aseg-rel-x width-dif)
|
||||
(- aseg-rel-y height-dif)
|
||||
emphasized)]
|
||||
[hover-magnified (if (and showing-tacked
|
||||
hovered
|
||||
(not (eq? hovered tacked)))
|
||||
(let* ([hmag (make-stand-out-pict hovered)]
|
||||
[hwidth-dif (/ (- (pict-width hmag)
|
||||
(pict-width (pict-for-segment hovered)))
|
||||
2)]
|
||||
[hheight-dif (/ (- (pict-height hmag)
|
||||
(pict-height (pict-for-segment hovered)))
|
||||
2)])
|
||||
(pin-over magnified
|
||||
(- (- (segment-x hovered) (viewable-region-x vregion)) hwidth-dif)
|
||||
(- (- (segment-y hovered) (viewable-region-y vregion)) hheight-dif)
|
||||
hmag))
|
||||
magnified)]
|
||||
[arrows (draw-arrows hover-magnified vregion picked-seg)])
|
||||
arrows)])]
|
||||
[else base]))
|
||||
|
||||
;Draw a line from one node on the creation graph to another
|
||||
;;line-from : drawable-node drawable-node pict viewable-region -> pict
|
||||
|
|
|
|||
|
|
@ -16,22 +16,30 @@
|
|||
(define (rebuild-mouse-index frameinfo tr segs)
|
||||
(let ([ym (make-interval-map)])
|
||||
(for ([tl (in-list (trace-proc-timelines tr))])
|
||||
(let* ([xm (make-interval-map)]
|
||||
[midy (calc-row-mid-y (process-timeline-proc-index tl) (frame-info-row-height frameinfo))]
|
||||
[miny (floor (- midy (/ MIN-SEG-WIDTH 2)))]
|
||||
[maxy (floor (+ midy (/ MIN-SEG-WIDTH 2)))])
|
||||
(define xm (make-interval-map))
|
||||
(define-values (miny maxy)
|
||||
(cond
|
||||
[(equal? (process-timeline-proc-id tl) 'gc)
|
||||
(values 0 (frame-info-adjusted-height frameinfo))]
|
||||
[else
|
||||
(define midy (calc-row-mid-y (process-timeline-proc-index tl)
|
||||
(process-timeline-proc-id tl)
|
||||
(frame-info-row-height frameinfo)
|
||||
(length (trace-proc-timelines tr))))
|
||||
(values (floor (- midy (/ MIN-SEG-WIDTH 2)))
|
||||
(floor (+ midy (/ MIN-SEG-WIDTH 2))))]))
|
||||
(interval-map-set! ym
|
||||
miny
|
||||
maxy
|
||||
xm)
|
||||
(for ([seg (in-list (filter (λ (s)
|
||||
(= (event-proc-id (segment-event s))
|
||||
(process-timeline-proc-id tl)))
|
||||
(equal? (event-proc-id (segment-event s))
|
||||
(process-timeline-proc-id tl)))
|
||||
segs))])
|
||||
(interval-map-set! xm
|
||||
(segment-x seg)
|
||||
(+ (segment-x seg) (segment-width seg))
|
||||
seg))))
|
||||
seg)))
|
||||
ym))
|
||||
|
||||
;;display-evt-details : segment trace message message message message message message -> void
|
||||
|
|
@ -51,14 +59,19 @@
|
|||
(send fid-label set-label (format "Future ID: ~a" (if (not (event-future-id evt))
|
||||
"None (top-level event)"
|
||||
(event-future-id evt))))
|
||||
(send pid-label set-label (format "Process ID: ~a" (event-proc-id evt)))
|
||||
(send pid-label set-label (format "Process ID: ~a"
|
||||
(let ([id (event-proc-id evt)])
|
||||
(if (equal? id 'gc)
|
||||
RT-THREAD-ID
|
||||
id))))
|
||||
(case (event-type evt)
|
||||
[(start-work start-0-work)
|
||||
[(start-work start-0-work gc)
|
||||
(send data-label1 set-label (format "Duration: ~a" (get-time-string (- (event-end-time evt)
|
||||
(event-start-time evt)))))]
|
||||
[(block sync)
|
||||
(when (= (event-proc-id evt) RT-THREAD-ID)
|
||||
(send data-label1 set-label (format "Primitive: ~a" (symbol->string (event-prim-name evt)))))
|
||||
(if (= (event-proc-id evt) RT-THREAD-ID)
|
||||
(send data-label1 set-label (format "Primitive: ~a" (symbol->string (event-prim-name evt))))
|
||||
(send data-label1 set-label ""))
|
||||
(define label2-txt (cond
|
||||
[(touch-event? evt) (format "Touching future ~a" (event-user-data evt))]
|
||||
[(allocation-event? evt) (format "Size: ~a" (event-user-data evt))]
|
||||
|
|
@ -289,6 +302,8 @@
|
|||
(format "Barricades: ~a" (trace-num-blocks the-trace))))
|
||||
(define syncs-label (label left-bot-panel
|
||||
(format "Syncs: ~a" (trace-num-syncs the-trace))))
|
||||
(define gcs-label (label left-bot-panel
|
||||
(format "GC's: ~a" (trace-num-gcs the-trace))))
|
||||
|
||||
;Selected-event-specific labels
|
||||
(define hover-label (mt-bold-label mid-bot-panel))
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
(require racket/contract
|
||||
"private/visualizer-data.rkt")
|
||||
(provide (struct-out future-event)
|
||||
(struct-out gc-info)
|
||||
(struct-out indexed-future-event)
|
||||
trace-futures
|
||||
(contract-out
|
||||
|
|
|
|||
|
|
@ -64,12 +64,31 @@ the execution of parallel programs written using @racket[future].
|
|||
}
|
||||
|
||||
@defstruct[indexed-future-event ([index exact-nonnegative-integer?]
|
||||
[event future-event?])]{
|
||||
Represents an individual log message in a program trace. Because multiple
|
||||
[event (or future-event? gc-info?)])]{
|
||||
Represents an individual log message in a program trace. In addition to
|
||||
future events, the tracing code also records garbage collection events; hence
|
||||
the @racket[event] field may contain either a @racket[future-event] or @racket[gc-info],
|
||||
where the latter describes a GC operation. 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.
|
||||
}
|
||||
|
||||
@defstruct[gc-info ([major? boolean?]
|
||||
[pre-used integer?]
|
||||
[pre-admin integer?]
|
||||
[code-page-total integer?]
|
||||
[post-used integer?]
|
||||
[post-admin integer?]
|
||||
[start-time integer?]
|
||||
[end-time integer?]
|
||||
[start-real-time real?]
|
||||
[end-real-time real?])
|
||||
#:prefab]{
|
||||
Represents a garbage collection. The only fields used by the visualizer
|
||||
are @racket[start-real-time] and @racket[end-real-time], which are inexact
|
||||
numbers representing time in the same way as @racket[current-inexact-milliseconds].
|
||||
}
|
||||
|
||||
@; ------------------------------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -68,7 +68,8 @@ The @deftech{execution timeline}, shown in the top left-hand corner of the
|
|||
profiler window, displays a history of the program
|
||||
and all events associated with its futures, with OS-level threads
|
||||
or @deftech{processes} organized along the y-axis and time increasing along
|
||||
the x-axis. A coloring convention is used to distinguish between
|
||||
the x-axis. Garbage collections are shown as translucent maroon bars spanning
|
||||
the height of the timeline. A coloring convention is used to distinguish between
|
||||
different types of events (see @secref["future-logging"] for a full
|
||||
description of these event types):
|
||||
|
||||
|
|
@ -83,10 +84,12 @@ description of these event types):
|
|||
|
||||
@item{White dot: @racket['result], @racket['end-work]}
|
||||
|
||||
@item{Green dot: @racket['touch-pause], @racket['touch-resume]}
|
||||
@item{Green dot: @racket['touch-pause], @racket['touch-resume]}
|
||||
|
||||
@item{Maroon bar: @racket['gc]}
|
||||
]
|
||||
|
||||
Mousing over any event connects it via purple lines to the sequence
|
||||
Mousing over any non-GC event connects it via purple lines to the sequence
|
||||
of events for its future. Additionally, orange dotted lines
|
||||
with arrowheads may be shown to indicate operations performed from
|
||||
one future to another (e.g. @racket['create] or @racket['touch] actions).
|
||||
|
|
|
|||
|
|
@ -56,7 +56,7 @@
|
|||
(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)])
|
||||
[organized (organize-output future-log 0 3)])
|
||||
(check-equal? (vector-length organized) 2)
|
||||
(let ([proc0log (vector-ref organized 0)]
|
||||
[proc1log (vector-ref organized 1)])
|
||||
|
|
@ -82,7 +82,7 @@
|
|||
(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)])
|
||||
[organized (organize-output future-log 0 7)])
|
||||
(check-equal? (vector-length organized) 3)
|
||||
(let ([proc0log (vector-ref organized 0)]
|
||||
[proc1log (vector-ref organized 1)]
|
||||
|
|
@ -202,7 +202,7 @@
|
|||
|
||||
;Viewable region tests
|
||||
(define (make-seg-at x y w h)
|
||||
(segment #f x y w h #f #f #f #f #f #f #f #f))
|
||||
(segment #f x y w h #f #f #f #f #f #f #f #f #f))
|
||||
|
||||
;;make-segs-with-times : (listof (or float (float . float))) -> (listof segment)
|
||||
(define (make-segs-with-times . times)
|
||||
|
|
@ -216,8 +216,8 @@
|
|||
(segment (event index
|
||||
real-start-time
|
||||
real-end-time
|
||||
0 0 0 0 0 0 0 0 0 0 0 0 0 #f)
|
||||
0 0 0 0 #f #f #f #f #f #f #f #f))
|
||||
0 0 0 0 0 0 0 0 0 0 0 0 0 #f)
|
||||
0 0 0 0 #f #f #f #f #f #f #f #f #f))
|
||||
|
||||
|
||||
(let ([vregion (viewable-region 20 30 100 100)]
|
||||
|
|
@ -291,6 +291,49 @@
|
|||
(check-equal? (length (hash-keys (trace-sync-counts tr))) 0)
|
||||
(check-equal? (length (hash-keys (trace-future-rtcalls tr))) 1))
|
||||
|
||||
(define gci (gc-info #f 0 0 0 0 0 0 0 4.0 6.0))
|
||||
(check-true (gc-event? gci))
|
||||
(check-true (gc-event? (indexed-future-event 0 gci)))
|
||||
|
||||
(define gc-log1
|
||||
(list
|
||||
(indexed-future-event 0 (future-event #f 0 'create 10.0 #f 1))
|
||||
(indexed-future-event 1 (gc-info #f 0 0 0 0 0 0 0 4.0 6.0))
|
||||
(indexed-future-event 2 (future-event 1 1 'start-work 11.0 #f 0))
|
||||
(indexed-future-event 3 (future-event 1 1 'complete 14.0 #f 0))
|
||||
(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))
|
||||
|
||||
(define gc-log2
|
||||
(list
|
||||
(indexed-future-event 0 (future-event #f 0 'create 10.0 #f 1))
|
||||
(indexed-future-event 1 (gc-info #f 0 0 0 0 0 0 0 14.0 19.0))
|
||||
(indexed-future-event 2 (future-event 1 1 'start-work 11.0 #f 0))
|
||||
(indexed-future-event 3 (future-event 1 1 'complete 20.0 #f 0))
|
||||
(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? (trace-num-gcs tr) 1))
|
||||
|
||||
(define gc-log3
|
||||
(list
|
||||
(indexed-future-event 0 (future-event #f 0 'create 10.0 #f 1))
|
||||
(indexed-future-event 1 (future-event 1 1 'start-work 11.0 #f 0))
|
||||
(indexed-future-event 2 (gc-info #f 0 0 0 0 0 0 0 14.0 15.0))
|
||||
(indexed-future-event 3 (gc-info #f 0 0 0 0 0 0 0 15.0 19.5))
|
||||
(indexed-future-event 4 (future-event 1 1 'complete 20.0 #f 0))
|
||||
(indexed-future-event 5 (future-event 1 1 'end-work 21.0 #f 0))))
|
||||
(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)
|
||||
(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)))))
|
||||
|
||||
;Graph drawing tests
|
||||
(let* ([nodea (drawable-node (node 'a '()) 5 5 10 0 0 '() 10)]
|
||||
[center (drawable-node-center nodea)])
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user