Tcl Library Source Code

Check-in [eb9ea6260d]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:profiler - Tkt [0dd4b31bb8] EF, D bumped to 0.4 Changed profiler leaveHandler to return command result. This enables use by subsequent non-profiler trace handlers.
Timelines: family | ancestors | descendants | both | profiler-0dd4b31bb8
Files: files | file ages | folders
SHA3-256: eb9ea6260d42f2eeedcefd01192eab5a9fddac5e5d1b0eddc200329063c05b79
User & Date: andreask 2019-06-24 19:45:55
Context
2019-06-24
21:15
Integrated profiler enhancement for ticket [0dd4b31bb8]. check-in: 1e56dce90c user: aku tags: trunk
19:45
profiler - Tkt [0dd4b31bb8] EF, D bumped to 0.4 Changed profiler leaveHandler to return command result. This enables use by subsequent non-profiler trace handlers. Closed-Leaf check-in: eb9ea6260d user: andreask tags: profiler-0dd4b31bb8
19:41
profiler - Tkt [0dd4b31bb8] T More testsuite cleanup, and fix. Moved all the common setup/teardown into a helper procedure and updated all tests Further fixed the package initialization done by the helper as the original code was able to use the wrong implementation. Now explicitly sourcing the code under test. check-in: 6e55e6721e user: andreask tags: profiler-0dd4b31bb8
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to embedded/md/tcllib/files/modules/profiler/profiler.md.

