MessageTally.st
author Claus Gittinger <cg@exept.de>
Thu, 25 Apr 1996 19:12:40 +0200
changeset 236 7f570e0a0a75
parent 120 950e4628d657
child 244 42acac0f7b8c
permissions -rw-r--r--
documentation
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
470788421600 Initial revision
claus
parents:
diff changeset
     1
"
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
     2
 COPYRIGHT (c) 1995 by Claus Gittinger
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
     3
	      All Rights Reserved
0
470788421600 Initial revision
claus
parents:
diff changeset
     4
470788421600 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
470788421600 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
470788421600 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
470788421600 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
470788421600 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
470788421600 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
470788421600 Initial revision
claus
parents:
diff changeset
    11
"
470788421600 Initial revision
claus
parents:
diff changeset
    12
120
950e4628d657 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 119
diff changeset
    13
Object subclass:#MessageTally
236
7f570e0a0a75 documentation
Claus Gittinger <cg@exept.de>
parents: 120
diff changeset
    14
	instanceVariableNames:'process tree ntally theBlock spyInterval'
7f570e0a0a75 documentation
Claus Gittinger <cg@exept.de>
parents: 120
diff changeset
    15
	classVariableNames:''
7f570e0a0a75 documentation
Claus Gittinger <cg@exept.de>
parents: 120
diff changeset
    16
	poolDictionaries:''
7f570e0a0a75 documentation
Claus Gittinger <cg@exept.de>
parents: 120
diff changeset
    17
	category:'System-Debugging-Support'
0
470788421600 Initial revision
claus
parents:
diff changeset
    18
!
470788421600 Initial revision
claus
parents:
diff changeset
    19
9
f5b6ab00bdf6 *** empty log message ***
claus
parents: 5
diff changeset
    20
!MessageTally class methodsFor:'documentation'!
f5b6ab00bdf6 *** empty log message ***
claus
parents: 5
diff changeset
    21
88
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    22
copyright
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    23
"
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    24
 COPYRIGHT (c) 1995 by Claus Gittinger
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    25
	      All Rights Reserved
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    26
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    27
 This software is furnished under a license and may be used
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    28
 only in accordance with the terms of that license and with the
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    29
 inclusion of the above copyright notice.   This software may not
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    30
 be provided or otherwise made available to, or used by, any
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    31
 other person.  No title to or ownership of the software is
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    32
 hereby transferred.
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    33
"
9
f5b6ab00bdf6 *** empty log message ***
claus
parents: 5
diff changeset
    34
!
f5b6ab00bdf6 *** empty log message ***
claus
parents: 5
diff changeset
    35
f5b6ab00bdf6 *** empty log message ***
claus
parents: 5
diff changeset
    36
documentation
f5b6ab00bdf6 *** empty log message ***
claus
parents: 5
diff changeset
    37
"
f5b6ab00bdf6 *** empty log message ***
claus
parents: 5
diff changeset
    38
    MessageTally allows profiling excution of a block; 
f5b6ab00bdf6 *** empty log message ***
claus
parents: 5
diff changeset
    39
    statistic of method evaluation is output on Transcript.
f5b6ab00bdf6 *** empty log message ***
claus
parents: 5
diff changeset
    40
    To get statistic, use 'MessageTally spyOn:aBlock'.
f5b6ab00bdf6 *** empty log message ***
claus
parents: 5
diff changeset
    41
f5b6ab00bdf6 *** empty log message ***
claus
parents: 5
diff changeset
    42
    example:
236
7f570e0a0a75 documentation
Claus Gittinger <cg@exept.de>
parents: 120
diff changeset
    43
        MessageTally spyOn:[
7f570e0a0a75 documentation
Claus Gittinger <cg@exept.de>
parents: 120
diff changeset
    44
            (ByteArray uninitalizedNew:1000) sort
7f570e0a0a75 documentation
Claus Gittinger <cg@exept.de>
parents: 120
diff changeset
    45
        ]
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    46
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    47
    By default, probing is done every 10ms (i.e. the execution of the block is 
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    48
    interrupted every 10ms, and the context chain analyzed).
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    49
    For better resolution, use smaller clock ticks (if your OperatingSystem
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    50
    supports it). Try spyDetailedOn:aBlock, which tries to measure things
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    51
    every 1ms. (Notice, that some OS's only provide a resolution of less than
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    52
    that time interval)
236
7f570e0a0a75 documentation
Claus Gittinger <cg@exept.de>
parents: 120
diff changeset
    53
7f570e0a0a75 documentation
Claus Gittinger <cg@exept.de>
parents: 120
diff changeset
    54
    [author:]
7f570e0a0a75 documentation
Claus Gittinger <cg@exept.de>
parents: 120
diff changeset
    55
        Claus Gittinger
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    56
"
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    57
!
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    58
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    59
examples
9
f5b6ab00bdf6 *** empty log message ***
claus
parents: 5
diff changeset
    60
