--- a/MessageTally.st Tue Jun 15 14:54:58 2010 +0200
+++ b/MessageTally.st Sun Jul 04 10:06:24 2010 +0200
@@ -434,83 +434,22 @@
"{ Pragma: +optSpeed }"
- |con chain info atEnd sender home
- recClass selector mthdClass isBlock|
+ |chain|
- con := aContext.
- con isNil ifTrue:[^ self].
+ chain := CallChain
+ callChainTo:aContext
+ stopAtCallerForWhich:[:con |
+ (con receiver == self) and:[con selector == #execute]
+ ].
- [con receiver == Processor] whileTrue:[
- con := con sender
+ "add chain to the tree"
+
+ chain notNil ifTrue:[
+ ntally := ntally + 1.
+ tree addChain:chain
].
- "got it - collect info from contexts"
-
- "walk up"
-
- con isNil ifTrue:[^ self].
- ((con receiver == self) and:[con selector == #execute]) ifTrue:[^ self].
-
- atEnd := false.
-
- [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
-"/ ] ifFalse:[
-"/ (sender isMemberOf:BlockContext) ifTrue:[
-"/ sender sender selector == #execute ifTrue:[
-"/ atEnd := true
-"/ ]
-"/ ]
- ]
- ]
- ].
- atEnd ifFalse:[
- info := CallChain basicNew.
- (con isMemberOf:BlockContext) ifTrue:[
- isBlock := true.
- home := con methodHome.
- home isNil ifTrue:[
- recClass := UndefinedObject.
- selector := 'optimized'.
- mthdClass := UndefinedObject.
- ] ifFalse:[
- recClass := home receiver class.
- selector := home selector.
- mthdClass := home methodClass.
- ].
- ] ifFalse:[
- isBlock := false.
- recClass := con receiver class.
- selector := con selector.
- mthdClass := con methodClass.
- ].
- info receiver:recClass
- selector:selector
- class:mthdClass
- isBlock:isBlock.
- info rest:chain.
- chain := info.
- con := sender
- ]
- ].
- "add chain to the tree"
-
- chain isNil ifTrue:[^ self].
-
- ntally := ntally + 1.
- "walk up above the interrupt context"
-
- tree addChain:chain
-
- "Modified: 22.3.1997 / 19:11:59 / cg"
+ "Modified: / 04-07-2010 / 09:45:28 / cg"
!
countLeaf:aContext
@@ -519,7 +458,7 @@
"{ Pragma: +optSpeed }"
- |con entry recClass selector mthdClass isBlock sender home existingEntry|
+ |con entry recClass selector mthdClass sender home existingEntry|
con := aContext.
con isNil ifTrue:[^ self].
@@ -539,23 +478,15 @@
sender isNil ifTrue:[^ self].
((sender receiver == self) and:[sender selector == #execute]) ifTrue:[^ self].
- (con isMemberOf:BlockContext) ifTrue:[
- isBlock := true.
- home := con methodHome.
- home isNil ifTrue:[
- recClass := UndefinedObject.
- selector := 'optimized'.
- mthdClass := UndefinedObject.
- ] ifFalse:[
- recClass := home receiver class.
- selector := home selector.
- mthdClass := home methodClass.
- ].
+ home := con methodHome.
+ home isNil ifTrue:[
+ recClass := UndefinedObject.
+ selector := 'optimized'.
+ mthdClass := UndefinedObject.
] ifFalse:[
- isBlock := false.
- recClass := con receiver class.
- selector := con selector.
- mthdClass := con methodClass.
+ recClass := home receiver class.
+ selector := home selector.
+ mthdClass := home methodClass.
].
"add info to the probes collection"
@@ -567,7 +498,7 @@
receiver:recClass
selector:selector
class:mthdClass
- isBlock:isBlock.
+ isBlock:(con isBlockContext).
existingEntry := probes elementAt:entry ifAbsent:nil.
existingEntry isNil ifTrue:[
@@ -576,7 +507,7 @@
existingEntry incrementLeafTally.
].
- "Modified: 22.3.1997 / 19:09:03 / cg"
+ "Modified: / 04-07-2010 / 09:47:06 / cg"
! !
!MessageTally methodsFor:'spy setup'!
@@ -688,9 +619,9 @@
!MessageTally class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.45 2010-02-02 14:18:57 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.46 2010-07-04 08:06:24 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.45 2010-02-02 14:18:57 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.46 2010-07-04 08:06:24 cg Exp $'
! !