added an option of giving create-sampler the super custodian

svn: r14363

original commit: 85cbee30e23668c07c0a6e2df75d7c3b1f0e6718
This commit is contained in:
Eli Barzilay 2009-03-30 19:42:55 +00:00
parent 3a6113ab51
commit 719e7282ba
3 changed files with 15 additions and 11 deletions

View File

@ -11,7 +11,7 @@
;; * The input value can be either a thread (track just that thread), a ;; * The input value can be either a thread (track just that thread), a
;; custodian (track all threads managed by the custodian), or a list of ;; custodian (track all threads managed by the custodian), or a list of
;; threads and/or custodians. If a custodian is given, it must be ;; threads and/or custodians. If a custodian is given, it must be
;; subordinate to the current custodian. ;; subordinate to the current custodian or to the given super custodian.
;; * The collected values are (<thread-id> <thread-time> . <stack>), where ;; * The collected values are (<thread-id> <thread-time> . <stack>), where
;; - The <thread-id> is an integer number identifying the thread, starting ;; - The <thread-id> is an integer number identifying the thread, starting
;; from 0. If the collected data has thread ids in a 0..N range ;; from 0. If the collected data has thread ids in a 0..N range
@ -39,6 +39,8 @@
;; data. (There is no message to start a new sampler thread, although ;; data. (There is no message to start a new sampler thread, although
;; adding one will not be difficult.) ;; adding one will not be difficult.)
;; - 'set-tracked! <new>: changes the thread/s and/or custodian/s to track. ;; - 'set-tracked! <new>: changes the thread/s and/or custodian/s to track.
;; (Custodians should still be subordinate to the original one or to the
;; given argument.)
;; - 'set-delay! <new>: changes the sampling delay. This means that we won't ;; - 'set-delay! <new>: changes the sampling delay. This means that we won't
;; have a direct correlation between the number of samples and the time ;; have a direct correlation between the number of samples and the time
;; they represent -- but the samples are statistical snapshots anyway, and ;; they represent -- but the samples are statistical snapshots anyway, and
@ -48,10 +50,9 @@
;; - 'get-snapshots: returns the currently collected list of snapshots. Note ;; - 'get-snapshots: returns the currently collected list of snapshots. Note
;; that this can be called multiple times, each will return the data that ;; that this can be called multiple times, each will return the data that
;; is collected up to that point in time. ;; is collected up to that point in time.
(define (create-sampler to-track delay) (define (create-sampler to-track delay [super-cust (current-custodian)])
;; the collected data ;; the collected data
(define snapshots '()) (define snapshots '())
(define cust (current-custodian))
;; intern the entries (which are (cons id/#f srcloc/#f)) ;; intern the entries (which are (cons id/#f srcloc/#f))
(define entry-table (make-hash)) (define entry-table (make-hash))
(define (intern-entry entry) (define (intern-entry entry)
@ -74,8 +75,8 @@
who "thread, custodian, or a list of threads/csutodians" to-track)] who "thread, custodian, or a list of threads/csutodians" to-track)]
;; test that it's subordinate ;; test that it's subordinate
[(with-handlers ([exn:fail:contract? (lambda (_) #t)]) [(with-handlers ([exn:fail:contract? (lambda (_) #t)])
(custodian-managed-list t cust) #f) (custodian-managed-list t super-cust) #f)
(error who "got a custodian that is not subordinate to current")]))) (error who "got an insubordinate custodian")])))
(define paused 0) (define paused 0)
(define thread-id (define thread-id
(let ([next-id 0] [t (make-weak-hasheq)]) (let ([next-id 0] [t (make-weak-hasheq)])
@ -98,7 +99,8 @@
(continuation-mark-set->context (continuation-mark-set->context
(continuation-marks t)))) (continuation-marks t))))
snapshots)))] snapshots)))]
[(custodian? t) (for-each loop (custodian-managed-list t cust))] [(custodian? t)
(for-each loop (custodian-managed-list t super-cust))]
;; cannot assume that it's a list: we might get other values from ;; cannot assume that it's a list: we might get other values from
;; a custodian managed list ;; a custodian managed list
[(list? t) (for-each loop t)]))) [(list? t) (for-each loop t)])))

View File

@ -57,9 +57,9 @@ Represents the analyzed profile result.
@item{@scheme[nodes] is a list of nodes representing all observed @item{@scheme[nodes] is a list of nodes representing all observed
functions. These nodes are the components of the call-graph that functions. These nodes are the components of the call-graph that
the analyzer assembles (see the @scheme[edge] field). The nodes are the analyzer assembles (see the @scheme[edge] field). The nodes are
sorted by decreasing total amount of time (time spent either in the sorted by a topological top-to-bottom sort, and by decreasing total
function or in its callees), and by a top-to-bottom topological amount of time (time spent either in the function or in its callees)
sort.} as a secondary key.}
@item{@scheme[*-node] holds a ``special'' node value that is @item{@scheme[*-node] holds a ``special'' node value that is
constructed for every graph. This node is used as the caller for constructed for every graph. This node is used as the caller for

View File

@ -9,7 +9,8 @@
@defproc[(create-sampler [to-track (or/c thread? custodian? @defproc[(create-sampler [to-track (or/c thread? custodian?
(listof (or/c thread? custodian?)))] (listof (or/c thread? custodian?)))]
[delay nonnegative-number?]) [delay nonnegative-number?]
[super-cust custodian? (current-custodian)])
((symbol?) (any/c) . ->* . any/c)]{ ((symbol?) (any/c) . ->* . any/c)]{
Creates a sample collector thread, which tracks the given Creates a sample collector thread, which tracks the given
@ -17,7 +18,8 @@ Creates a sample collector thread, which tracks the given
@scheme[to-track] value can be either a thread (track just that @scheme[to-track] value can be either a thread (track just that
thread), a custodian (track all threads managed by the custodian), or thread), a custodian (track all threads managed by the custodian), or
a list of threads and/or custodians. If a custodian is given, it must a list of threads and/or custodians. If a custodian is given, it must
be subordinate to the current custodian. be subordinate to @scheme[super-cust], which defaults to the current
custodian.
The resulting value is a controller function, which consumes a message The resulting value is a controller function, which consumes a message
consisting of a symbol and an optional argument, and can affect the consisting of a symbol and an optional argument, and can affect the