/usr/share/racket/pkgs/profile-lib/render-text.rkt is in racket-common 6.7-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 | #lang at-exp racket/base
(provide render)
(require "analyzer.rkt" "utils.rkt" racket/list racket/string)
(define (f:msec msec)
(number->string (round (inexact->exact msec))))
(define (f:msec* msec)
(string-append (f:msec msec) "ms"))
(define (display-table aligns table)
;; * thunks are used for cells that are ignored when inspecting widths
;; * chars are used for filler cells
(define (display-line strings)
(printf "~a\n" (regexp-replace #rx" +$" (string-append* strings) "")))
(define widths
(let loop ([table table])
(define table* (filter pair? table))
(if (null? table*) '()
(cons (apply max
(filter-map
(λ (x) (and (string? (car x)) (string-length (car x))))
table*))
(loop (map cdr table*))))))
(for ([row (in-list table)])
(display-line
(for/list ([cell (in-list row)]
[width (in-list widths)]
[align (in-list aligns)])
(define cell*
(cond [(char? cell) (make-string width cell)]
[(procedure? cell) (cell)]
[else cell]))
(define pad
(make-string (max 0 (- width (string-length cell*))) #\space))
(case align
[(l) (string-append cell* pad)]
[(r) (string-append pad cell*)]
[else (error 'internal-error "poof")])))))
(define (render profile
[order 'topological]
#:truncate-source [truncate-source 50]
#:hide-self [hide-self% 1/100]
#:hide-subs [hide-subs% 2/100])
(unless (member order '(topological self total))
(raise-argument-error 'render "(or/c 'topological 'self 'total)" order))
(define key (if (eq? order 'total) node-total node-self))
(define (show . xs)
(let loop ([x xs])
(cond [(or (not x) (null? x) (void? x)) (void)]
[(pair? x) (loop (car x)) (loop (cdr x))]
[else (display x)]))
(newline))
(define total-time (profile-total-time profile)) ;!! are these two
(define cpu-time (profile-cpu-time profile)) ;!! swapped?
(define sample-number (profile-sample-number profile))
(define granularity (if (zero? sample-number) 0 ;!! this might
(/ total-time sample-number))) ;!! be wrong
(define threads+times (profile-thread-times profile))
(define *-node (profile-*-node profile))
(define hidden (get-hidden profile hide-self% hide-subs%))
(define nodes (let ([incnodes (remq* hidden (profile-nodes profile))])
(if (eq? order 'topological)
incnodes
(sort incnodes > #:key key))))
(define node->
(let ([t (make-hasheq)])
(for ([node (in-list nodes)] [idx (in-naturals 1)])
(define index (format "[~a]" idx))
(define label (format "~a" (or (node-id node) '???)))
(hash-set! t node (list index label @string-append{@label @index})))
(λ (mode node)
((case mode [(index) car] [(label) cadr] [(sub-label) caddr])
(hash-ref t node)))))
(define (sep ch) (list ch ch ch ch ch ch ch ch ch ch))
(define =sep (sep #\=))
(define -sep (sep #\-))
@show{
Profiling results
-----------------
Total cpu time observed: @f:msec*[total-time] (out of @f:msec*[cpu-time])
Number of samples taken: @sample-number (once every @f:msec*[granularity])
}
(when (> (length threads+times) 1)
@show{ Threads observed: @(length threads+times)})
(when (pair? hidden)
(define hidden# (length hidden))
(define nodes# (length (profile-nodes profile)))
(define self% @string-append{self<@(format-percent (or hide-self% 0))})
(define subs% @string-append{local<@(format-percent (or hide-subs% 0))})
(define %s (cond [(not hide-self%) subs%]
[(not hide-subs%) self%]
[else @string-append{@self% and @subs%}]))
@show{ (Hiding functions with @|%s|: @hidden# of @nodes# hidden)})
(newline)
(display-table
'(r l r l l r l l l r l l)
(append*
`(,=sep
(" " " " " "" " " " " "" " " " " Caller")
("Idx" " " "To""tal " " " "Se""lf " " " "Name+src" "Local%")
(" " " " " ms""(pct)" " " "ms""(pct)" " " " Callee")
,=sep)
(for/list ([node (in-list nodes)])
(define index (node-> 'index node))
(define name (node-> 'label node))
(define total (node-total node))
(define totalS (f:msec total))
(define total% @string-append{(@(format-percent total total-time))})
(define self (node-self node))
(define selfS (f:msec self))
(define self% @string-append{(@(format-percent self total-time))})
(define name+src
(let* ([src (format-source (node-src node))]
[src-len (string-length src)]
[name-len (string-length name)])
(string-append
name " "
;; truncate-source only truncates the source
(let* ([n (and truncate-source
((+ src-len name-len 1) . - . truncate-source))]
[n (and n (positive? n) (- src-len n 3))])
(cond [(not n) src]
[(n . <= . 0) "..."]
[else (string-append "..."
(substring src (- src-len n)))])))))
(define (sub get-edges get-node get-node-time)
(for*/list ([edge (in-list (get-edges node))]
[sub (in-list (list (get-node edge)))] ; <-- hack...
#:unless (or (eq? *-node sub) ; <-- ...for this
(memq sub hidden)))
(define name (node-> 'sub-label sub))
(define local% (format-percent (get-node-time edge) total))
`("" "" "" "" "" "" "" ""
,(string-append " " name) ,local%
"" "")))
`(,@(reverse (sub node-callers edge-caller edge-caller-time))
(,(node-> 'index node)
" " ,totalS ,total%
" " ,selfS ,self%
" " ,(λ () name+src))
,@(sub node-callees edge-callee edge-callee-time)
,-sep)))))
|