--- a/CallChain.st Sat May 18 18:51:30 1996 +0200
+++ b/CallChain.st Sat May 18 19:05:49 1996 +0200
@@ -37,6 +37,8 @@
"
This is is used as a companion to MessageTally.
Instances of it are used to represent a calling chain.
+ They are simply holders for some of the contexts values - no
+ intelligence here.
(MessageTally could have used the contexts themself, but these
may create more overhead)
@@ -44,7 +46,7 @@
Claus Gittinger
[see also:]
- MessageTally
+ MessageTally ProfileTree
MessageTracer
AbstractTime
"
@@ -52,51 +54,93 @@
!CallChain methodsFor:'accessing'!
-isBlock
+isBlock
+ "return true, if this is a callChain for a block-context"
+
^ isBlock
-!
-isBlock:aBoolean
- isBlock := aBoolean.
+ "Modified: 18.5.1996 / 18:52:05 / cg"
!
methodClass
+ "return the contexts methods class"
+
^ class
+
+ "Modified: 18.5.1996 / 18:54:04 / cg"
!
receiver
+ "return the contexts receiver"
+
^ receiver
+
+ "Modified: 18.5.1996 / 18:54:12 / cg"
!
receiver:r selector:s class:cls
+ "private tally interface - set receiver, selector and class.
+ the block flag is cleared."
+
receiver := r.
selector := s.
class := cls.
isBlock := false.
+
+ "Modified: 18.5.1996 / 18:54:42 / cg"
+!
+
+receiver:r selector:s class:cls isBlock:blk
+ "private tally interface - set receiver, selector, class
+ and the block flag."
+
+ receiver := r.
+ selector := s.
+ class := cls.
+ isBlock := blk.
+
+ "Created: 18.5.1996 / 18:52:34 / cg"
+ "Modified: 18.5.1996 / 18:54:58 / cg"
!
rest
+ "return the chains link"
+
^ rest
+
+ "Modified: 18.5.1996 / 18:55:24 / cg"
!
rest:r
+ "set the chains link"
+
rest := r.
+
+ "Modified: 18.5.1996 / 18:55:19 / cg"
!
selector
+ "return the contexts selector"
+
^ selector
+
+ "Modified: 18.5.1996 / 18:55:11 / cg"
! !
!CallChain methodsFor:'comparing'!
= someInfo
+ "return true, if the argument chain is for the same method invocation"
+
receiver == someInfo receiver ifFalse:[^ false].
selector == someInfo selector ifFalse:[^ false].
^ class == someInfo methodClass
+
+ "Modified: 18.5.1996 / 18:55:47 / cg"
! !
!CallChain class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/CallChain.st,v 1.11 1996-04-25 17:11:22 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/CallChain.st,v 1.12 1996-05-18 17:05:34 cg Exp $'
! !
--- a/MessageTally.st Sat May 18 18:51:30 1996 +0200
+++ b/MessageTally.st Sat May 18 19:05:49 1996 +0200
@@ -55,7 +55,8 @@
Claus Gittinger
[see also:]
- CallChain
+ CallChain ProfileTree
+ MessageTracer
"
!
@@ -262,13 +263,14 @@
home isNil ifTrue:[
info receiver:UndefinedObject
selector:'optimized'
- class:UndefinedObject.
+ class:UndefinedObject
+ isBlock:true.
] ifFalse:[
info receiver:home receiver class
selector:home selector
- class:con methodClass.
+ class:con methodClass
+ isBlock:true.
].
- info isBlock:true.
] ifFalse:[
info receiver:con receiver class
selector:con selector
@@ -292,7 +294,7 @@
tree addChain:chain
- "Modified: 18.5.1996 / 18:48:45 / cg"
+ "Modified: 18.5.1996 / 18:53:31 / cg"
! !
!MessageTally methodsFor:'setup'!
@@ -336,5 +338,6 @@
!MessageTally class methodsFor:'documentation'!
-les/CVS/stx/libbasic3/MsgTally.st,v 1.21 1996/05/18 16:35:03 cg Exp $'
+version
+ ^ '$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.23 1996-05-18 17:05:41 cg Exp $'
! !
--- a/MsgTally.st Sat May 18 18:51:30 1996 +0200
+++ b/MsgTally.st Sat May 18 19:05:49 1996 +0200
@@ -55,7 +55,8 @@
Claus Gittinger
[see also:]
- CallChain
+ CallChain ProfileTree
+ MessageTracer
"
!
@@ -262,13 +263,14 @@
home isNil ifTrue:[
info receiver:UndefinedObject
selector:'optimized'
- class:UndefinedObject.
+ class:UndefinedObject
+ isBlock:true.
] ifFalse:[
info receiver:home receiver class
selector:home selector
- class:con methodClass.
+ class:con methodClass
+ isBlock:true.
].
- info isBlock:true.
] ifFalse:[
info receiver:con receiver class
selector:con selector
@@ -292,7 +294,7 @@
tree addChain:chain
- "Modified: 18.5.1996 / 18:48:45 / cg"
+ "Modified: 18.5.1996 / 18:53:31 / cg"
! !
!MessageTally methodsFor:'setup'!
@@ -336,5 +338,6 @@
!MessageTally class methodsFor:'documentation'!
-les/CVS/stx/libbasic3/MsgTally.st,v 1.21 1996/05/18 16:35:03 cg Exp $'
+version
+ ^ '$Header: /cvs/stx/stx/libbasic3/Attic/MsgTally.st,v 1.23 1996-05-18 17:05:41 cg Exp $'
! !
--- a/ProfileTree.st Sat May 18 18:51:30 1996 +0200
+++ b/ProfileTree.st Sat May 18 19:05:49 1996 +0200
@@ -36,153 +36,235 @@
documentation
"
This is is used as a companion to MessageTally.
- Instances of it are used to represent the calling tree.
+ Instances of it are used to represent a calling chain.
+ (MessageTally could have used the contexts themself, but these
+ may create more overhead)
[author:]
Claus Gittinger
+
+ [see also:]
+ MessageTally CallChain
+ MessageTracer
+ AbstractTime
"
! !
!ProfileTree methodsFor:'accessing'!
called
+ "return the trees of the called methods/blocks"
+
^ called
+
+ "Modified: 18.5.1996 / 19:00:59 / cg"
!
called:aCollection
+ "set the trees of the called methods/blocks"
+
called := aCollection
+
+ "Modified: 18.5.1996 / 19:01:08 / cg"
!
isBlock
- ^ isBlock
-!
+ "return true, if this is a tree for a block-context"
-isBlock:aBoolean
- isBlock := aBoolean
+ ^ isBlock
+
+ "Modified: 18.5.1996 / 18:59:12 / cg"
!
leafTally
+ "return true, if this is a leaf"
+
^ leafTally
+
+ "Modified: 18.5.1996 / 19:01:27 / cg"
!
methodClass
- ^ class
+ "return the contexts methods class"
+
+ ^ class
+
+ "Modified: 18.5.1996 / 19:01:40 / cg"
!
receiver
+ "return the contexts receiver"
+
^ receiver
+
+ "Modified: 18.5.1996 / 19:01:45 / cg"
!
receiver:r selector:s class:cls
+ "private tally interface - set receiver, selector and class.
+ the block flag is cleared."
+
receiver := r.
selector := s.
class := cls
+
+ "Modified: 18.5.1996 / 19:01:52 / cg"
+!
+
+receiver:r selector:s class:cls isBlock:blk
+ "private tally interface - set receiver, selector, class
+ and the block flag."
+
+ receiver := r.
+ selector := s.
+ class := cls.
+ isBlock := blk
+
+ "Modified: 18.5.1996 / 19:01:57 / cg"
!
selector
+ "return the contexts selector"
+
^ selector
+
+ "Modified: 18.5.1996 / 19:02:04 / cg"
!
totalTally
+ "return the total tally counter"
+
^ totalTally
+
+ "Modified: 18.5.1996 / 19:02:15 / cg"
! !
!ProfileTree methodsFor:'adding info'!
addChain:aCallChain
+ "merge a chain into the receviers tree"
+
|node found subTree chain called|
node := self.
chain := aCallChain.
[chain notNil] whileTrue:[
- node incrementTotalTally.
+ node incrementTotalTally.
- found := false.
- (called := node called) notNil ifTrue:[
- called do:[:subTree |
- found ifFalse:[
- (chain = subTree) ifTrue:[
- node := subTree.
- chain := chain rest.
- found := true
- ].
- ].
- ].
- ] ifFalse:[
- node called:(OrderedCollection new)
- ].
- found ifFalse:[
- subTree := ProfileTree new.
- subTree receiver:chain receiver
- selector:chain selector
- class:chain methodClass.
- subTree isBlock:(chain isBlock).
+ found := false.
+ (called := node called) notNil ifTrue:[
+ called do:[:subTree |
+ found ifFalse:[
+ (chain = subTree) ifTrue:[
+ node := subTree.
+ chain := chain rest.
+ found := true
+ ].
+ ].
+ ].
+ ] ifFalse:[
+ node called:(OrderedCollection new)
+ ].
+ found ifFalse:[
+ subTree := ProfileTree new.
+ subTree receiver:chain receiver
+ selector:chain selector
+ class:chain methodClass
+ isBlock:chain isBlock.
- node called add:subTree.
- node := subTree.
- chain := chain rest
- ]
+ node called add:subTree.
+ node := subTree.
+ chain := chain rest
+ ]
].
node incrementTotalTally.
node incrementLeafTally.
+
+ "Modified: 18.5.1996 / 19:02:28 / cg"
!
computePercentage:total
+ "compute percentages"
+
totalTally := (totalTally / total * 1000) rounded / 10.0.
leafTally notNil ifTrue:[
- leafTally := (leafTally / total * 1000) rounded / 10.0
+ leafTally := (leafTally / total * 1000) rounded / 10.0
].
called notNil ifTrue:[
- called do:[:subTree |
- subTree computePercentage:total
- ]
+ called do:[:subTree |
+ subTree computePercentage:total
+ ]
].
+
+ "Modified: 18.5.1996 / 19:02:45 / cg"
!
incrementLeafTally
+ "count as leaf"
+
leafTally isNil ifTrue:[
- leafTally := 1
+ leafTally := 1
] ifFalse:[
- leafTally := leafTally + 1.
+ leafTally := leafTally + 1.
].
+
+ "Modified: 18.5.1996 / 19:02:59 / cg"
!
incrementTotalTally
+ "count"
+
totalTally isNil ifTrue:[
- totalTally := 1
+ totalTally := 1
] ifFalse:[
- totalTally := totalTally + 1.
+ totalTally := totalTally + 1.
].
+
+ "Modified: 18.5.1996 / 19:03:06 / cg"
!
leafTally:aCount
+ "set the leafTally count"
+
leafTally := aCount
+
+ "Modified: 18.5.1996 / 19:03:22 / cg"
!
totalTally:aCount
+ "set the totalTally count"
+
totalTally := aCount
+
+ "Modified: 18.5.1996 / 19:03:30 / cg"
! !
!ProfileTree methodsFor:'prettyPrinting'!
printLeafsOn:aStream
+ "print all leafNodes statistics on aStream"
+
|leafNodes|
leafNodes := OrderedCollection new.
self addLeafNodesTo:leafNodes.
leafNodes := leafNodes asSortedCollection:[:a :b |
- a leafTally < b leafTally].
+ a leafTally < b leafTally].
leafNodes do:[:aNode |
- aNode printSingleOn:aStream.
- aStream cr.
+ aNode printSingleOn:aStream.
+ aStream cr.
].
+
+ "Modified: 18.5.1996 / 19:04:03 / cg"
!
printOn:aStream
+ "print statistics on aStream"
+
|s|
"/ self printOn:aStream indent:0
@@ -190,81 +272,99 @@
self printOn:s indent:0.
aStream nextPutAll:s contents
+
+ "Modified: 18.5.1996 / 19:03:55 / cg"
!
printOn:aStream indent:i
+ "print statistics indented on aStream"
+
selector notNil ifTrue:[
- aStream spaces:i.
- self printSingleOn:aStream.
- aStream cr.
+ aStream spaces:i.
+ self printSingleOn:aStream.
+ aStream cr.
].
called notNil ifTrue:[
- called do:[:sub|
- sub printOn:aStream indent:(i + 1)
- ].
+ called do:[:sub|
+ sub printOn:aStream indent:(i + 1)
+ ].
].
+
+ "Modified: 18.5.1996 / 19:04:12 / cg"
!
printSingleOn:aStream
+ "print a single nodes statistic on aStream"
+
selector notNil ifTrue:[
- isBlock == true ifTrue:[
- '[] in ' printOn:aStream
- ].
- receiver name printOn:aStream.
- (class notNil and:[class ~~ receiver class]) ifTrue:[
- '>>' printOn:aStream.
- class name printOn:aStream
- ].
- aStream space.
- selector printOn:aStream.
- aStream space.
+ isBlock == true ifTrue:[
+ '[] in ' printOn:aStream
+ ].
+ receiver name printOn:aStream.
+ (class notNil and:[class ~~ receiver class]) ifTrue:[
+ '>>' printOn:aStream.
+ class name printOn:aStream
+ ].
+ aStream space.
+ selector printOn:aStream.
+ aStream space.
- aStream nextPutAll:'(total '.
- totalTally printOn:aStream.
- aStream nextPutAll:'%)'.
+ aStream nextPutAll:'(total '.
+ totalTally printOn:aStream.
+ aStream nextPutAll:'%)'.
- leafTally notNil ifTrue:[
- aStream nextPutAll:'(leaf '.
- leafTally printOn:aStream.
- aStream nextPutAll:'%)'.
- ].
+ leafTally notNil ifTrue:[
+ aStream nextPutAll:'(leaf '.
+ leafTally printOn:aStream.
+ aStream nextPutAll:'%)'.
+ ].
].
+
+ "Modified: 18.5.1996 / 19:04:28 / cg"
! !
!ProfileTree methodsFor:'private'!
= aProfileTreeNode
+ "return true, if the argument tree is for the same method invocation"
+
receiver ~= aProfileTreeNode receiver ifTrue:[^ false].
selector ~~ aProfileTreeNode selector ifTrue:[^ false].
class ~~ aProfileTreeNode methodClass ifTrue:[^ false].
^ true
+
+ "Modified: 18.5.1996 / 19:04:40 / cg"
!
addLeafNodesTo:aCollection
+ "add all leaf nodes to aCollection"
+
|idx|
leafTally notNil ifTrue:[
- idx := aCollection indexOf:self.
- idx == 0 ifTrue:[
- aCollection add:self copy
- ] ifFalse:[
- |nd|
+ idx := aCollection indexOf:self.
+ idx == 0 ifTrue:[
+ aCollection add:self copy
+ ] ifFalse:[
+ |nd|
- nd := aCollection at:idx.
- nd leafTally:(nd leafTally + leafTally).
- nd totalTally:(nd totalTally max: totalTally)
- ]
+ nd := aCollection at:idx.
+ nd leafTally:(nd leafTally + leafTally).
+ nd totalTally:(nd totalTally max: totalTally)
+ ]
].
called notNil ifTrue:[
- called do:[:aNode |
- aNode addLeafNodesTo:aCollection
- ]
+ called do:[:aNode |
+ aNode addLeafNodesTo:aCollection
+ ]
]
+
+ "Modified: 18.5.1996 / 19:04:56 / cg"
! !
!ProfileTree class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/ProfileTree.st,v 1.11 1996-04-25 17:11:26 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ProfileTree.st,v 1.12 1996-05-18 17:05:49 cg Exp $'
! !