--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Change.st Fri Jul 16 11:38:06 1993 +0200
@@ -0,0 +1,15 @@
+'From Smalltalk/X, Version:2.6.4 on 29-Apr-1993 at 19:31:37'!
+
+Object subclass:#Change
+ instanceVariableNames:'source'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Changes'
+!
+
+!Change methodsFor:'source'!
+
+source
+ ^ source
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ChangeSet.st Fri Jul 16 11:38:06 1993 +0200
@@ -0,0 +1,20 @@
+'From Smalltalk/X, Version:2.6.4 on 29-Apr-1993 at 19:31:37'!
+
+OrderedCollection subclass:#ChangeSet
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Changes'
+!
+
+!ChangeSet methodsFor:'change management'!
+
+addMethodChange:aMethod in:aClass
+ |newChange|
+
+ newChange := MethodChange class:aClass
+ selector:(aClass selectorForMethod:aMethod)
+ source:aMethod source.
+ self add:newChange
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ClassChange.st Fri Jul 16 11:38:06 1993 +0200
@@ -0,0 +1,15 @@
+'From Smalltalk/X, Version:2.6.4 on 29-Apr-1993 at 19:31:37'!
+
+Change subclass:#ClassChange
+ instanceVariableNames:'className'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Changes'
+!
+
+!ClassChange methodsFor:'accessing'!
+
+className
+ ^ className
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ClassChg.st Fri Jul 16 11:38:06 1993 +0200
@@ -0,0 +1,15 @@
+'From Smalltalk/X, Version:2.6.4 on 29-Apr-1993 at 19:31:37'!
+
+Change subclass:#ClassChange
+ instanceVariableNames:'className'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Changes'
+!
+
+!ClassChange methodsFor:'accessing'!
+
+className
+ ^ className
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ClassCommentChange.st Fri Jul 16 11:38:06 1993 +0200
@@ -0,0 +1,21 @@
+'From Smalltalk/X, Version:2.6.4 on 29-Apr-1993 at 19:31:38'!
+
+ClassChange subclass:#ClassCommentChange
+ instanceVariableNames:'comment'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Changes'
+!
+
+!ClassCommentChange methodsFor:'accessing'!
+
+comment
+ ^ comment
+! !
+
+!ClassCommentChange methodsFor:'printing'!
+
+printString
+ ^ 'ClassCommentChange(' , className , ')'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ClassDefinitionChange.st Fri Jul 16 11:38:06 1993 +0200
@@ -0,0 +1,15 @@
+'From Smalltalk/X, Version:2.6.4 on 29-Apr-1993 at 19:31:37'!
+
+ClassChange subclass:#ClassDefinitionChange
+ instanceVariableNames:'definition'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Changes'
+!
+
+!ClassDefinitionChange methodsFor:'printing'!
+
+printString
+ ^ 'ClassDefinitionChange(' , className , ')'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ClsComChg.st Fri Jul 16 11:38:06 1993 +0200
@@ -0,0 +1,21 @@
+'From Smalltalk/X, Version:2.6.4 on 29-Apr-1993 at 19:31:38'!
+
+ClassChange subclass:#ClassCommentChange
+ instanceVariableNames:'comment'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Changes'
+!
+
+!ClassCommentChange methodsFor:'accessing'!
+
+comment
+ ^ comment
+! !
+
+!ClassCommentChange methodsFor:'printing'!
+
+printString
+ ^ 'ClassCommentChange(' , className , ')'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ClsDefChg.st Fri Jul 16 11:38:06 1993 +0200
@@ -0,0 +1,15 @@
+'From Smalltalk/X, Version:2.6.4 on 29-Apr-1993 at 19:31:37'!
+
+ClassChange subclass:#ClassDefinitionChange
+ instanceVariableNames:'definition'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Changes'
+!
+
+!ClassDefinitionChange methodsFor:'printing'!
+
+printString
+ ^ 'ClassDefinitionChange(' , className , ')'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MessageTally.st Fri Jul 16 11:38:06 1993 +0200
@@ -0,0 +1,265 @@
+"
+ COPYRIGHT (c) 1989-93 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.
+"
+
+Object subclass:#MessageTally
+ instanceVariableNames:'classes selectors counts ntally
+ sumClasses sumSelectors sumCounts sumNtally'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Support'
+!
+
+MessageTally comment:'
+
+COPYRIGHT (c) 1989-93 by Claus Gittinger
+ All Rights Reserved
+
+%W% %E%
+
+MessageTally allows profiling excution of a block; statistic
+of method evaluation is output on Transcript.
+To get statistic, use MessageTally spyOn:aBlock.
+'!
+
+!MessageTally class methodsFor:'instance creation'!
+
+spyOn:aBlock
+ "evaluate aBlock and output time statistic on Transcript"
+
+ |runTime aTally|
+
+ aTally := self new.
+ runTime := aTally spyOn:aBlock.
+ aTally statistics.
+ Transcript cr.
+ Transcript showCr:('total execution time: '
+ , runTime printString , ' ms')
+
+ "MessageTally spyOn:[10000 timesRepeat:[#(6 5 4 3 2 1) sort] ]"
+!
+
+spyCountOn:aBlock
+ "evaluate aBlock and output call statistic on Transcript"
+
+ (self new spyCountOn:aBlock) statistics
+
+ "MessageTally spyCountOn:[#(6 5 4 3 2 1) sort ]"
+! !
+
+!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
+!
+
+spyOn:aBlock
+ "spy on execution time"
+
+ |startTime endTime|
+
+ self setupArrays.
+ SpyInterruptHandler := self.
+ startTime := OperatingSystem getMillisecondTime.
+ OperatingSystem startSpyTimer.
+ aBlock value.
+ OperatingSystem stopSpyTimer.
+ endTime := OperatingSystem getMillisecondTime.
+ SpyInterruptHandler := nil.
+ ^ endTime - startTime
+!
+
+spyCountOn:aBlock
+ "spy on method sends"
+
+ self setupArrays.
+ StepInterruptHandler := self.
+ StepInterruptPending := true.
+ InterruptPending := true.
+ aBlock value.
+ StepInterruptPending := nil.
+ StepInterruptHandler := nil
+!
+
+stepInterrupt
+ "called for every send;
+ increment counts and retrigger stepInterrupt"
+
+ self count.
+ StepInterruptPending := true.
+ InterruptPending := true
+!
+
+spyInterrupt
+ "called every 10ms by timer;
+ increment counts and retrigger spyInterrupt"
+
+ self count.
+ OperatingSystem startSpyTimer
+!
+
+count
+ "increment class/method counts"
+
+ |where index sel recClass done newColl|
+
+ 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"
+
+ "ignore block-contexts"
+ (where isBlockContext) ifTrue:[
+ where := nil. "currently needed"
+ ^ self
+ ].
+
+ sel := where selector.
+ recClass := where searchClass whichClassImplements:sel "receiver class".
+
+ 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
+ ]
+ ]
+ ].
+
+ "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|
+
+ 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 printStringRightAdjustLen:6).
+ Transcript tab. Transcript show:' '.
+ Transcript show:((percent printStringRightAdjustLen:3) , '%').
+ Transcript tab.
+ Transcript show:((classes at:index) name printStringRightAdjustLen: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 printStringRightAdjustLen:6).
+ Transcript tab. Transcript show:' '.
+ Transcript show:((percent printStringRightAdjustLen:3) , '%').
+ Transcript tab.
+ (sumClasses at:index) isNil ifTrue:[
+ Transcript show:('??' printStringRightAdjustLen:20)
+ ] ifFalse:[
+ Transcript show:((sumClasses at:index) name printStringRightAdjustLen:20).
+ ].
+ Transcript tab. Transcript show:' '.
+ Transcript showCr:((sumSelectors at:index) printString)
+ ]
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MethodChange.st Fri Jul 16 11:38:06 1993 +0200
@@ -0,0 +1,29 @@
+'From Smalltalk/X, Version:2.6.4 on 29-Apr-1993 at 19:31:37'!
+
+ClassChange subclass:#MethodChange
+ instanceVariableNames:'selector'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Changes'
+!
+
+!MethodChange class methodsFor:'instance creation'!
+
+class:cls selector:sel source:src
+ ^ self basicNew class:cls selector:sel source:src
+! !
+
+!MethodChange methodsFor:'accessing'!
+
+class:cls selector:sel source:src
+ className := cls name.
+ selector := sel.
+ source := src
+! !
+
+!MethodChange methodsFor:'printing'!
+
+printString
+ ^ className , ' ' , selector
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MethodChg.st Fri Jul 16 11:38:06 1993 +0200
@@ -0,0 +1,29 @@
+'From Smalltalk/X, Version:2.6.4 on 29-Apr-1993 at 19:31:37'!
+
+ClassChange subclass:#MethodChange
+ instanceVariableNames:'selector'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Changes'
+!
+
+!MethodChange class methodsFor:'instance creation'!
+
+class:cls selector:sel source:src
+ ^ self basicNew class:cls selector:sel source:src
+! !
+
+!MethodChange methodsFor:'accessing'!
+
+class:cls selector:sel source:src
+ className := cls name.
+ selector := sel.
+ source := src
+! !
+
+!MethodChange methodsFor:'printing'!
+
+printString
+ ^ className , ' ' , selector
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MsgTally.st Fri Jul 16 11:38:06 1993 +0200
@@ -0,0 +1,265 @@
+"
+ COPYRIGHT (c) 1989-93 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.
+"
+
+Object subclass:#MessageTally
+ instanceVariableNames:'classes selectors counts ntally
+ sumClasses sumSelectors sumCounts sumNtally'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'System-Support'
+!
+
+MessageTally comment:'
+
+COPYRIGHT (c) 1989-93 by Claus Gittinger
+ All Rights Reserved
+
+%W% %E%
+
+MessageTally allows profiling excution of a block; statistic
+of method evaluation is output on Transcript.
+To get statistic, use MessageTally spyOn:aBlock.
+'!
+
+!MessageTally class methodsFor:'instance creation'!
+
+spyOn:aBlock
+ "evaluate aBlock and output time statistic on Transcript"
+
+ |runTime aTally|
+
+ aTally := self new.
+ runTime := aTally spyOn:aBlock.
+ aTally statistics.
+ Transcript cr.
+ Transcript showCr:('total execution time: '
+ , runTime printString , ' ms')
+
+ "MessageTally spyOn:[10000 timesRepeat:[#(6 5 4 3 2 1) sort] ]"
+!
+
+spyCountOn:aBlock
+ "evaluate aBlock and output call statistic on Transcript"
+
+ (self new spyCountOn:aBlock) statistics
+
+ "MessageTally spyCountOn:[#(6 5 4 3 2 1) sort ]"
+! !
+
+!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
+!
+
+spyOn:aBlock
+ "spy on execution time"
+
+ |startTime endTime|
+
+ self setupArrays.
+ SpyInterruptHandler := self.
+ startTime := OperatingSystem getMillisecondTime.
+ OperatingSystem startSpyTimer.
+ aBlock value.
+ OperatingSystem stopSpyTimer.
+ endTime := OperatingSystem getMillisecondTime.
+ SpyInterruptHandler := nil.
+ ^ endTime - startTime
+!
+
+spyCountOn:aBlock
+ "spy on method sends"
+
+ self setupArrays.
+ StepInterruptHandler := self.
+ StepInterruptPending := true.
+ InterruptPending := true.
+ aBlock value.
+ StepInterruptPending := nil.
+ StepInterruptHandler := nil
+!
+
+stepInterrupt
+ "called for every send;
+ increment counts and retrigger stepInterrupt"
+
+ self count.
+ StepInterruptPending := true.
+ InterruptPending := true
+!
+
+spyInterrupt
+ "called every 10ms by timer;
+ increment counts and retrigger spyInterrupt"
+
+ self count.
+ OperatingSystem startSpyTimer
+!
+
+count
+ "increment class/method counts"
+
+ |where index sel recClass done newColl|
+
+ 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"
+
+ "ignore block-contexts"
+ (where isBlockContext) ifTrue:[
+ where := nil. "currently needed"
+ ^ self
+ ].
+
+ sel := where selector.
+ recClass := where searchClass whichClassImplements:sel "receiver class".
+
+ 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
+ ]
+ ]
+ ].
+
+ "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|
+
+ 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 printStringRightAdjustLen:6).
+ Transcript tab. Transcript show:' '.
+ Transcript show:((percent printStringRightAdjustLen:3) , '%').
+ Transcript tab.
+ Transcript show:((classes at:index) name printStringRightAdjustLen: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 printStringRightAdjustLen:6).
+ Transcript tab. Transcript show:' '.
+ Transcript show:((percent printStringRightAdjustLen:3) , '%').
+ Transcript tab.
+ (sumClasses at:index) isNil ifTrue:[
+ Transcript show:('??' printStringRightAdjustLen:20)
+ ] ifFalse:[
+ Transcript show:((sumClasses at:index) name printStringRightAdjustLen:20).
+ ].
+ Transcript tab. Transcript show:' '.
+ Transcript showCr:((sumSelectors at:index) printString)
+ ]
+! !