Initial revision
authorclaus
Thu, 09 Mar 1995 00:41:17 +0100
changeset 22 2911230f8e8e
parent 21 c521be54a8e6
child 23 a85cd774be98
Initial revision
CallChain.st
ProfileTree.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/CallChain.st	Thu Mar 09 00:41:17 1995 +0100
@@ -0,0 +1,54 @@
+'From Smalltalk/X, Version:2.10.4 on 8-mar-1995 at 15:00:52'!
+
+Object subclass:#CallChain
+	 instanceVariableNames:'receiver selector class isBlock rest'
+	 classVariableNames:''
+	 poolDictionaries:''
+	 category:'System-Profiler'
+!
+
+!CallChain methodsFor:'accessing'!
+
+rest:r
+    rest := r.
+!
+
+rest
+    ^ rest
+!
+
+selector
+    ^ selector
+!
+
+methodClass
+    ^ class
+!
+
+receiver:r selector:s class:cls 
+    receiver := r.
+    selector := s.
+    class := cls.
+    isBlock := false.
+!
+
+isBlock 
+    ^ isBlock
+!
+
+isBlock:aBoolean 
+    isBlock := aBoolean.
+!
+
+receiver
+    ^ receiver
+! !
+
+!CallChain methodsFor:'comparing'!
+
+= someInfo
+    receiver == someInfo receiver ifFalse:[^ false].
+    selector == someInfo selector ifFalse:[^ false].
+    ^ class == someInfo methodClass
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/ProfileTree.st	Thu Mar 09 00:41:17 1995 +0100
@@ -0,0 +1,229 @@
+'From Smalltalk/X, Version:2.10.4 on 8-mar-1995 at 22:37:26'!
+
+Object subclass:#ProfileTree
+	 instanceVariableNames:'receiver selector class leafTally totalTally called isBlock'
+	 classVariableNames:''
+	 poolDictionaries:''
+	 category:'System-Profiler'
+!
+
+!ProfileTree methodsFor:'prettyPrinting'!
+
+printOn:aStream indent:i
+    selector notNil ifTrue:[
+        aStream spaces:i.
+        self printSingleOn:aStream.
+        aStream cr.
+    ].
+
+    called notNil ifTrue:[
+        called do:[:sub|
+            sub printOn:aStream indent:(i + 1)
+        ].
+    ].
+!
+
+printOn:aStream
+    |s|
+
+"/    self printOn:aStream indent:0
+    s := WriteStream on:String new.
+    self printOn:s indent:0.
+
+    aStream nextPutAll:s contents
+!
+
+printSingleOn: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.
+
+        aStream nextPutAll:'(total '.
+        totalTally printOn:aStream.
+        aStream nextPutAll:'%)'.
+
+        leafTally notNil ifTrue:[
+            aStream nextPutAll:'(leaf '.
+            leafTally printOn:aStream.
+            aStream nextPutAll:'%)'.
+        ].
+    ].
+!
+
+printLeafsOn:aStream
+    |leafNodes|
+
+    leafNodes := OrderedCollection new.
+    self addLeafNodesTo:leafNodes.
+    leafNodes := leafNodes asSortedCollection:[:a :b |
+                                        a leafTally < b leafTally].
+    leafNodes do:[:aNode |
+        aNode printSingleOn:aStream.
+        aStream cr.
+    ].
+! !
+
+!ProfileTree methodsFor:'accessing'!
+
+selector 
+    ^ selector
+!
+
+called:aCollection
+    called := aCollection
+!
+
+methodClass 
+    ^ class 
+!
+
+isBlock:aBoolean
+    isBlock  := aBoolean
+!
+
+receiver
+    ^ receiver
+!
+
+called
+    ^ called
+!
+
+leafTally
+    ^ leafTally
+!
+
+receiver:r selector:s class:cls 
+    receiver := r.
+    selector := s.
+    class := cls
+!
+
+totalTally
+    ^ totalTally
+!
+
+isBlock 
+    ^ isBlock 
+! !
+
+!ProfileTree methodsFor:'adding info'!
+
+computePercentage:total
+    totalTally := (totalTally / total * 1000) rounded / 10.0.
+    leafTally notNil ifTrue:[
+        leafTally := (leafTally / total * 1000) rounded / 10.0
+    ].
+
+    called notNil ifTrue:[
+        called do:[:subTree |
+            subTree computePercentage:total
+        ]
+    ].
+!
+
+addChain:aCallChain
+    |node found subTree chain called|
+
+    node := self.
+    chain := aCallChain.
+
+    [chain notNil] whileTrue:[
+	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).
+
+	    node called add:subTree.
+	    node := subTree.
+	    chain := chain rest
+	]
+
+    ].
+
+    node incrementTotalTally.
+    node incrementLeafTally.
+!
+
+incrementTotalTally
+    totalTally isNil ifTrue:[
+	totalTally := 1
+    ] ifFalse:[
+	totalTally := totalTally + 1.
+    ].
+!
+
+leafTally:aCount
+    leafTally := aCount
+!
+
+incrementLeafTally
+    leafTally isNil ifTrue:[
+	leafTally := 1
+    ] ifFalse:[
+	leafTally := leafTally + 1.
+    ].
+!
+
+totalTally:aCount
+    totalTally := aCount
+! !
+
+!ProfileTree methodsFor:'private'!
+
+addLeafNodesTo:aCollection
+    |idx|
+
+    leafTally notNil ifTrue:[
+        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 + totalTally)
+        ]
+    ].
+    called notNil ifTrue:[
+        called do:[:aNode |
+            aNode addLeafNodesTo:aCollection
+        ]
+    ]
+!
+
+= aProfileTreeNode
+    receiver ~= aProfileTreeNode receiver ifTrue:[^ false].
+    selector ~~ aProfileTreeNode selector ifTrue:[^ false].
+    class ~~ aProfileTreeNode methodClass ifTrue:[^ false].
+    ^ true
+! !
+