1
2
3
4
5
6
7
8
9
10
11
..
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
[//000000001]: # (profiler \- Tcl Profiler)
[//000000002]: # (Generated from file 'profiler\.man' by tcllib/doctools with format 'markdown')
[//000000003]: # (profiler\(n\) 0\.3 tcllib "Tcl Profiler")

<hr> [ <a href="../../../../toc.md">Main Table Of Contents</a> &#124; <a
href="../../../toc.md">Table Of Contents</a> &#124; <a
href="../../../../index.md">Keyword Index</a> &#124; <a
href="../../../../toc0.md">Categories</a> &#124; <a
href="../../../../toc1.md">Modules</a> &#124; <a
href="../../../../toc2.md">Applications</a> ] <hr>
................................................................................
  - [Keywords](#keywords)

  - [Category](#category)

# <a name='synopsis'></a>SYNOPSIS

package require Tcl 8\.3  
package require profiler ?0\.3?  

[__::profiler::init__](#1)  
[__::profiler::dump__ *pattern*](#2)  
[__::profiler::print__ ?*pattern*?](#3)  
[__::profiler::reset__ ?*pattern*?](#4)  
[__::profiler::suspend__ ?*pattern*?](#5)  
[__::profiler::resume__ ?*pattern*?](#6)  


|







 







|







1
2
3
4
5
6
7
8
9
10
11
..
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
[//000000001]: # (profiler \- Tcl Profiler)
[//000000002]: # (Generated from file 'profiler\.man' by tcllib/doctools with format 'markdown')
[//000000003]: # (profiler\(n\) 0\.4 tcllib "Tcl Profiler")

<hr> [ <a href="../../../../toc.md">Main Table Of Contents</a> &#124; <a
href="../../../toc.md">Table Of Contents</a> &#124; <a
href="../../../../index.md">Keyword Index</a> &#124; <a
href="../../../../toc0.md">Categories</a> &#124; <a
href="../../../../toc1.md">Modules</a> &#124; <a
href="../../../../toc2.md">Applications</a> ] <hr>
................................................................................
  - [Keywords](#keywords)

  - [Category](#category)

# <a name='synopsis'></a>SYNOPSIS

package require Tcl 8\.3  
package require profiler ?0\.4?  

[__::profiler::init__](#1)  
[__::profiler::dump__ *pattern*](#2)  
[__::profiler::print__ ?*pattern*?](#3)  
[__::profiler::reset__ ?*pattern*?](#4)  
[__::profiler::suspend__ ?*pattern*?](#5)  
[__::profiler::resume__ ?*pattern*?](#6)  

Changes to idoc/man/files/modules/profiler/profiler.n.

1
2
3
4
5
6
7
8
9
10
11
...
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
'\"
'\" Generated from file 'profiler\&.man' by tcllib/doctools with format 'nroff'
'\"
.TH "profiler" n 0\&.3 tcllib "Tcl Profiler"
.\" The -*- nroff -*- definitions below are for supplemental macros used
.\" in Tcl/Tk manual entries.
.\"
.\" .AP type name in/out ?indent?
.\"	Start paragraph describing an argument to a library procedure.
.\"	type is type of argument (int, etc.), in/out is either "in", "out",
.\"	or "in/out" to describe whether procedure reads or modifies arg,
................................................................................
..
.BS
.SH NAME
profiler \- Tcl source code profiler
.SH SYNOPSIS
package require \fBTcl  8\&.3\fR
.sp
package require \fBprofiler  ?0\&.3?\fR
.sp
\fB::profiler::init\fR
.sp
\fB::profiler::dump\fR \fIpattern\fR
.sp
\fB::profiler::print\fR ?\fIpattern\fR?
.sp


|







 







|







1
2
3
4
5
6
7
8
9
10
11
...
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
'\"
'\" Generated from file 'profiler\&.man' by tcllib/doctools with format 'nroff'
'\"
.TH "profiler" n 0\&.4 tcllib "Tcl Profiler"
.\" The -*- nroff -*- definitions below are for supplemental macros used
.\" in Tcl/Tk manual entries.
.\"
.\" .AP type name in/out ?indent?
.\"	Start paragraph describing an argument to a library procedure.
.\"	type is type of argument (int, etc.), in/out is either "in", "out",
.\"	or "in/out" to describe whether procedure reads or modifies arg,
................................................................................
..
.BS
.SH NAME
profiler \- Tcl source code profiler
.SH SYNOPSIS
package require \fBTcl  8\&.3\fR
.sp
package require \fBprofiler  ?0\&.4?\fR
.sp
\fB::profiler::init\fR
.sp
\fB::profiler::dump\fR \fIpattern\fR
.sp
\fB::profiler::print\fR ?\fIpattern\fR?
.sp

Changes to idoc/www/tcllib/files/modules/profiler/profiler.html.

101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
...
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
&#124; <a href="../../../toc.html">Table Of Contents</a>
&#124; <a href="../../../../index.html">Keyword Index</a>
&#124; <a href="../../../../toc0.html">Categories</a>
&#124; <a href="../../../../toc1.html">Modules</a>
&#124; <a href="../../../../toc2.html">Applications</a>
 ] <hr>
<div class="doctools">
<h1 class="doctools_title">profiler(n) 0.3 tcllib &quot;Tcl Profiler&quot;</h1>
<div id="name" class="doctools_section"><h2><a name="name">Name</a></h2>
<p>profiler - Tcl source code profiler</p>
</div>
<div id="toc" class="doctools_section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="doctools_toc">
<li class="doctools_section"><a href="#toc">Table Of Contents</a></li>
<li class="doctools_section"><a href="#synopsis">Synopsis</a></li>
................................................................................
<li class="doctools_section"><a href="#category">Category</a></li>
</ul>
</div>
<div id="synopsis" class="doctools_section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="doctools_synopsis">
<ul class="doctools_requirements">
<li>package require <b class="pkgname">Tcl 8.3</b></li>
<li>package require <b class="pkgname">profiler <span class="opt">?0.3?</span></b></li>
</ul>
<ul class="doctools_syntax">
<li><a href="#1"><b class="cmd">::profiler::init</b></a></li>
<li><a href="#2"><b class="cmd">::profiler::dump</b> <i class="arg">pattern</i></a></li>
<li><a href="#3"><b class="cmd">::profiler::print</b> <span class="opt">?<i class="arg">pattern</i>?</span></a></li>
<li><a href="#4"><b class="cmd">::profiler::reset</b> <span class="opt">?<i class="arg">pattern</i>?</span></a></li>
<li><a href="#5"><b class="cmd">::profiler::suspend</b> <span class="opt">?<i class="arg">pattern</i>?</span></a></li>






|







 







|







101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
...
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
&#124; <a href="../../../toc.html">Table Of Contents</a>
&#124; <a href="../../../../index.html">Keyword Index</a>
&#124; <a href="../../../../toc0.html">Categories</a>
&#124; <a href="../../../../toc1.html">Modules</a>
&#124; <a href="../../../../toc2.html">Applications</a>
 ] <hr>
<div class="doctools">
<h1 class="doctools_title">profiler(n) 0.4 tcllib &quot;Tcl Profiler&quot;</h1>
<div id="name" class="doctools_section"><h2><a name="name">Name</a></h2>
<p>profiler - Tcl source code profiler</p>
</div>
<div id="toc" class="doctools_section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="doctools_toc">
<li class="doctools_section"><a href="#toc">Table Of Contents</a></li>
<li class="doctools_section"><a href="#synopsis">Synopsis</a></li>
................................................................................
<li class="doctools_section"><a href="#category">Category</a></li>
</ul>
</div>
<div id="synopsis" class="doctools_section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="doctools_synopsis">
<ul class="doctools_requirements">
<li>package require <b class="pkgname">Tcl 8.3</b></li>
<li>package require <b class="pkgname">profiler <span class="opt">?0.4?</span></b></li>
</ul>
<ul class="doctools_syntax">
<li><a href="#1"><b class="cmd">::profiler::init</b></a></li>
<li><a href="#2"><b class="cmd">::profiler::dump</b> <i class="arg">pattern</i></a></li>
<li><a href="#3"><b class="cmd">::profiler::print</b> <span class="opt">?<i class="arg">pattern</i>?</span></a></li>
<li><a href="#4"><b class="cmd">::profiler::reset</b> <span class="opt">?<i class="arg">pattern</i>?</span></a></li>
<li><a href="#5"><b class="cmd">::profiler::suspend</b> <span class="opt">?<i class="arg">pattern</i>?</span></a></li>

Changes to modules/profiler/pkgIndex.tcl.

1
2
if {![package vsatisfies [package provide Tcl] 8.3]} {return}
package ifneeded profiler 0.3 [list source [file join $dir profiler.tcl]]
|
1
2
if {![package vsatisfies [package provide Tcl] 8.3]} {return}
package ifneeded profiler 0.4 [list source [file join $dir profiler.tcl]]

Changes to modules/profiler/profiler.man.


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
[comment {-*- tcl -*- doctools manpage}]
[manpage_begin profiler n 0.3]
[keywords performance]
[keywords profile]
[keywords speed]
[moddesc   {Tcl Profiler}]
[titledesc {Tcl source code profiler}]
[category  {Programming tools}]
[require Tcl 8.3]
[require profiler [opt 0.3]]
[description]
[para]

The [package profiler] package provides a simple Tcl source code
profiler.  It is a function-level profiler; that is, it collects only
function-level information, not the more detailed line-level
information.  It operates by redefining the Tcl [cmd proc] command.
>

|







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
[vset VERSION 0.4]
[comment {-*- tcl -*- doctools manpage}]
[manpage_begin profiler n [vset VERSION]]
[keywords performance]
[keywords profile]
[keywords speed]
[moddesc   {Tcl Profiler}]
[titledesc {Tcl source code profiler}]
[category  {Programming tools}]
[require Tcl 8.3]
[require profiler [opt [vset VERSION]]]
[description]
[para]

The [package profiler] package provides a simple Tcl source code
profiler.  It is a function-level profiler; that is, it collects only
function-level information, not the more detailed line-level
information.  It operates by redefining the Tcl [cmd proc] command.

Changes to modules/profiler/profiler.tcl.

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
...
226
227
228
229
230
231
232



233
234

235
236
237
238
239
240
241
...
243
244
245
246
247
248
249


250
251
252
253
254
255
256
...
631
632
633
634
635
636
637
638
#
#	Tcl code profiler.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: profiler.tcl,v 1.29 2006/09/19 23:36:17 andreas_kupries Exp $

package require Tcl 8.3		;# uses [clock clicks -milliseconds]
package provide profiler 0.3

namespace eval ::profiler {
}

# ::profiler::tZero --
#
#	Start a named timer instance
#
# Arguments:
#	tag	name for the timer instance; if none is given, defaults to ""
................................................................................
#
# Results:
#	None

proc ::profiler::leaveHandler {name caller} {
    variable enabled




    if { !$enabled($name) } {
        return

    }

    set t [::profiler::tMark $name.$caller]
    lappend ::profiler::statTime($name) $t

    if { [incr ::profiler::callCount($name)] == 1 } {
        set ::profiler::compileTime($name) $t
................................................................................
    incr ::profiler::totalRuntime($name) $t
    if { [catch {incr ::profiler::descendantTime($caller) $t}] } {
        set ::profiler::descendantTime($caller) $t
    }
    if { [catch {incr ::profiler::descendants($caller,$name)}] } {
        set ::profiler::descendants($caller,$name) 1
    }


}

# ::profiler::profProc --
#
#	Replacement for the proc command that adds rudimentary profiling
#	capabilities to Tcl.
#
................................................................................
    set paused 0
    foreach name [array names callCount $pattern] {
        set enabled($name) 1
    }

    return
}







|
<
<

|

|
<







 







>
>
>

<
>







 







>
>







 







<
2
3
4
5
6
7
8
9


10
11
12
13

14
15
16
17
18
19
20
...
223
224
225
226
227
228
229
230
231
232
233

234
235
236
237
238
239
240
241
...
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
...
633
634
635
636
637
638
639

#
#	Tcl code profiler.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.



package require Tcl 8.3		;# uses [clock clicks -milliseconds]
package provide profiler 0.4

namespace eval ::profiler {}


# ::profiler::tZero --
#
#	Start a named timer instance
#
# Arguments:
#	tag	name for the timer instance; if none is given, defaults to ""
................................................................................
#
# Results:
#	None

proc ::profiler::leaveHandler {name caller} {
    variable enabled

    # Tkt [0dd4b31bb8] Note that the result is pulled from the
    # caller's context as it is not passed into leaveHandler
    
    if { !$enabled($name) } {

	return [uplevel 1 {lindex $args 1}] ;# RETURN RESULT!
    }

    set t [::profiler::tMark $name.$caller]
    lappend ::profiler::statTime($name) $t

    if { [incr ::profiler::callCount($name)] == 1 } {
        set ::profiler::compileTime($name) $t
................................................................................
    incr ::profiler::totalRuntime($name) $t
    if { [catch {incr ::profiler::descendantTime($caller) $t}] } {
        set ::profiler::descendantTime($caller) $t
    }
    if { [catch {incr ::profiler::descendants($caller,$name)}] } {
        set ::profiler::descendants($caller,$name) 1
    }

    return [uplevel 1 {lindex $args 1}] ;# RETURN RESULT!
}

# ::profiler::profProc --
#
#	Replacement for the proc command that adds rudimentary profiling
#	capabilities to Tcl.
#
................................................................................
    set paused 0
    foreach name [array names callCount $pattern] {
        set enabled($name) 1
    }

    return
}