"
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    61
     MessageTally spyOn:[ #(6 5 4 3 2 1) sort ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    62
     MessageTally spyOn:[100 timesRepeat:[#(6 5 4 3 2 1) sort] ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    63
     MessageTally spyOn:[1000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    64
     MessageTally spyOn:[10000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    65
     MessageTally spyOn:[100000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    66
     MessageTally spyOn:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    67
     MessageTally spyDetailedOn:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    68
     Time millisecondsToRun:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    69
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    70
     MessageTally spyOn:[SystemBrowser open ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    71
     MessageTally spyDetailedOn:[SystemBrowser open ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    72
"
9
f5b6ab00bdf6 *** empty log message ***
claus
parents: 5
diff changeset
    73
! !
0
470788421600 Initial revision
claus
parents:
diff changeset
    74
470788421600 Initial revision
claus
parents:
diff changeset
    75
!MessageTally class methodsFor:'instance creation'!
470788421600 Initial revision
claus
parents:
diff changeset
    76
88
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    77
spyDetailedOn:aBlock
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    78
    "evaluate aBlock and output time statistic on the Transcript.
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    79
     Tick is 1ms."
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    80
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    81
    ^ self spyOn:aBlock interval:1
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    82
!
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    83
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    84
spyOn:aBlock
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    85
    "evaluate aBlock and output time statistic on the Transcript.
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    86
     Tick is 10ms."
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    87
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    88
    ^ self spyOn:aBlock interval:10
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    89
!
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
    90
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    91
spyOn:aBlock interval:ms
0
470788421600 Initial revision
claus
parents:
diff changeset
    92
    "evaluate aBlock and output time statistic on Transcript"
470788421600 Initial revision
claus
parents:
diff changeset
    93
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    94
    |runTime aTally nTally|
0
470788421600 Initial revision
claus
parents:
diff changeset
    95
470788421600 Initial revision
claus
parents:
diff changeset
    96
    aTally := self new.
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    97
    runTime := aTally spyOn:aBlock interval:ms.
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    98
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
    99
    aTally tree isNil ifTrue:[
24
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   100
	Transcript cr.
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   101
	Transcript showCr:'TALLY: No probes - execution time too short;'.
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   102
	Transcript showCr:'TALLY: retry using: spyOn:[n timesRepeat:[...]]'.
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   103
    ] ifFalse:[
24
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   104
	"/ aTally tree inspect.
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   105
	nTally := aTally nTally.
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   106
	Transcript cr.
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   107
	Transcript showCr:('total execution time: '
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   108
			   , runTime printString , ' ms '
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   109
			   , '(' , nTally printString , ' probes ;'
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   110
			   , ' error >= ' 
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   111
			   , (1000 // nTally / 10.0) printString
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   112
			   , '%)').
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   113
	Transcript cr.
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   114
	aTally tree printOn:Transcript.
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   115
	Transcript cr.
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   116
	Transcript cr.
0
470788421600 Initial revision
claus
parents:
diff changeset
   117
24
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   118
	Transcript showCr:'leafs of calling tree:'.
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   119
	Transcript cr.
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   120
	aTally tree printLeafsOn:Transcript.
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   121
	Transcript cr.
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   122
24
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   123
	"
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   124
	aTally statistics.
10e1150b1f4b *** empty log message ***
claus
parents: 21
diff changeset
   125
	"
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   126
    ].
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   127
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   128
    "
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   129
     MessageTally spyOn:[ #(6 5 4 3 2 1) sort ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   130
     MessageTally spyOn:[100 timesRepeat:[#(6 5 4 3 2 1) sort] ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   131
     MessageTally spyOn:[1000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   132
     MessageTally spyOn:[10000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   133
     MessageTally spyOn:[100000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   134
     MessageTally spyOn:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   135
     MessageTally spyOn:[SystemBrowser open ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   136
     MessageTally spyDetailedOn:[SystemBrowser open ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   137
     Time millisecondsToRun:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   138
    "
88
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   139
! !
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   140
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   141
!MessageTally methodsFor:'accessing'!
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   142
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   143
nTally 
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   144
    ^ ntally 
0
470788421600 Initial revision
claus
parents:
diff changeset
   145
!
470788421600 Initial revision
claus
parents:
diff changeset
   146
88
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   147
tree
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   148
    ^ tree
0
470788421600 Initial revision
claus
parents:
diff changeset
   149
! !
470788421600 Initial revision
claus
parents:
diff changeset
   150
470788421600 Initial revision
claus
parents:
diff changeset
   151
!MessageTally methodsFor:'private'!
470788421600 Initial revision
claus
parents:
diff changeset
   152
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   153
execute
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   154
    theBlock value
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   155
! !
0
470788421600 Initial revision
claus
parents:
diff changeset
   156
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   157
!MessageTally methodsFor:'probes'!
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   158
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   159
count:aContext
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   160
    |con chain info atEnd sender home|
0
470788421600 Initial revision
claus
parents:
diff changeset
   161
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   162
    con := aContext.
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   163
    con isNil ifTrue:[^ self].
0
470788421600 Initial revision
claus
parents:
diff changeset
   164
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   165
    ntally := ntally + 1.
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   166
    "walk up above the interrupt context"
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   167
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   168
    [con receiver == Processor] whileTrue:[
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   169
	con := con sender
0
470788421600 Initial revision
claus
parents:
diff changeset
   170
    ].
470788421600 Initial revision
claus
parents:
diff changeset
   171
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   172
    "got it - collect info from contexts"
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   173
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   174
    "walk up"
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   175
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   176
    con isNil ifTrue:[^ self].
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   177
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   178
    atEnd := false.
0
470788421600 Initial revision
claus
parents:
diff changeset
   179
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   180
    [atEnd] whileFalse:[
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   181
	con isNil ifTrue:[
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   182
	    atEnd := true
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   183
	] ifFalse:[
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   184
	    sender := con sender.
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   185
	    sender isNil ifTrue:[
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   186
		atEnd := true
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   187
	    ] ifFalse:[
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   188
		((sender receiver == self) and:[sender selector == #execute]) ifTrue:[
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   189
		    atEnd := true
36
claus
parents: 24
diff changeset
   190
"/                ] ifFalse:[
claus
parents: 24
diff changeset
   191
"/                    (sender isMemberOf:BlockContext) ifTrue:[
claus
parents: 24
diff changeset
   192
"/                        sender sender selector == #execute ifTrue:[
claus
parents: 24
diff changeset
   193
"/                            atEnd := true
claus
parents: 24
diff changeset
   194
"/                        ]
claus
parents: 24
diff changeset
   195
"/                    ]
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   196
		]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   197
	    ]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   198
	].
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   199
	atEnd ifFalse:[
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   200
	    info := CallChain new.
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   201
	    (con isMemberOf:BlockContext) ifTrue:[
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   202
		home := con methodHome.
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   203
		home isNil ifTrue:[
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   204
		    info receiver:UndefinedObject
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   205
			 selector:'optimized'
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   206
			    class:UndefinedObject.
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   207
		] ifFalse:[
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   208
		    info receiver:home receiver class
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   209
			 selector:home selector
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   210
			    class:con methodClass.
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   211
		].
36
claus
parents: 24
diff changeset
   212
		info isBlock:true.
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   213
	    ] ifFalse:[
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   214
		info receiver:con receiver class
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   215
		     selector:con selector
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   216
			class:con methodClass.
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   217
	    ].
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   218
	    info rest:chain.
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   219
	    chain := info.
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   220
	    con := sender
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   221
	]
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   222
    ].
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   223
    "add chain to the tree"
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   224
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   225
    chain isNil ifTrue:[^ self].
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   226
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   227
    tree isNil ifTrue:[
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   228
	tree := ProfileTree new.
36
claus
parents: 24
diff changeset
   229
	tree receiver:MessageTally 
claus
parents: 24
diff changeset
   230
	     selector:#execute 
claus
parents: 24
diff changeset
   231
		class:MessageTally .
0
470788421600 Initial revision
claus
parents:
diff changeset
   232
    ].
470788421600 Initial revision
claus
parents:
diff changeset
   233
21
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   234
    tree addChain:chain
c521be54a8e6 *** empty log message ***
claus
parents: 17
diff changeset
   235
! !
0
470788421600 Initial revision
claus
parents:
diff changeset
   236
88
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   237
!MessageTally methodsFor:'setup'!
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   238
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   239
spyOn:aBlock interval:ms
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   240
    "spy on execution time"
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   241
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   242
    |startTime endTime running delay|
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   243
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   244
    theBlock := aBlock.
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   245
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   246
    Processor activeProcess withPriority:23 do:[
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   247
	process := [
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   248
			[
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   249
			    self execute
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   250
			] valueNowOrOnUnwindDo:[
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   251
			    running := false.
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   252
			    theBlock := nil.
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   253
			]
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   254
		   ] newProcess.
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   255
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   256
	Processor activeProcess withPriority:24 do:[
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   257
	    startTime := OperatingSystem getMillisecondTime.
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   258
	    delay := (Delay forMilliseconds:ms).
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   259
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   260
	    ntally := 0.
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   261
	    running := true.
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   262
	    process resume.
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   263
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   264
	    [running] whileTrue:[
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   265
		delay wait.
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   266
		self count:process suspendedContext
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   267
	    ].
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   268
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   269
	    endTime := OperatingSystem getMillisecondTime.
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   270
	].    
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   271
    ].    
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   272
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   273
    tree notNil ifTrue:[tree computePercentage:ntally].
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   274
    ^ endTime - startTime
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   275
! !
070ba8eb911e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 68
diff changeset
   276
98
123d948aacd1 version at the end
Claus Gittinger <cg@exept.de>
parents: 88
diff changeset
   277
!MessageTally class methodsFor:'documentation'!
123d948aacd1 version at the end
Claus Gittinger <cg@exept.de>
parents: 88
diff changeset
   278
123d948aacd1 version at the end
Claus Gittinger <cg@exept.de>
parents: 88
diff changeset
   279
version
236
7f570e0a0a75 documentation
Claus Gittinger <cg@exept.de>
parents: 120
diff changeset
   280
    ^ '$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.18 1996-04-25 17:11:32 cg Exp $'
98
123d948aacd1 version at the end
Claus Gittinger <cg@exept.de>
parents: 88
diff changeset
   281
! !