--- a/MessageTally.st Wed Feb 22 02:15:44 1995 +0100
+++ b/MessageTally.st Thu Mar 09 00:41:08 1995 +0100
@@ -1,6 +1,6 @@
"
- COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -10,40 +10,21 @@
hereby transferred.
"
+
+'From Smalltalk/X, Version:2.10.4 on 8-mar-1995 at 22:38:17'!
+
Object subclass:#MessageTally
- instanceVariableNames:'classes selectors counts ntally
- sumClasses sumSelectors sumCounts sumNtally'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Support'
+ instanceVariableNames:'process tree ntally theBlock spyInterval'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Profiler'
!
-MessageTally comment:'
-COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
-
-$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.7 1995-02-08 03:16:43 claus Exp $
-'!
-
!MessageTally class methodsFor:'documentation'!
-copyright
-"
- COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-!
-
version
"
-$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.7 1995-02-08 03:16:43 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.8 1995-03-08 23:41:04 claus Exp $
"
!
@@ -54,244 +35,243 @@
To get statistic, use 'MessageTally spyOn:aBlock'.
example:
- MessageTally spyOn:[
- (ByteArray uninitalizedNew:1000) sort
- ]
+ MessageTally spyOn:[
+ (ByteArray uninitalizedNew:1000) sort
+ ]
+
+ By default, probing is done every 10ms (i.e. the execution of the block is
+ interrupted every 10ms, and the context chain analyzed).
+ For better resolution, use smaller clock ticks (if your OperatingSystem
+ supports it). Try spyDetailedOn:aBlock, which tries to measure things
+ every 1ms. (Notice, that some OS's only provide a resolution of less than
+ that time interval)
+"
+!
+
+examples
"
+ MessageTally spyOn:[ #(6 5 4 3 2 1) sort ]
+ MessageTally spyOn:[100 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[1000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[10000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[100000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyDetailedOn:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ Time millisecondsToRun:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+
+ MessageTally spyOn:[SystemBrowser open ]
+ MessageTally spyDetailedOn:[SystemBrowser open ]
+"
+!
+
+copyright
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
! !
!MessageTally class methodsFor:'instance creation'!
-spyOn:aBlock
+spyOn:aBlock interval:ms
"evaluate aBlock and output time statistic on Transcript"
- |runTime aTally|
+ |runTime aTally nTally|
aTally := self new.
- runTime := aTally spyOn:aBlock.
- aTally statistics.
- Transcript cr.
- Transcript showCr:('total execution time: '
- , runTime printString , ' ms')
+ runTime := aTally spyOn:aBlock interval:ms.
+
+ aTally tree isNil ifTrue:[
+ Transcript cr.
+ Transcript showCr:'TALLY: No probes - execution time too short;'.
+ Transcript showCr:'TALLY: retry using: spyOn:[n timesRepeat:[...]]'.
+ ] ifFalse:[
+ "/ aTally tree inspect.
+ nTally := aTally nTally.
+ Transcript cr.
+ Transcript showCr:('total execution time: '
+ , runTime printString , ' ms '
+ , '(' , nTally printString , ' probes ;'
+ , ' error >= '
+ , (1000 // nTally / 10.0) printString
+ , '%)').
+ Transcript cr.
+ aTally tree printOn:Transcript.
+ Transcript cr.
+ Transcript cr.
- "MessageTally spyOn:[10000 timesRepeat:[#(6 5 4 3 2 1) sort] ]"
+ Transcript showCr:'leafs of calling tree:'.
+ Transcript cr.
+ aTally tree printLeafsOn:Transcript.
+ Transcript cr.
+
+ "
+ aTally statistics.
+ "
+ ].
+
+ "
+ MessageTally spyOn:[ #(6 5 4 3 2 1) sort ]
+ MessageTally spyOn:[100 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[1000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[10000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[100000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[SystemBrowser open ]
+ MessageTally spyDetailedOn:[SystemBrowser open ]
+ Time millisecondsToRun:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ "
!
-spyCountOn:aBlock
- "evaluate aBlock and output call statistic on Transcript"
+spyDetailedOn:aBlock
+ "evaluate aBlock and output time statistic on the Transcript.
+ Tick is 1ms."
- (self new spyCountOn:aBlock) statistics
+ ^ self spyOn:aBlock interval:1
+!
- "MessageTally spyCountOn:[#(6 5 4 3 2 1) sort ]"
+spyOn:aBlock
+ "evaluate aBlock and output time statistic on the Transcript.
+ Tick is 10ms."
+
+ ^ self spyOn:aBlock interval:10
! !
!MessageTally methodsFor:'private'!
-setupArrays
- classes := Array new:200.
- selectors := Array new:200.
- counts := Array new:200.
- sumClasses := Array new:200.
- sumSelectors := Array new:200.
- sumCounts := Array new:200.
- ntally := 0.
- sumNtally := 0
-!
+execute
+ theBlock value
+! !
-spyOn:aBlock
- "spy on execution time"
-
- |startTime endTime|
+!MessageTally methodsFor:'accessing'!
- self setupArrays.
- ObjectMemory spyInterruptHandler:self.
- startTime := Time millisecondClockValue.
- OperatingSystem startSpyTimer.
- aBlock value.
- OperatingSystem stopSpyTimer.
- endTime := Time millisecondClockValue.
- ObjectMemory spyInterruptHandler:nil.
- ^ endTime - startTime
+tree
+ ^ tree
!
-spyCountOn:aBlock
- "spy on method sends"
+nTally
+ ^ ntally
+! !
+
+!MessageTally methodsFor:'setup'!
+
+spyOn:aBlock interval:ms
+ "spy on execution time"
+
+ |startTime endTime running delay|
+
+ theBlock := aBlock.
- self setupArrays.
- ObjectMemory stepInterruptHandler:nil.
- ObjectMemory flushInlineCaches.
- StepInterruptPending := 1.
- InterruptPending := 1.
- aBlock value.
- StepInterruptPending := nil.
- ObjectMemory stepInterruptHandler:nil.
-!
+ Processor activeProcess withPriority:23 do:[
+ process := [
+ [
+ self execute
+ ] valueNowOrOnUnwindDo:[
+ running := false.
+ theBlock := nil.
+ ]
+ ] newProcess.
-stepInterrupt
- "called for every send;
- increment counts and retrigger stepInterrupt"
-
- self count.
- ObjectMemory flushInlineCaches.
- StepInterruptPending := 1.
- InterruptPending := 1
-!
+ Processor activeProcess withPriority:24 do:[
+ startTime := OperatingSystem getMillisecondTime.
+ delay := (Delay forMilliseconds:ms).
-spyInterrupt
- "called every 10ms by timer;
- increment counts and retrigger spyInterrupt"
+ ntally := 0.
+ running := true.
+ process resume.
- self count.
- OperatingSystem startSpyTimer
-!
+ [running] whileTrue:[
+ delay wait.
+ self count:process suspendedContext
+ ].
-count
- "increment class/method counts"
+ endTime := OperatingSystem getMillisecondTime.
+ ].
+ ].
- |where index sel recClass done newColl|
+ tree notNil ifTrue:[tree computePercentage:ntally].
+ ^ endTime - startTime
+! !
+
+!MessageTally methodsFor:'probes'!
+
+count:aContext
+ |con chain info atEnd sender home|
- where := thisContext.
- "where is now my context"
- where := where sender.
- "where is now spy/step interrupt context"
- where := where sender.
- "where is now interrupted context"
+ con := aContext.
+ con isNil ifTrue:[^ self].
- "ignore block-contexts"
- (where isBlockContext) ifTrue:[
- where := nil. "currently needed"
- ^ self
+ ntally := ntally + 1.
+ "walk up above the interrupt context"
+
+ [con receiver == Processor] whileTrue:[
+ con := con sender
].
- sel := where selector.
- recClass := where searchClass whichClassImplements:sel "receiver class".
+ "got it - collect info from contexts"
+
+ "walk up"
+
+ con isNil ifTrue:[^ self].
+
+ atEnd := false.
- index := 0.
- done := false.
- [done] whileFalse:[
- index := selectors identityIndexOf:sel startingAt:(index + 1).
- (index == 0) ifTrue:[
- ntally := ntally + 1.
- (ntally > counts size) ifTrue:[
- newColl := Array new:(ntally * 2).
- newColl replaceFrom:1 with:counts.
- counts := newColl.
- newColl := Array new:(ntally * 2).
- newColl replaceFrom:1 with:selectors.
- selectors := newColl.
- newColl := Array new:(ntally * 2).
- newColl replaceFrom:1 with:classes.
- classes := newColl.
- ].
- selectors at:ntally put:sel.
- classes at:ntally put:recClass.
- counts at:ntally put:1.
- done := true
- ] ifFalse:[
- ((classes at:index) == recClass) ifTrue:[
- counts at:index put:((counts at:index) + 1).
- done := true
- ]
- ]
+ [atEnd] whileFalse:[
+ con isNil ifTrue:[
+ atEnd := true
+ ] ifFalse:[
+ sender := con sender.
+ sender isNil ifTrue:[
+ atEnd := true
+ ] ifFalse:[
+ ((sender receiver == self) and:[sender selector == #execute]) ifTrue:[
+ atEnd := true
+ ]
+ ]
+ ].
+ atEnd ifFalse:[
+ info := CallChain new.
+ (con isMemberOf:BlockContext) ifTrue:[
+ home := con methodHome.
+ home isNil ifTrue:[
+ info receiver:UndefinedObject
+ selector:'optimized'
+ class:UndefinedObject.
+ ] ifFalse:[
+ info receiver:home receiver class
+ selector:home selector
+ class:con methodClass.
+ ].
+ info isBlock:true
+ ] ifFalse:[
+ info receiver:con receiver class
+ selector:con selector
+ class:con methodClass.
+ ].
+ info rest:chain.
+ chain := info.
+ con := sender
+ ]
+ ].
+ "add chain to the tree"
+
+ chain isNil ifTrue:[^ self].
+
+ tree isNil ifTrue:[
+ tree := ProfileTree new.
+ tree receiver:chain receiver
+ selector:chain selector
+ class:chain methodClass.
].
- "count in accumulated table"
- [where notNil] whileTrue:[
- sel := where selector.
- (sel == #spyOn:) ifTrue:[
- where := nil
- ] ifFalse:[
- recClass := where searchClass whichClassImplements:sel "receiver class".
- recClass isNil ifTrue:[
- recClass := where searchClass
- ].
- index := 0.
- done := false.
- [done] whileFalse:[
- index := sumSelectors identityIndexOf:sel startingAt:(index + 1).
- (index == 0) ifTrue:[
- sumNtally := sumNtally + 1.
- (sumNtally > sumCounts size) ifTrue:[
- newColl := Array new:(sumNtally * 2).
- newColl replaceFrom:1 with:sumCounts.
- sumCounts := newColl.
-
- newColl := Array new:(sumNtally * 2).
- newColl replaceFrom:1 with:sumSelectors.
- sumSelectors := newColl.
-
- newColl := Array new:(sumNtally * 2).
- newColl replaceFrom:1 with:sumClasses.
- sumClasses := newColl.
- ].
- sumSelectors at:sumNtally put:sel.
- sumClasses at:sumNtally put:recClass.
- sumCounts at:sumNtally put:1.
- done := true
- ] ifFalse:[
- ((sumClasses at:index) == recClass) ifTrue:[
- sumCounts at:index put:((sumCounts at:index) + 1).
- done := true
- ]
- ]
- ].
- where := where sender
- ]
- ]
-!
-
-statistics
- "print statistics with percentages"
-
- |nprobe sumNprobe nthis percent|
+ tree addChain:chain
+! !
- nprobe := 0.
- 1 to:ntally do:[:index |
- nprobe := nprobe + (counts at:index)
- ].
- sumNprobe := 0.
- 1 to:sumNtally do:[:index |
- sumNprobe := sumNprobe + (sumCounts at:index)
- ].
- Transcript cr.
- Transcript show:'total probes: '.
- Transcript show:nprobe printString.
- Transcript show:' ('.
- Transcript show:sumNprobe printString.
- Transcript show:')'.
- Transcript cr.
- Transcript cr.
- Transcript show:' ntally'.
- Transcript tab show:'percentage'.
- Transcript tab show:' class'.
- Transcript tab showCr:' selector'.
- Transcript showCr:'------------------ leafs ---------------------------'.
- 1 to:ntally do:[:index |
- nthis := counts at:index.
- percent := nthis * 100 // nprobe.
- Transcript show:(nthis printStringLeftPaddedTo:6).
- Transcript tab. Transcript show:' '.
- Transcript show:((percent printStringLeftPaddedTo:3) , '%').
- Transcript tab.
- Transcript show:((classes at:index) name printStringLeftPaddedTo:20).
- Transcript tab. Transcript show:' '.
- Transcript showCr:((selectors at:index) printString)
- ].
-
- Transcript showCr:'---------------- accumulated -----------------------'.
- 1 to:sumNtally do:[:index |
- nthis := sumCounts at:index.
- percent := nthis * 100 // sumNprobe.
- Transcript show:(nthis printStringLeftPaddedTo:6).
- Transcript tab. Transcript show:' '.
- Transcript show:((percent printStringLeftPaddedTo:3) , '%').
- Transcript tab.
- (sumClasses at:index) isNil ifTrue:[
- Transcript show:('??' printStringLeftPaddedTo:20)
- ] ifFalse:[
- Transcript show:((sumClasses at:index) name printStringLeftPaddedTo:20).
- ].
- Transcript tab. Transcript show:' '.
- Transcript showCr:((sumSelectors at:index) printString)
- ]
-! !
--- a/MessageTracer.st Wed Feb 22 02:15:44 1995 +0100
+++ b/MessageTracer.st Thu Mar 09 00:41:08 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.9 1995-02-16 03:02:15 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.10 1995-03-08 23:41:08 claus Exp $
'!
!MessageTracer class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.9 1995-02-16 03:02:15 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.10 1995-03-08 23:41:08 claus Exp $
"
!
@@ -161,9 +161,9 @@
initialize
BreakpointSignal isNil ifTrue:[
- Object initialize.
+ HaltSignal isNil ifTrue:[super initialize].
- BreakpointSignal := Object haltSignal newSignalMayProceed:true.
+ BreakpointSignal := HaltSignal newSignalMayProceed:true.
BreakpointSignal nameClass:self message:#breakpointSignal.
BreakpointSignal notifierString:'breakpoint encountered'.
]
--- a/MsgTally.st Wed Feb 22 02:15:44 1995 +0100
+++ b/MsgTally.st Thu Mar 09 00:41:08 1995 +0100
@@ -1,6 +1,6 @@
"
- COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -10,40 +10,21 @@
hereby transferred.
"
+
+'From Smalltalk/X, Version:2.10.4 on 8-mar-1995 at 22:38:17'!
+
Object subclass:#MessageTally
- instanceVariableNames:'classes selectors counts ntally
- sumClasses sumSelectors sumCounts sumNtally'
- classVariableNames:''
- poolDictionaries:''
- category:'System-Support'
+ instanceVariableNames:'process tree ntally theBlock spyInterval'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Profiler'
!
-MessageTally comment:'
-COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
-
-$Header: /cvs/stx/stx/libbasic3/Attic/MsgTally.st,v 1.7 1995-02-08 03:16:43 claus Exp $
-'!
-
!MessageTally class methodsFor:'documentation'!
-copyright
-"
- COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-!
-
version
"
-$Header: /cvs/stx/stx/libbasic3/Attic/MsgTally.st,v 1.7 1995-02-08 03:16:43 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/Attic/MsgTally.st,v 1.8 1995-03-08 23:41:04 claus Exp $
"
!
@@ -54,244 +35,243 @@
To get statistic, use 'MessageTally spyOn:aBlock'.
example:
- MessageTally spyOn:[
- (ByteArray uninitalizedNew:1000) sort
- ]
+ MessageTally spyOn:[
+ (ByteArray uninitalizedNew:1000) sort
+ ]
+
+ By default, probing is done every 10ms (i.e. the execution of the block is
+ interrupted every 10ms, and the context chain analyzed).
+ For better resolution, use smaller clock ticks (if your OperatingSystem
+ supports it). Try spyDetailedOn:aBlock, which tries to measure things
+ every 1ms. (Notice, that some OS's only provide a resolution of less than
+ that time interval)
+"
+!
+
+examples
"
+ MessageTally spyOn:[ #(6 5 4 3 2 1) sort ]
+ MessageTally spyOn:[100 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[1000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[10000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[100000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyDetailedOn:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ Time millisecondsToRun:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+
+ MessageTally spyOn:[SystemBrowser open ]
+ MessageTally spyDetailedOn:[SystemBrowser open ]
+"
+!
+
+copyright
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
! !
!MessageTally class methodsFor:'instance creation'!
-spyOn:aBlock
+spyOn:aBlock interval:ms
"evaluate aBlock and output time statistic on Transcript"
- |runTime aTally|
+ |runTime aTally nTally|
aTally := self new.
- runTime := aTally spyOn:aBlock.
- aTally statistics.
- Transcript cr.
- Transcript showCr:('total execution time: '
- , runTime printString , ' ms')
+ runTime := aTally spyOn:aBlock interval:ms.
+
+ aTally tree isNil ifTrue:[
+ Transcript cr.
+ Transcript showCr:'TALLY: No probes - execution time too short;'.
+ Transcript showCr:'TALLY: retry using: spyOn:[n timesRepeat:[...]]'.
+ ] ifFalse:[
+ "/ aTally tree inspect.
+ nTally := aTally nTally.
+ Transcript cr.
+ Transcript showCr:('total execution time: '
+ , runTime printString , ' ms '
+ , '(' , nTally printString , ' probes ;'
+ , ' error >= '
+ , (1000 // nTally / 10.0) printString
+ , '%)').
+ Transcript cr.
+ aTally tree printOn:Transcript.
+ Transcript cr.
+ Transcript cr.
- "MessageTally spyOn:[10000 timesRepeat:[#(6 5 4 3 2 1) sort] ]"
+ Transcript showCr:'leafs of calling tree:'.
+ Transcript cr.
+ aTally tree printLeafsOn:Transcript.
+ Transcript cr.
+
+ "
+ aTally statistics.
+ "
+ ].
+
+ "
+ MessageTally spyOn:[ #(6 5 4 3 2 1) sort ]
+ MessageTally spyOn:[100 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[1000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[10000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[100000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ MessageTally spyOn:[SystemBrowser open ]
+ MessageTally spyDetailedOn:[SystemBrowser open ]
+ Time millisecondsToRun:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]
+ "
!
-spyCountOn:aBlock
- "evaluate aBlock and output call statistic on Transcript"
+spyDetailedOn:aBlock
+ "evaluate aBlock and output time statistic on the Transcript.
+ Tick is 1ms."
- (self new spyCountOn:aBlock) statistics
+ ^ self spyOn:aBlock interval:1
+!
- "MessageTally spyCountOn:[#(6 5 4 3 2 1) sort ]"
+spyOn:aBlock
+ "evaluate aBlock and output time statistic on the Transcript.
+ Tick is 10ms."
+
+ ^ self spyOn:aBlock interval:10
! !
!MessageTally methodsFor:'private'!
-setupArrays
- classes := Array new:200.
- selectors := Array new:200.
- counts := Array new:200.
- sumClasses := Array new:200.
- sumSelectors := Array new:200.
- sumCounts := Array new:200.
- ntally := 0.
- sumNtally := 0
-!
+execute
+ theBlock value
+! !
-spyOn:aBlock
- "spy on execution time"
-
- |startTime endTime|
+!MessageTally methodsFor:'accessing'!
- self setupArrays.
- ObjectMemory spyInterruptHandler:self.
- startTime := Time millisecondClockValue.
- OperatingSystem startSpyTimer.
- aBlock value.
- OperatingSystem stopSpyTimer.
- endTime := Time millisecondClockValue.
- ObjectMemory spyInterruptHandler:nil.
- ^ endTime - startTime
+tree
+ ^ tree
!
-spyCountOn:aBlock
- "spy on method sends"
+nTally
+ ^ ntally
+! !
+
+!MessageTally methodsFor:'setup'!
+
+spyOn:aBlock interval:ms
+ "spy on execution time"
+
+ |startTime endTime running delay|
+
+ theBlock := aBlock.
- self setupArrays.
- ObjectMemory stepInterruptHandler:nil.
- ObjectMemory flushInlineCaches.
- StepInterruptPending := 1.
- InterruptPending := 1.
- aBlock value.
- StepInterruptPending := nil.
- ObjectMemory stepInterruptHandler:nil.
-!
+ Processor activeProcess withPriority:23 do:[
+ process := [
+ [
+ self execute
+ ] valueNowOrOnUnwindDo:[
+ running := false.
+ theBlock := nil.
+ ]
+ ] newProcess.
-stepInterrupt
- "called for every send;
- increment counts and retrigger stepInterrupt"
-
- self count.
- ObjectMemory flushInlineCaches.
- StepInterruptPending := 1.
- InterruptPending := 1
-!
+ Processor activeProcess withPriority:24 do:[
+ startTime := OperatingSystem getMillisecondTime.
+ delay := (Delay forMilliseconds:ms).
-spyInterrupt
- "called every 10ms by timer;
- increment counts and retrigger spyInterrupt"
+ ntally := 0.
+ running := true.
+ process resume.
- self count.
- OperatingSystem startSpyTimer
-!
+ [running] whileTrue:[
+ delay wait.
+ self count:process suspendedContext
+ ].
-count
- "increment class/method counts"
+ endTime := OperatingSystem getMillisecondTime.
+ ].
+ ].
- |where index sel recClass done newColl|
+ tree notNil ifTrue:[tree computePercentage:ntally].
+ ^ endTime - startTime
+! !
+
+!MessageTally methodsFor:'probes'!
+
+count:aContext
+ |con chain info atEnd sender home|
- where := thisContext.
- "where is now my context"
- where := where sender.
- "where is now spy/step interrupt context"
- where := where sender.
- "where is now interrupted context"
+ con := aContext.
+ con isNil ifTrue:[^ self].
- "ignore block-contexts"
- (where isBlockContext) ifTrue:[
- where := nil. "currently needed"
- ^ self
+ ntally := ntally + 1.
+ "walk up above the interrupt context"
+
+ [con receiver == Processor] whileTrue:[
+ con := con sender
].
- sel := where selector.
- recClass := where searchClass whichClassImplements:sel "receiver class".
+ "got it - collect info from contexts"
+
+ "walk up"
+
+ con isNil ifTrue:[^ self].
+
+ atEnd := false.
- index := 0.
- done := false.
- [done] whileFalse:[
- index := selectors identityIndexOf:sel startingAt:(index + 1).
- (index == 0) ifTrue:[
- ntally := ntally + 1.
- (ntally > counts size) ifTrue:[
- newColl := Array new:(ntally * 2).
- newColl replaceFrom:1 with:counts.
- counts := newColl.
- newColl := Array new:(ntally * 2).
- newColl replaceFrom:1 with:selectors.
- selectors := newColl.
- newColl := Array new:(ntally * 2).
- newColl replaceFrom:1 with:classes.
- classes := newColl.
- ].
- selectors at:ntally put:sel.
- classes at:ntally put:recClass.
- counts at:ntally put:1.
- done := true
- ] ifFalse:[
- ((classes at:index) == recClass) ifTrue:[
- counts at:index put:((counts at:index) + 1).
- done := true
- ]
- ]
+ [atEnd] whileFalse:[
+ con isNil ifTrue:[
+ atEnd := true
+ ] ifFalse:[
+ sender := con sender.
+ sender isNil ifTrue:[
+ atEnd := true
+ ] ifFalse:[
+ ((sender receiver == self) and:[sender selector == #execute]) ifTrue:[
+ atEnd := true
+ ]
+ ]
+ ].
+ atEnd ifFalse:[
+ info := CallChain new.
+ (con isMemberOf:BlockContext) ifTrue:[
+ home := con methodHome.
+ home isNil ifTrue:[
+ info receiver:UndefinedObject
+ selector:'optimized'
+ class:UndefinedObject.
+ ] ifFalse:[
+ info receiver:home receiver class
+ selector:home selector
+ class:con methodClass.
+ ].
+ info isBlock:true
+ ] ifFalse:[
+ info receiver:con receiver class
+ selector:con selector
+ class:con methodClass.
+ ].
+ info rest:chain.
+ chain := info.
+ con := sender
+ ]
+ ].
+ "add chain to the tree"
+
+ chain isNil ifTrue:[^ self].
+
+ tree isNil ifTrue:[
+ tree := ProfileTree new.
+ tree receiver:chain receiver
+ selector:chain selector
+ class:chain methodClass.
].
- "count in accumulated table"
- [where notNil] whileTrue:[
- sel := where selector.
- (sel == #spyOn:) ifTrue:[
- where := nil
- ] ifFalse:[
- recClass := where searchClass whichClassImplements:sel "receiver class".
- recClass isNil ifTrue:[
- recClass := where searchClass
- ].
- index := 0.
- done := false.
- [done] whileFalse:[
- index := sumSelectors identityIndexOf:sel startingAt:(index + 1).
- (index == 0) ifTrue:[
- sumNtally := sumNtally + 1.
- (sumNtally > sumCounts size) ifTrue:[
- newColl := Array new:(sumNtally * 2).
- newColl replaceFrom:1 with:sumCounts.
- sumCounts := newColl.
-
- newColl := Array new:(sumNtally * 2).
- newColl replaceFrom:1 with:sumSelectors.
- sumSelectors := newColl.
-
- newColl := Array new:(sumNtally * 2).
- newColl replaceFrom:1 with:sumClasses.
- sumClasses := newColl.
- ].
- sumSelectors at:sumNtally put:sel.
- sumClasses at:sumNtally put:recClass.
- sumCounts at:sumNtally put:1.
- done := true
- ] ifFalse:[
- ((sumClasses at:index) == recClass) ifTrue:[
- sumCounts at:index put:((sumCounts at:index) + 1).
- done := true
- ]
- ]
- ].
- where := where sender
- ]
- ]
-!
-
-statistics
- "print statistics with percentages"
-
- |nprobe sumNprobe nthis percent|
+ tree addChain:chain
+! !
- nprobe := 0.
- 1 to:ntally do:[:index |
- nprobe := nprobe + (counts at:index)
- ].
- sumNprobe := 0.
- 1 to:sumNtally do:[:index |
- sumNprobe := sumNprobe + (sumCounts at:index)
- ].
- Transcript cr.
- Transcript show:'total probes: '.
- Transcript show:nprobe printString.
- Transcript show:' ('.
- Transcript show:sumNprobe printString.
- Transcript show:')'.
- Transcript cr.
- Transcript cr.
- Transcript show:' ntally'.
- Transcript tab show:'percentage'.
- Transcript tab show:' class'.
- Transcript tab showCr:' selector'.
- Transcript showCr:'------------------ leafs ---------------------------'.
- 1 to:ntally do:[:index |
- nthis := counts at:index.
- percent := nthis * 100 // nprobe.
- Transcript show:(nthis printStringLeftPaddedTo:6).
- Transcript tab. Transcript show:' '.
- Transcript show:((percent printStringLeftPaddedTo:3) , '%').
- Transcript tab.
- Transcript show:((classes at:index) name printStringLeftPaddedTo:20).
- Transcript tab. Transcript show:' '.
- Transcript showCr:((selectors at:index) printString)
- ].
-
- Transcript showCr:'---------------- accumulated -----------------------'.
- 1 to:sumNtally do:[:index |
- nthis := sumCounts at:index.
- percent := nthis * 100 // sumNprobe.
- Transcript show:(nthis printStringLeftPaddedTo:6).
- Transcript tab. Transcript show:' '.
- Transcript show:((percent printStringLeftPaddedTo:3) , '%').
- Transcript tab.
- (sumClasses at:index) isNil ifTrue:[
- Transcript show:('??' printStringLeftPaddedTo:20)
- ] ifFalse:[
- Transcript show:((sumClasses at:index) name printStringLeftPaddedTo:20).
- ].
- Transcript tab. Transcript show:' '.
- Transcript showCr:((sumSelectors at:index) printString)
- ]
-! !
--- a/MsgTracer.st Wed Feb 22 02:15:44 1995 +0100
+++ b/MsgTracer.st Thu Mar 09 00:41:08 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic3/Attic/MsgTracer.st,v 1.9 1995-02-16 03:02:15 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/Attic/MsgTracer.st,v 1.10 1995-03-08 23:41:08 claus Exp $
'!
!MessageTracer class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic3/Attic/MsgTracer.st,v 1.9 1995-02-16 03:02:15 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/Attic/MsgTracer.st,v 1.10 1995-03-08 23:41:08 claus Exp $
"
!
@@ -161,9 +161,9 @@
initialize
BreakpointSignal isNil ifTrue:[
- Object initialize.
+ HaltSignal isNil ifTrue:[super initialize].
- BreakpointSignal := Object haltSignal newSignalMayProceed:true.
+ BreakpointSignal := HaltSignal newSignalMayProceed:true.
BreakpointSignal nameClass:self message:#breakpointSignal.
BreakpointSignal notifierString:'breakpoint encountered'.
]