--- a/MessageTracer.st Thu Jun 05 11:38:02 2014 +0200
+++ b/MessageTracer.st Tue Jun 10 12:21:37 2014 +0200
@@ -67,88 +67,88 @@
tracing execution of a block:
- MessageTracer trace:[ ... ]
-
- MessageTracer traceFull:[ ... ]
-
- (for system developer only:)
-
- MessageTracer debugTrace:[ ... ]
+ MessageTracer trace:[ ... ]
+
+ MessageTracer traceFull:[ ... ]
+
+ (for system developer only:)
+
+ MessageTracer debugTrace:[ ... ]
trapping sends to a specific object:
- MessageTracer trap:anObject selector:aSelector
- ...
- MessageTracer untrap:anObject selector:aSelector
- or:
- MessageTracer untrap:anObject
+ MessageTracer trap:anObject selector:aSelector
+ ...
+ MessageTracer untrap:anObject selector:aSelector
+ or:
+ MessageTracer untrap:anObject
trapping some messages sent to a specific object:
- MessageTracer trap:anObject selectors:aCollectionOfSelectors
- ...
- MessageTracer untrap:anObject
+ MessageTracer trap:anObject selectors:aCollectionOfSelectors
+ ...
+ MessageTracer untrap:anObject
trapping any message sent to a specific object:
- MessageTracer trapAll:anObject
- ...
- MessageTracer untrap:anObject
+ MessageTracer trapAll:anObject
+ ...
+ MessageTracer untrap:anObject
trapping evaluation of a specific method:
- MessageTracer trapMethod:aMethod
- ...
- MessageTracer unwrapMethod:aMethod
+ MessageTracer trapMethod:aMethod
+ ...
+ MessageTracer unwrapMethod:aMethod
trapping evaluation of a specific method with
receiver being an instance of some class:
- MessageTracer trapMethod:aMethod forInstancesOf:aClass
- ...
- MessageTracer unwrapMethod:aMethod
+ MessageTracer trapMethod:aMethod forInstancesOf:aClass
+ ...
+ MessageTracer unwrapMethod:aMethod
tracing sends to a specific object:
- MessageTracer trace:anObject selector:aSelector
- ...
- MessageTracer untrace:anObject selector:aSelector
- or:
- MessageTracer untrace:anObject
+ MessageTracer trace:anObject selector:aSelector
+ ...
+ MessageTracer untrace:anObject selector:aSelector
+ or:
+ MessageTracer untrace:anObject
tracing sender only:
- MessageTracer traceSender:anObject selector:aSelector
- ...
- MessageTracer untrace:anObject selector:aSelector
- or:
- MessageTracer untrace:anObject
+ MessageTracer traceSender:anObject selector:aSelector
+ ...
+ MessageTracer untrace:anObject selector:aSelector
+ or:
+ MessageTracer untrace:anObject
tracing evaluation of a specific method:
- MessageTracer traceMethod:aMethod
- ...
- MessageTracer unwrapmethod:aMethod
+ MessageTracer traceMethod:aMethod
+ ...
+ MessageTracer unwrapmethod:aMethod
see more in examples and in method comments.
[author:]
- Claus Gittinger
+ Claus Gittinger
"
!
@@ -161,60 +161,60 @@
trapping specific methods:
(by class/selector):
- [exBegin]
+ [exBegin]
MessageTracer trapClass:Collection selector:#select:.
Dictionary new select:[:e | ]. 'not caught - Dictionary has its own select'.
(Array new:10) select:[:e | ]. 'not caught - SeqColl has its own select'.
Set new select:[:e | ]. 'caught - Set inherits this from Collection'.
- MessageTracer untrapClass:Collection
- [exEnd]
+ MessageTracer untrapClass:Collection
+ [exEnd]
(by method):
- [exBegin]
+ [exBegin]
MessageTracer trapMethod:(Collection compiledMethodAt:#select:).
Dictionary new select:[:e | ]. 'not caught - Dictionary has its own select'.
(Array new:10) select:[:e | ]. 'not caught - SeqColl has its own select'.
Set new select:[:e | ]. 'caught - Set inherits this from Collection'.
MessageTracer unwrapMethod:(Collection compiledMethodAt:#select:).
- [exEnd]
+ [exEnd]
(by method & instance class):
- [exBegin]
+ [exBegin]
MessageTracer trapMethod:(SequenceableCollection compiledMethodAt:#select:)
- forInstancesOf:SortedCollection.
+ forInstancesOf:SortedCollection.
Dictionary new select:[:e | ]. 'not caught - Dictionary has its own select'.
(Array new:10) select:[:e | ]. 'not caught - not a SortedCollection'.
OrderedCollection new select:[:e | ]. 'not caught - not a SortedCollection'.
SortedCollection new select:[:e | ]. 'caught - Set inherits this from Collection'.
MessageTracer unwrapMethod:(SequenceableCollection compiledMethodAt:#select:).
- [exEnd]
+ [exEnd]
tracing specific methods:
(by class/selector):
- [exBegin]
+ [exBegin]
MessageTracer traceClass:SequenceableCollection selector:#quickSortFrom:to:.
#(6 1 9 66 2 17) copy sort.
- MessageTracer untraceClass:SequenceableCollection
- [exEnd]
+ MessageTracer untraceClass:SequenceableCollection
+ [exEnd]
(by method):
- [exBegin]
+ [exBegin]
MessageTracer traceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
#(6 1 9 66 2 17) copy sort.
- MessageTracer unwrapMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
- [exEnd]
+ MessageTracer unwrapMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
+ [exEnd]
object trapping:
- [exBegin]
+ [exBegin]
|o|
o := OrderedCollection new.
MessageTracer trapAll:o.
o collect:[:el | el].
- [exEnd]
+ [exEnd]
trapping modifications to an objects instVars:
- [exBegin]
+ [exBegin]
|o|
o := Point new.
@@ -224,10 +224,10 @@
o x:1.
o y:2.
MessageTracer untrap:o
- [exEnd]
+ [exEnd]
trapping modifications of a particular instVar:
- [exBegin]
+ [exBegin]
|o|
o := Point new.
@@ -237,11 +237,11 @@
o x:1.
o y:2.
MessageTracer untrap:o
- [exEnd]
+ [exEnd]
tracing during block execution:
- [exBegin]
+ [exBegin]
MessageTracer trace:[ 10 factorialR ]
- [exEnd]
+ [exEnd]
"
! !
@@ -262,16 +262,16 @@
initialize
BreakpointSignal isNil ifTrue:[
- "/ BreakpointSignal := HaltSignal newSignalMayProceed:true.
- "/ BreakpointSignal nameClass:self message:#breakpointSignal.
- BreakpointSignal := BreakPointInterrupt.
- BreakpointSignal notifierString:'breakpoint encountered'.
+ "/ BreakpointSignal := HaltSignal newSignalMayProceed:true.
+ "/ BreakpointSignal nameClass:self message:#breakpointSignal.
+ BreakpointSignal := BreakPointInterrupt.
+ BreakpointSignal notifierString:'breakpoint encountered'.
].
ObjectWrittenBreakpointSignal isNil ifTrue:[
- ObjectWrittenBreakpointSignal := BreakpointSignal newSignalMayProceed:true.
- ObjectWrittenBreakpointSignal nameClass:self message:#objectWrittenBreakpointSignal.
- ObjectWrittenBreakpointSignal notifierString:'object modified'.
+ ObjectWrittenBreakpointSignal := BreakpointSignal newSignalMayProceed:true.
+ ObjectWrittenBreakpointSignal nameClass:self message:#objectWrittenBreakpointSignal.
+ ObjectWrittenBreakpointSignal notifierString:'object modified'.
].
"/ the following have been written as cheapBlocks (by purpose)
@@ -297,7 +297,7 @@
"sent when restarted after a snapIn"
(something == #restarted) ifTrue:[
- TimeForWrappers := nil
+ TimeForWrappers := nil
]
"Created: / 30.7.1998 / 17:00:09 / cg"
@@ -325,10 +325,10 @@
!MessageTracer class methodsFor:'class wrapping'!
-wrapClass:orgClass selector:aSelector onEntry:entryBlock onExit:exitBlock
+wrapClass:orgClass selector:aSelector onEntry:entryBlock onExit:exitBlock
"arrange for the two blocks entryBlock and exitBlock to be evaluated whenever
- aSelector is sent to instances of orgClass or subclasses.
- EntryBlock will be called on entry, and get the current context passed as argument.
+ aSelector is sent to instances of orgClass or subclasses.
+ EntryBlock will be called on entry, and get the current context passed as argument.
ExitBlock will be called, when the method is left, and get context and the methods return value as arguments.
"
@@ -348,41 +348,41 @@
s nextPutAll:'<context: #return>'; cr.
s nextPutAll:'|retVal stubClass|'; cr.
entryBlock notNil ifTrue:[
- s nextPutAll:'#literal1 yourself value:thisContext.'; cr.
+ s nextPutAll:'#literal1 yourself value:thisContext.'; cr.
].
s nextPutAll:('retVal := #originalMethod. '). "/ just to get a literal to be replaced by theoriginal method
s nextPutAll:('retVal := super ' , spec , '.'); cr.
exitBlock notNil ifTrue:[
- s nextPutAll:'#literal2 yourself value:thisContext value:retVal.'; cr.
+ s nextPutAll:'#literal2 yourself value:thisContext value:retVal.'; cr.
].
s nextPutAll:'^ retVal'; cr.
- ParserFlags
- withSTCCompilation:#never
- do:[
- Class withoutUpdatingChangesDo:[
- trapMethod := Compiler
- compile:s contents
- forClass:orgClass
- inCategory:'trapping'
- notifying:nil
- install:false
- skipIfSame:false
- silent:true.
- ]
- ].
+ ParserFlags
+ withSTCCompilation:#never
+ do:[
+ Class withoutUpdatingChangesDo:[
+ trapMethod := Compiler
+ compile:s contents
+ forClass:orgClass
+ inCategory:'trapping'
+ notifying:nil
+ install:false
+ skipIfSame:false
+ silent:true.
+ ]
+ ].
implClass := orgClass whichClassIncludesSelector:aSelector.
implClass isNil ifTrue:[
- Transcript showCR:aSelector , ' is not understood by ' , orgClass name.
+ Transcript showCR:aSelector , ' is not understood by ' , orgClass name.
] ifFalse:[
- trapMethod changeLiteral:#originalMethod to:(implClass compiledMethodAt:aSelector).
+ trapMethod changeLiteral:#originalMethod to:(implClass compiledMethodAt:aSelector).
].
entryBlock notNil ifTrue:[
- trapMethod changeLiteral:#literal1 to:entryBlock.
+ trapMethod changeLiteral:#literal1 to:entryBlock.
].
exitBlock notNil ifTrue:[
- trapMethod changeLiteral:#literal2 to:exitBlock.
+ trapMethod changeLiteral:#literal2 to:exitBlock.
].
"
@@ -399,90 +399,90 @@
if not already trapping, create a new class
"
orgClass category == #'* trapping *' ifTrue:[
- dict at:aSelector put:trapMethod.
- orgClass methodDictionary:dict.
- newClass := orgClass superclass.
+ dict at:aSelector put:trapMethod.
+ orgClass methodDictionary:dict.
+ newClass := orgClass superclass.
] ifFalse:[
- myMetaclass := orgClass class.
-
- newClass := myMetaclass copy new.
- newClass setSuperclass:orgClass superclass.
- newClass instSize:orgClass instSize.
- newClass flags:orgClass flags.
- newClass setClassVariableString:orgClass classVariableString.
- newClass setSharedPoolNames:(orgClass sharedPoolNames).
- newClass setInstanceVariableString:orgClass instanceVariableString.
- newClass setName:orgClass name.
- newClass setCategory:orgClass category.
- newClass methodDictionary:dict.
-
- orgClass setSuperclass:newClass.
- orgClass setClassVariableString:''.
- orgClass setInstanceVariableString:''.
- orgClass setCategory:#'* trapping *'.
-
- dict := MethodDictionary new:1.
- dict at:aSelector put:trapMethod.
- orgClass methodDictionary:dict.
+ myMetaclass := orgClass class.
+
+ newClass := myMetaclass copy new.
+ newClass setSuperclass:orgClass superclass.
+ newClass instSize:orgClass instSize.
+ newClass flags:orgClass flags.
+ newClass setClassVariableString:orgClass classVariableString.
+ newClass setSharedPoolNames:(orgClass sharedPoolNames).
+ newClass setInstanceVariableString:orgClass instanceVariableString.
+ newClass setName:orgClass name.
+ newClass setCategory:orgClass category.
+ newClass methodDictionary:dict.
+
+ orgClass setSuperclass:newClass.
+ orgClass setClassVariableString:''.
+ orgClass setInstanceVariableString:''.
+ orgClass setCategory:#'* trapping *'.
+
+ dict := MethodDictionary new:1.
+ dict at:aSelector put:trapMethod.
+ orgClass methodDictionary:dict.
].
trapMethod changeLiteral:(newClass superclass) to:newClass.
ObjectMemory flushCaches.
"
- MessageTracer
- wrapClass:Point
- selector:#scaleBy:
- onEntry:nil
- onExit:[:con :retVal |
- Transcript show:'leave Point>>scaleBy:; returning:'.
- Transcript showCR:retVal printString.
- Transcript endEntry
- ].
- (1@2) scaleBy:5.
- MessageTracer untrapClass:Point selector:#scaleBy:.
- (1@2) scaleBy:5.
+ MessageTracer
+ wrapClass:Point
+ selector:#scaleBy:
+ onEntry:nil
+ onExit:[:con :retVal |
+ Transcript show:'leave Point>>scaleBy:; returning:'.
+ Transcript showCR:retVal printString.
+ Transcript endEntry
+ ].
+ (1@2) scaleBy:5.
+ MessageTracer untrapClass:Point selector:#scaleBy:.
+ (1@2) scaleBy:5.
"
"
- MessageTracer
- wrapClass:Integer
- selector:#factorial
- onEntry:[:con |
- Transcript showCR:('entering ' , con receiver printString , '>>factorial').
- ]
- onExit:[:con :retVal |
- Transcript show:'leave Integer>>factorial; returning:'.
- Transcript showCR:retVal printString.
- Transcript endEntry
- ].
+ MessageTracer
+ wrapClass:Integer
+ selector:#factorial
+ onEntry:[:con |
+ Transcript showCR:('entering ' , con receiver printString , '>>factorial').
+ ]
+ onExit:[:con :retVal |
+ Transcript show:'leave Integer>>factorial; returning:'.
+ Transcript showCR:retVal printString.
+ Transcript endEntry
+ ].
Transcript showCR:'5 factorial traced'.
- 5 factorial.
- MessageTracer untrapClass:Integer selector:#factorial.
+ 5 factorial.
+ MessageTracer untrapClass:Integer selector:#factorial.
Transcript showCR:'5 factorial normal'.
- 5 factorial.
+ 5 factorial.
"
"
|lvl|
lvl := 0.
- MessageTracer
- wrapClass:Integer
- selector:#factorial
- onEntry:[:con |
- Transcript spaces:lvl. lvl := lvl + 2.
- Transcript showCR:('entering ' , con receiver printString , '>>factorial').
- ]
- onExit:[:con :retVal |
- lvl := lvl - 2. Transcript spaces:lvl.
- Transcript show:('leave ' , con receiver printString , '>>factorial; returning:').
- Transcript showCR:retVal printString.
- Transcript endEntry
- ].
+ MessageTracer
+ wrapClass:Integer
+ selector:#factorial
+ onEntry:[:con |
+ Transcript spaces:lvl. lvl := lvl + 2.
+ Transcript showCR:('entering ' , con receiver printString , '>>factorial').
+ ]
+ onExit:[:con :retVal |
+ lvl := lvl - 2. Transcript spaces:lvl.
+ Transcript show:('leave ' , con receiver printString , '>>factorial; returning:').
+ Transcript showCR:retVal printString.
+ Transcript endEntry
+ ].
Transcript showCR:'5 factorial traced'.
- 5 factorial.
- MessageTracer untrapClass:Integer selector:#factorial.
+ 5 factorial.
+ MessageTracer untrapClass:Integer selector:#factorial.
Transcript showCR:'5 factorial normal'.
- 5 factorial.
+ 5 factorial.
"
"Modified: / 25-06-1996 / 22:01:05 / stefan"
@@ -537,9 +537,9 @@
"evaluate aBlock sending trace information to stdout.
Return the value of the block."
- ^ PrintingMessageTracer new
- output:aStream;
- trace:aBlock detail:false.
+ ^ PrintingMessageTracer new
+ output:aStream;
+ trace:aBlock detail:false.
"
MessageTracer trace:[#(6 5 4 3 2 1) sort] on:Transcript
@@ -563,9 +563,9 @@
Return the value of the block.
The trace information is more detailed."
- ^ PrintingMessageTracer new
- output:aStream;
- trace:aBlock detail:true.
+ ^ PrintingMessageTracer new
+ output:aStream;
+ trace:aBlock detail:true.
"
MessageTracer traceFull:[#(6 5 4 3 2 1) sort]
@@ -589,9 +589,9 @@
Return the value of the block.
The trace information is more detailed."
- ^ PrintingMessageTracer new
- output:aStream;
- trace:aBlock detail:#fullIndent.
+ ^ PrintingMessageTracer new
+ output:aStream;
+ trace:aBlock detail:#fullIndent.
"
MessageTracer traceFullIndented:[ #(6 5 4 3 2 1) sort ]
@@ -613,9 +613,9 @@
"evaluate aBlock sending trace information to stdout.
Return the value of the block."
- ^ PrintingMessageTracer new
- output:aStream;
- trace:aBlock detail:#indent.
+ ^ PrintingMessageTracer new
+ output:aStream;
+ trace:aBlock detail:#indent.
"
MessageTracer traceIndented:[ #(6 5 4 3 2 1) sort ] on:Transcript
@@ -625,7 +625,7 @@
!MessageTracer class methodsFor:'method breakpointing'!
trapClass:aClass selector:aSelector
- "arrange for the debugger to be entered when a message with aSelector is
+ "arrange for the debugger to be entered when a message with aSelector is
sent to instances of aClass (or subclass instances). Use untrapClass to remove this trap.
Be careful, to not place a trap on code needed in the debugger (i.e. on scrollBars etc.);
if there is a need to trap those, use the low-level wrap-methods, and put a check into the
@@ -638,7 +638,7 @@
Dictionary new select:[:e | ]. 'not caught - Dictionary has its own select'.
(Array new:10) select:[:e | ]. 'not caught - SeqColl has its own select'.
Set new select:[:e | ]. 'caught - Set inherits this from Collection'.
- MessageTracer untrapClass:Collection
+ MessageTracer untrapClass:Collection
"
!
@@ -652,8 +652,8 @@
entry/leave blocks."
^ self wrapMethod:aMethod
- onEntry:BreakBlock
- onExit:LeaveBreakBlock.
+ onEntry:BreakBlock
+ onExit:LeaveBreakBlock.
"
MessageTracer trapMethod:(Collection compiledMethodAt:#select:).
@@ -678,13 +678,13 @@
n := 0.
^ self wrapMethod:aMethod
- onEntry:[:con | n := n + 1.
- n > countInvocations
- ifTrue:[
- BreakpointSignal raiseRequestWith:nil errorString:nil in:con
- ]
- ]
- onExit:LeaveBreakBlock.
+ onEntry:[:con | n := n + 1.
+ n > countInvocations
+ ifTrue:[
+ BreakpointSignal raiseRequestWith:nil errorString:nil in:con
+ ]
+ ]
+ onExit:LeaveBreakBlock.
!
@@ -697,12 +697,12 @@
entry/leave blocks."
^ self wrapMethod:aMethod
- onEntry:[:con |
- (con receiver isMemberOf:aClass) ifTrue:[
- BreakpointSignal raiseRequestWith:nil errorString:nil in:con
- ]
- ]
- onExit:LeaveBreakBlock.
+ onEntry:[:con |
+ (con receiver isMemberOf:aClass) ifTrue:[
+ BreakpointSignal raiseRequestWith:nil errorString:nil in:con
+ ]
+ ]
+ onExit:LeaveBreakBlock.
"
MessageTracer trapMethod:(View compiledMethodAt:#redraw) forInstancesOf:myView.
@@ -720,26 +720,26 @@
if there is a need to trap those, use the low-level wrap-methods, and put a check into the
entry/leave blocks."
- ^ self
- wrapMethod:aMethod
- onEntry:[:con |
- |conditionFires|
-
- Error handle:[:ex |
- 'MessageTrace: error in breakpoint condition cought: ' errorPrint.
- ex description errorPrintCR.
- ] do:[
- conditionBlock numArgs == 1 ifTrue:[
- conditionFires := conditionBlock value:con
- ] ifFalse:[
- conditionFires := conditionBlock value:con value:aMethod
- ].
- ].
- conditionFires == true ifTrue:[
- BreakpointSignal raiseRequestWith:nil errorString:nil in:con
- ]
- ]
- onExit:LeaveBreakBlock.
+ ^ self
+ wrapMethod:aMethod
+ onEntry:[:con |
+ |conditionFires|
+
+ Error handle:[:ex |
+ 'MessageTrace: error in breakpoint condition caught: ' errorPrint.
+ ex description errorPrintCR.
+ ] do:[
+ conditionBlock numArgs == 1 ifTrue:[
+ conditionFires := conditionBlock value:con
+ ] ifFalse:[
+ conditionFires := conditionBlock value:con value:aMethod
+ ].
+ ].
+ conditionFires == true ifTrue:[
+ BreakpointSignal raiseRequestWith:nil errorString:nil in:con
+ ]
+ ]
+ onExit:LeaveBreakBlock.
"Created: / 18-08-2000 / 22:09:10 / cg"
"Modified: / 20-10-2010 / 09:38:57 / cg"
@@ -756,12 +756,12 @@
entry/leave blocks."
^ self wrapMethod:aMethod
- onEntry:[:con |
- (Processor activeProcess processGroupId = aProcess id) ifTrue:[
- BreakpointSignal raiseRequestWith:nil errorString:nil in:con
- ]
- ]
- onExit:LeaveBreakBlock.
+ onEntry:[:con |
+ (Processor activeProcess processGroupId = aProcess id) ifTrue:[
+ BreakpointSignal raiseRequestWith:nil errorString:nil in:con
+ ]
+ ]
+ onExit:LeaveBreakBlock.
"Created: 14.10.1996 / 15:38:46 / cg"
"Modified: 22.10.1996 / 17:40:06 / cg"
@@ -771,7 +771,7 @@
"remove any traps on any class"
Smalltalk allClassesDo:[:aClass |
- self untrapClass:aClass
+ self untrapClass:aClass
]
"
@@ -787,7 +787,7 @@
|orgClass|
aClass category == #'* trapping *' ifFalse:[
- ^ self
+ ^ self
].
orgClass := aClass superclass.
@@ -814,7 +814,7 @@
|dict|
aClass category == #'* trapping *' ifFalse:[
- ^ self
+ ^ self
].
dict := aClass methodDictionary.
@@ -823,8 +823,8 @@
ObjectMemory flushCaches. "avoid calling the old trap method"
dict size == 1 ifTrue:[
- "the last trapped method"
- ^ self untrapClass:aClass
+ "the last trapped method"
+ ^ self untrapClass:aClass
].
dict removeKey:aSelector.
aClass methodDictionary:dict.
@@ -859,7 +859,7 @@
!MessageTracer class methodsFor:'method breakpointing - new'!
-breakMethod: method atLine: line
+breakMethod: method atLine: line
"Installs new breakpoint in given method at given line.
Returns the installed breakpoint or nil if none could be
installed"
@@ -867,8 +867,8 @@
| analyzer map lines i breakpoint table |
(ConfigurableFeatures includesFeature: #VMBreakpointSupport) ifFalse:[
- self error: 'Breakpoint support not present'.
- ^nil.
+ self error: 'Breakpoint support not present'.
+ ^nil.
].
analyzer := BreakpointAnalyzer parseMethodSilent: method source in: method mclass.
@@ -876,24 +876,24 @@
lines := map keys asSortedCollection.
i := lines indexForInserting: line.
i > lines size ifTrue:[
- ^nil
+ ^nil
].
breakpoint := Breakpoint new line: (lines at: i).
breakpoint breaksToIgnore: (((map at: breakpoint line) size - 1) max: 0).
table := method breakpointTable.
table isNil ifTrue:[
- "/old way:
- "/table := Array with: (breakpoint line) with: breakpoint.
-
- "/new way:
- table := Array with: breakpoint.
+ "/old way:
+ "/table := Array with: (breakpoint line) with: breakpoint.
+
+ "/new way:
+ table := Array with: breakpoint.
] ifFalse:[
- "/old way:
- "/table := table, (Array with: (breakpoint line) with: breakpoint).
-
- "/new way:
- table := table copyWith: breakpoint
+ "/old way:
+ "/table := table, (Array with: (breakpoint line) with: breakpoint).
+
+ "/new way:
+ table := table copyWith: breakpoint
].
method breakpointTable: table.
@@ -910,26 +910,26 @@
Use unwrapMethod to remove this."
MethodCounts isNil ifTrue:[
- MethodCounts := IdentityDictionary new.
+ MethodCounts := IdentityDictionary new.
].
MethodCounts at:aMethod put:0.
^ self wrapMethod:aMethod
- onEntry:[:con |
- |cnt|
-
- cnt := MethodCounts at:aMethod ifAbsent:0.
- MethodCounts at:aMethod put:(cnt + 1).
- MessageTracer changed:#statistics: with:aMethod.
- aMethod changed:#statistics
- ]
- onExit:nil
+ onEntry:[:con |
+ |cnt|
+
+ cnt := MethodCounts at:aMethod ifAbsent:0.
+ MethodCounts at:aMethod put:(cnt + 1).
+ MessageTracer changed:#statistics: with:aMethod.
+ aMethod changed:#statistics
+ ]
+ onExit:nil
"
MessageTracer countMethod:(Integer compiledMethodAt:#factorial).
5 factorial.
- MessageTracer executionCountOf:(Integer compiledMethodAt:#factorial) printNL.
- MessageTracer stopCountingMethod:(Integer compiledMethodAt:#factorial)
+ MessageTracer executionCountOf:(Integer compiledMethodAt:#factorial) printNL.
+ MessageTracer stopCountingMethod:(Integer compiledMethodAt:#factorial)
"
"Created: / 15.12.1995 / 10:57:49 / cg"
@@ -942,28 +942,28 @@
Use unwrapMethod to remove this."
MethodCountsPerReceiverClass isNil ifTrue:[
- MethodCountsPerReceiverClass := IdentityDictionary new.
+ MethodCountsPerReceiverClass := IdentityDictionary new.
].
MethodCountsPerReceiverClass at:aMethod put:(IdentityDictionary new).
^ self wrapMethod:aMethod
- onEntry:[:con |
- |cls perMethodCounts cnt|
-
- cls := (con receiver class).
- perMethodCounts := MethodCountsPerReceiverClass at:aMethod.
- cnt := perMethodCounts at:cls ifAbsentPut:0.
- perMethodCounts at:cls put:(cnt + 1).
- MessageTracer changed:#statistics: with:aMethod.
- aMethod changed:#statistics
- ]
- onExit:nil
+ onEntry:[:con |
+ |cls perMethodCounts cnt|
+
+ cls := (con receiver class).
+ perMethodCounts := MethodCountsPerReceiverClass at:aMethod.
+ cnt := perMethodCounts at:cls ifAbsentPut:0.
+ perMethodCounts at:cls put:(cnt + 1).
+ MessageTracer changed:#statistics: with:aMethod.
+ aMethod changed:#statistics
+ ]
+ onExit:nil
"
MessageTracer countMethodWithReceiverStatistic:(Collection compiledMethodAt:#detect:).
NewSystemBrowser open.
- MessageTracer executionCountsOf:(Collection compiledMethodAt:#detect:) printNL.
- MessageTracer stopCountingMethod:(Collection compiledMethodAt:#detect:)
+ MessageTracer executionCountsOf:(Collection compiledMethodAt:#detect:) printNL.
+ MessageTracer stopCountingMethod:(Collection compiledMethodAt:#detect:)
"
!
@@ -973,20 +973,20 @@
|count counts|
MethodCounts notNil ifTrue:[
- aMethod isWrapped ifTrue:[
- count := MethodCounts at:aMethod originalMethod ifAbsent:nil.
- count notNil ifTrue:[^ count].
- ].
- ^ MethodCounts at:aMethod ifAbsent:0
+ aMethod isWrapped ifTrue:[
+ count := MethodCounts at:aMethod originalMethod ifAbsent:nil.
+ count notNil ifTrue:[^ count].
+ ].
+ ^ MethodCounts at:aMethod ifAbsent:0
].
MethodCountsPerReceiverClass notNil ifTrue:[
- aMethod isWrapped ifTrue:[
- counts := MethodCountsPerReceiverClass at:aMethod originalMethod ifAbsent:nil.
- ].
- counts isNil ifTrue:[
- counts := MethodCounts at:aMethod ifAbsent:#().
- ].
- ^ (counts collect:[:eachClassCountAssoc | eachClassCountAssoc value]) sum
+ aMethod isWrapped ifTrue:[
+ counts := MethodCountsPerReceiverClass at:aMethod originalMethod ifAbsent:nil.
+ ].
+ counts isNil ifTrue:[
+ counts := MethodCounts at:aMethod ifAbsent:#().
+ ].
+ ^ (counts collect:[:eachClassCountAssoc | eachClassCountAssoc value]) sum
].
^ 0
!
@@ -997,13 +997,13 @@
|counts|
MethodCountsPerReceiverClass notNil ifTrue:[
- aMethod isWrapped ifTrue:[
- counts := MethodCountsPerReceiverClass at:aMethod originalMethod ifAbsent:nil.
- ].
- counts isNil ifTrue:[
- counts := MethodCounts at:aMethod ifAbsent:#().
- ].
- ^ counts
+ aMethod isWrapped ifTrue:[
+ counts := MethodCountsPerReceiverClass at:aMethod originalMethod ifAbsent:nil.
+ ].
+ counts isNil ifTrue:[
+ counts := MethodCounts at:aMethod ifAbsent:#().
+ ].
+ ^ counts
].
^ #()
!
@@ -1012,9 +1012,9 @@
"return the current count"
MethodCounts notNil ifTrue:[
- aMethod isWrapped ifTrue:[
- MethodCounts at:aMethod originalMethod put:0.
- ].
+ aMethod isWrapped ifTrue:[
+ MethodCounts at:aMethod originalMethod put:0.
+ ].
].
"Created: / 30.7.1998 / 17:42:08 / cg"
@@ -1024,14 +1024,14 @@
"remove counting of aMethod"
MethodCounts notNil ifTrue:[
- aMethod isWrapped ifTrue:[
- MethodCounts removeKey:aMethod originalMethod ifAbsent:nil.
- ].
+ aMethod isWrapped ifTrue:[
+ MethodCounts removeKey:aMethod originalMethod ifAbsent:nil.
+ ].
].
MethodCountsPerReceiverClass notNil ifTrue:[
- aMethod isWrapped ifTrue:[
- MethodCountsPerReceiverClass removeKey:aMethod originalMethod ifAbsent:nil.
- ].
+ aMethod isWrapped ifTrue:[
+ MethodCountsPerReceiverClass removeKey:aMethod originalMethod ifAbsent:nil.
+ ].
].
^ self unwrapMethod:aMethod
@@ -1047,54 +1047,54 @@
|oldPriority oldScavengeCount oldNewUsed|
MethodCounts isNil ifTrue:[
- MethodCounts := IdentityDictionary new.
+ MethodCounts := IdentityDictionary new.
].
MethodMemoryUsage isNil ifTrue:[
- MethodMemoryUsage := IdentityDictionary new.
+ MethodMemoryUsage := IdentityDictionary new.
].
MethodCounts at:aMethod put:0.
MethodMemoryUsage at:aMethod put:0.
^ self wrapMethod:aMethod
- onEntry:[:con |
- oldPriority := Processor activeProcess changePriority:(Processor userInterruptPriority).
- oldNewUsed := ObjectMemory newSpaceUsed.
- oldScavengeCount := ObjectMemory scavengeCount.
- ]
- onExit:[:con :retVal |
- |cnt memUse scavenges|
-
- memUse := ObjectMemory newSpaceUsed - oldNewUsed.
- scavenges := ObjectMemory scavengeCount - oldScavengeCount.
- scavenges ~= 0 ifTrue:[
- memUse := memUse + (ObjectMemory newSpaceSize * scavenges)
- ].
-
- MethodCounts notNil ifTrue:[
- cnt := MethodCounts at:aMethod ifAbsent:0.
- MethodCounts at:aMethod put:(cnt + 1).
- ].
- MethodMemoryUsage notNil ifTrue:[
- cnt := MethodMemoryUsage at:aMethod ifAbsent:0.
- MethodMemoryUsage at:aMethod put:(cnt + memUse).
- ].
- Processor activeProcess priority:oldPriority.
- MessageTracer changed:#statistics: with:aMethod.
- aMethod changed:#statistics.
- retVal
- ]
- onUnwind:[
- oldPriority notNil ifTrue:[
- Processor activeProcess priority:oldPriority
- ]
- ]
+ onEntry:[:con |
+ oldPriority := Processor activeProcess changePriority:(Processor userInterruptPriority).
+ oldNewUsed := ObjectMemory newSpaceUsed.
+ oldScavengeCount := ObjectMemory scavengeCount.
+ ]
+ onExit:[:con :retVal |
+ |cnt memUse scavenges|
+
+ memUse := ObjectMemory newSpaceUsed - oldNewUsed.
+ scavenges := ObjectMemory scavengeCount - oldScavengeCount.
+ scavenges ~= 0 ifTrue:[
+ memUse := memUse + (ObjectMemory newSpaceSize * scavenges)
+ ].
+
+ MethodCounts notNil ifTrue:[
+ cnt := MethodCounts at:aMethod ifAbsent:0.
+ MethodCounts at:aMethod put:(cnt + 1).
+ ].
+ MethodMemoryUsage notNil ifTrue:[
+ cnt := MethodMemoryUsage at:aMethod ifAbsent:0.
+ MethodMemoryUsage at:aMethod put:(cnt + memUse).
+ ].
+ Processor activeProcess priority:oldPriority.
+ MessageTracer changed:#statistics: with:aMethod.
+ aMethod changed:#statistics.
+ retVal
+ ]
+ onUnwind:[
+ oldPriority notNil ifTrue:[
+ Processor activeProcess priority:oldPriority
+ ]
+ ]
"
MessageTracer countMemoryUsageOfMethod:(Integer compiledMethodAt:#factorialR).
3 factorialR.
- Transcript showCR:(MessageTracer memoryUsageOfMethod:(Integer compiledMethodAt:#factorialR)).
- MessageTracer stopCountingMemoryUsageOfMethod:(Integer compiledMethodAt:#factorialR)
+ Transcript showCR:(MessageTracer memoryUsageOfMethod:(Integer compiledMethodAt:#factorialR)).
+ MessageTracer stopCountingMemoryUsageOfMethod:(Integer compiledMethodAt:#factorialR)
"
"Created: / 18.12.1995 / 15:41:27 / stefan"
@@ -1122,13 +1122,13 @@
(MethodCounts isNil or:[MethodMemoryUsage isNil]) ifTrue:[^ 0].
aMethod isWrapped ifTrue:[
- orgMethod := aMethod originalMethod.
- count := MethodCounts at:orgMethod ifAbsent:nil.
- memUse := MethodMemoryUsage at:orgMethod ifAbsent:nil.
+ orgMethod := aMethod originalMethod.
+ count := MethodCounts at:orgMethod ifAbsent:nil.
+ memUse := MethodMemoryUsage at:orgMethod ifAbsent:nil.
].
memUse isNil ifTrue:[
- count := MethodCounts at:aMethod ifAbsent:0.
- memUse := MethodMemoryUsage at:aMethod ifAbsent:0.
+ count := MethodCounts at:aMethod ifAbsent:0.
+ memUse := MethodMemoryUsage at:aMethod ifAbsent:0.
].
count = 0 ifTrue:[^ 0].
^ memUse//count
@@ -1142,13 +1142,13 @@
|orgMethod|
MethodCounts notNil ifTrue:[
- MethodMemoryUsage notNil ifTrue:[
- aMethod isWrapped ifTrue:[
- orgMethod := aMethod originalMethod.
- MethodCounts at:orgMethod put:0.
- MethodMemoryUsage at:orgMethod put:nil.
- ]
- ].
+ MethodMemoryUsage notNil ifTrue:[
+ aMethod isWrapped ifTrue:[
+ orgMethod := aMethod originalMethod.
+ MethodCounts at:orgMethod put:0.
+ MethodMemoryUsage at:orgMethod put:nil.
+ ]
+ ].
].
"Created: / 30.7.1998 / 17:43:07 / cg"
@@ -1160,13 +1160,13 @@
|orgMethod|
MethodCounts notNil ifTrue:[
- MethodMemoryUsage notNil ifTrue:[
- aMethod isWrapped ifTrue:[
- orgMethod := aMethod originalMethod.
- MethodCounts removeKey:orgMethod ifAbsent:nil.
- MethodMemoryUsage removeKey:orgMethod ifAbsent:nil.
- ]
- ].
+ MethodMemoryUsage notNil ifTrue:[
+ aMethod isWrapped ifTrue:[
+ orgMethod := aMethod originalMethod.
+ MethodCounts removeKey:orgMethod ifAbsent:nil.
+ MethodMemoryUsage removeKey:orgMethod ifAbsent:nil.
+ ]
+ ].
].
^ self unwrapMethod:aMethod
@@ -1181,9 +1181,9 @@
|info|
MethodTiming notNil ifTrue:[
- aMethod isWrapped ifTrue:[
- info := ( MethodTiming at:(aMethod originalMethod) ifAbsent:nil ) copy.
- ].
+ aMethod isWrapped ifTrue:[
+ info := ( MethodTiming at:(aMethod originalMethod) ifAbsent:nil ) copy.
+ ].
].
info isNil ifTrue:[ info := MethodTimingInfo new ].
@@ -1198,10 +1198,10 @@
the method remains wrapped."
MethodTiming notNil ifTrue:[
- MethodTiming removeKey:aMethod.
- aMethod isWrapped ifTrue:[
- MethodTiming removeKey:aMethod originalMethod.
- ].
+ MethodTiming removeKey:aMethod.
+ aMethod isWrapped ifTrue:[
+ MethodTiming removeKey:aMethod originalMethod.
+ ].
].
"Created: / 30-07-1998 / 17:12:35 / cg"
@@ -1224,47 +1224,47 @@
|t0|
MethodTiming isNil ifTrue:[
- MethodTiming := IdentityDictionary new.
+ MethodTiming := IdentityDictionary new.
].
MethodTiming removeKey:aMethod ifAbsent:nil.
TimeForWrappers isNil ifTrue:[
- self getTimeForWrappers
+ self getTimeForWrappers
].
^ self wrapMethod:aMethod
- onEntry:[:con |
- t0 := OperatingSystem getMicrosecondTime.
- ]
- onExit:[:con :retVal |
- |info t cnt minT maxT sumTimes|
-
- t := OperatingSystem getMicrosecondTime - t0.
- t := t - TimeForWrappers.
- t < 0 ifTrue:[t := 0].
- t := t / 1000.0.
-
- MethodTiming isNil ifTrue:[
- MethodTiming := IdentityDictionary new.
- ].
- info := MethodTiming at:aMethod ifAbsent:nil.
- info isNil ifTrue:[
- MethodTiming at:aMethod put:(info := MethodTimingInfo new)
- ] ifFalse:[
- info rememberExecutionTime:t.
- ].
- MessageTracer changed:#statistics: with:aMethod.
- aMethod changed:#statistics.
- retVal
- ]
+ onEntry:[:con |
+ t0 := OperatingSystem getMicrosecondTime.
+ ]
+ onExit:[:con :retVal |
+ |info t cnt minT maxT sumTimes|
+
+ t := OperatingSystem getMicrosecondTime - t0.
+ t := t - TimeForWrappers.
+ t < 0 ifTrue:[t := 0].
+ t := t / 1000.0.
+
+ MethodTiming isNil ifTrue:[
+ MethodTiming := IdentityDictionary new.
+ ].
+ info := MethodTiming at:aMethod ifAbsent:nil.
+ info isNil ifTrue:[
+ MethodTiming at:aMethod put:(info := MethodTimingInfo new)
+ ] ifFalse:[
+ info rememberExecutionTime:t.
+ ].
+ MessageTracer changed:#statistics: with:aMethod.
+ aMethod changed:#statistics.
+ retVal
+ ]
"
MessageTracer timeMethod:(Integer compiledMethodAt:#factorial).
5 factorial.
5 factorial.
5 factorial.
- (MessageTracer executionTimesOfMethod:(Integer compiledMethodAt:#factorial)) printCR.
- MessageTracer stopTimingMethod:(Integer compiledMethodAt:#factorial)
+ (MessageTracer executionTimesOfMethod:(Integer compiledMethodAt:#factorial)) printCR.
+ MessageTracer stopTimingMethod:(Integer compiledMethodAt:#factorial)
"
"Created: / 17-06-1996 / 17:03:50 / cg"
@@ -1282,18 +1282,18 @@
"
MessageTracer traceClass:Integer selector:#factorial.
5 factorial.
- MessageTracer untraceClass:Integer
+ MessageTracer untraceClass:Integer
"
"
MessageTracer traceClass:SequenceableCollection selector:#quickSortFrom:to:.
#(6 1 9 66 2 17) copy sort.
- MessageTracer untraceClass:SequenceableCollection
+ MessageTracer untraceClass:SequenceableCollection
"
"
MessageTracer traceClass:Array selector:#at:.
MessageTracer traceClass:Array selector:#at:put:.
#(6 1 9 66 2 17) copy sort.
- MessageTracer untraceClass:Array
+ MessageTracer untraceClass:Array
"
!
@@ -1306,18 +1306,18 @@
"
MessageTracer traceClass:Integer selector:#factorial on:Transcript.
5 factorial.
- MessageTracer untraceClass:Integer
+ MessageTracer untraceClass:Integer
"
"
MessageTracer traceClass:Integer selector:#factorialR on:Transcript.
5 factorialR.
- MessageTracer untraceClass:Integer
+ MessageTracer untraceClass:Integer
"
!
traceMethod:aMethod
- "arrange for a trace message to be output on Stderr,
+ "arrange for a trace message to be output on Stderr,
when aMethod is executed. Traces both entry and exit.
Use unwrapMethod to remove this."
@@ -1326,17 +1326,17 @@
"
MessageTracer traceMethod:(Integer compiledMethodAt:#factorial).
5 factorial.
- MessageTracer untraceMethod:(Integer compiledMethodAt:#factorial)
+ MessageTracer untraceMethod:(Integer compiledMethodAt:#factorial)
"
"
MessageTracer traceMethod:(Integer compiledMethodAt:#factorialR).
5 factorialR.
- MessageTracer untraceMethod:(Integer compiledMethodAt:#factorialR)
+ MessageTracer untraceMethod:(Integer compiledMethodAt:#factorialR)
"
"
MessageTracer traceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
#(6 1 9 66 2 17) copy sort.
- MessageTracer untraceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
+ MessageTracer untraceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
"
"
dont do this:
@@ -1351,52 +1351,52 @@
!
traceMethod:aMethod on:aStream
- "arrange for a trace message to be output on aStream,
+ "arrange for a trace message to be output on aStream,
when aMethod is executed. Traces both entry and exit.
Use unwrapMethod to remove this."
|lvl inside|
^ self wrapMethod:aMethod
- onEntry:[:con |
- inside isNil ifTrue:[
- inside := true.
- CallingLevel isNil ifTrue:[
- CallingLevel := 0.
- ].
- lvl notNil ifTrue:[
- lvl := lvl + 1
- ] ifFalse:[
- CallingLevel := lvl := CallingLevel + 1.
- ].
- MessageTracer printEntryFull:con level:lvl on:aStream.
- inside := nil
- ]
- ]
- onExit:[:con :retVal |
- inside isNil ifTrue:[
- inside := true.
- MessageTracer printExit:con with:retVal level:lvl on:aStream.
- CallingLevel := lvl := lvl - 1.
- inside := nil
- ].
- retVal
- ]
+ onEntry:[:con |
+ inside isNil ifTrue:[
+ inside := true.
+ CallingLevel isNil ifTrue:[
+ CallingLevel := 0.
+ ].
+ lvl notNil ifTrue:[
+ lvl := lvl + 1
+ ] ifFalse:[
+ CallingLevel := lvl := CallingLevel + 1.
+ ].
+ MessageTracer printEntryFull:con level:lvl on:aStream.
+ inside := nil
+ ]
+ ]
+ onExit:[:con :retVal |
+ inside isNil ifTrue:[
+ inside := true.
+ MessageTracer printExit:con with:retVal level:lvl on:aStream.
+ CallingLevel := lvl := lvl - 1.
+ inside := nil
+ ].
+ retVal
+ ]
"
MessageTracer traceMethod:(Integer compiledMethodAt:#factorial) on:Transcript.
5 factorial.
- MessageTracer untraceMethod:(Integer compiledMethodAt:#factorial)
+ MessageTracer untraceMethod:(Integer compiledMethodAt:#factorial)
"
"
MessageTracer traceMethod:(Integer compiledMethodAt:#factorialR) on:Transcript.
5 factorialR.
- MessageTracer untraceMethod:(Integer compiledMethodAt:#factorialR)
+ MessageTracer untraceMethod:(Integer compiledMethodAt:#factorialR)
"
"
MessageTracer traceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:) on:Transcript.
#(6 1 9 66 2 17) copy sort.
- MessageTracer untraceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
+ MessageTracer untraceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
"
!
@@ -1408,14 +1408,14 @@
The trace output is a low level trace generated in the VM."
^ self wrapMethod:aMethod
- onEntry:[:con | ObjectMemory flushCaches. ObjectMemory sendTraceOn.]
- onExit:[:con :retVal | ObjectMemory sendTraceOff. retVal]
+ onEntry:[:con | ObjectMemory flushCaches. ObjectMemory sendTraceOn.]
+ onExit:[:con :retVal | ObjectMemory sendTraceOff. retVal]
"Modified: / 31.7.1998 / 16:40:07 / cg"
!
traceMethodEntry:aMethod
- "arrange for a trace message to be output on stdErr,
+ "arrange for a trace message to be output on stdErr,
when aMethod is executed. Only entry is traced.
Use unwrapMethod to remove this."
@@ -1424,59 +1424,59 @@
"
MessageTracer traceMethodEntry:(Integer compiledMethodAt:#factorial).
5 factorial.
- MessageTracer untraceMethod:(Integer compiledMethodAt:#factorial)
+ MessageTracer untraceMethod:(Integer compiledMethodAt:#factorial)
"
"
MessageTracer traceMethodEntry:(Integer compiledMethodAt:#factorialR).
5 factorialR.
- MessageTracer untraceMethod:(Integer compiledMethodAt:#factorialR)
+ MessageTracer untraceMethod:(Integer compiledMethodAt:#factorialR)
"
"
MessageTracer traceMethodEntry:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
#(6 1 9 66 2 17) copy sort.
- MessageTracer untraceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
+ MessageTracer untraceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
"
!
traceMethodEntry:aMethod on:aStream
- "arrange for a trace message to be output on aStream,
+ "arrange for a trace message to be output on aStream,
when aMethod is executed. Only entry is traced.
Use unwrapMethod to remove this."
|lvl inside|
^ self wrapMethod:aMethod
- onEntry:[:con |
- inside isNil ifTrue:[
- inside := true.
- CallingLevel isNil ifTrue:[
- CallingLevel := 0.
- ].
- lvl notNil ifTrue:[
- lvl := lvl + 1
- ] ifFalse:[
- CallingLevel := lvl := CallingLevel + 1.
- ].
- MessageTracer printEntryFull:con level:lvl on:aStream.
- inside := nil
- ]
- ]
- onExit:nil
+ onEntry:[:con |
+ inside isNil ifTrue:[
+ inside := true.
+ CallingLevel isNil ifTrue:[
+ CallingLevel := 0.
+ ].
+ lvl notNil ifTrue:[
+ lvl := lvl + 1
+ ] ifFalse:[
+ CallingLevel := lvl := CallingLevel + 1.
+ ].
+ MessageTracer printEntryFull:con level:lvl on:aStream.
+ inside := nil
+ ]
+ ]
+ onExit:nil
"
MessageTracer traceMethodEntry:(Integer compiledMethodAt:#factorial) on:Transcript.
5 factorial.
- MessageTracer untraceMethod:(Integer compiledMethodAt:#factorial)
+ MessageTracer untraceMethod:(Integer compiledMethodAt:#factorial)
"
"
MessageTracer traceMethodEntry:(Integer compiledMethodAt:#factorialR) on:Transcript.
5 factorialR.
- MessageTracer untraceMethod:(Integer compiledMethodAt:#factorialR)
+ MessageTracer untraceMethod:(Integer compiledMethodAt:#factorialR)
"
"
MessageTracer traceMethodEntry:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:) on:Transcript.
#(6 1 9 66 2 17) copy sort.
- MessageTracer untraceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
+ MessageTracer untraceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
"
!
@@ -1496,17 +1496,17 @@
Only the sender is traced on entry.
Use untraceMethod to remove this trace."
- ^ self
- wrapMethod:aMethod
- onEntry:(self traceFullBlockFor:aStream)
- onExit:LeaveTraceBlock.
+ ^ self
+ wrapMethod:aMethod
+ onEntry:(self traceFullBlockFor:aStream)
+ onExit:LeaveTraceBlock.
"Created: 15.12.1995 / 18:19:31 / cg"
"Modified: 22.10.1996 / 17:39:28 / cg"
!
traceMethodSender:aMethod
- "arrange for a trace message to be output on Stderr,
+ "arrange for a trace message to be output on Stderr,
when amethod is executed.
Only the sender is traced on entry.
Use untraceMethod to remove this trace."
@@ -1519,17 +1519,17 @@
Only the sender is traced on entry.
Use untraceMethod to remove this trace."
- ^ self
- wrapMethod:aMethod
- onEntry:(self traceSenderBlockFor:aStream)
- onExit:LeaveTraceBlock.
+ ^ self
+ wrapMethod:aMethod
+ onEntry:(self traceSenderBlockFor:aStream)
+ onExit:LeaveTraceBlock.
"Modified: 22.10.1996 / 17:39:33 / cg"
!
traceUpdateMethod:aMethod on:aStream
- "arrange for a trace message to be output on aStream,
- when aMethod is executed.
+ "arrange for a trace message to be output on aStream,
+ when aMethod is executed.
Traces both entry and exit.
Use unwrapMethod to remove this.
This one is specialized for change-update calling i.e. it traces from the update
@@ -1537,32 +1537,32 @@
|lvl inside|
- ^ self
- wrapMethod:aMethod
- onEntry:[:con |
- inside isNil ifTrue:[
- inside := true.
- CallingLevel isNil ifTrue:[
- CallingLevel := 0.
- ].
- lvl notNil ifTrue:[
- lvl := lvl + 1
- ] ifFalse:[
- CallingLevel := lvl := CallingLevel + 1.
- ].
- MessageTracer printUpdateEntryFull:con level:lvl on:aStream.
- inside := nil
- ]
- ]
- onExit:[:con :retVal |
- inside isNil ifTrue:[
- inside := true.
- MessageTracer printExit:con with:retVal level:lvl on:aStream.
- CallingLevel := lvl := lvl - 1.
- inside := nil
- ].
- retVal
- ]
+ ^ self
+ wrapMethod:aMethod
+ onEntry:[:con |
+ inside isNil ifTrue:[
+ inside := true.
+ CallingLevel isNil ifTrue:[
+ CallingLevel := 0.
+ ].
+ lvl notNil ifTrue:[
+ lvl := lvl + 1
+ ] ifFalse:[
+ CallingLevel := lvl := CallingLevel + 1.
+ ].
+ MessageTracer printUpdateEntryFull:con level:lvl on:aStream.
+ inside := nil
+ ]
+ ]
+ onExit:[:con :retVal |
+ inside isNil ifTrue:[
+ inside := true.
+ MessageTracer printExit:con with:retVal level:lvl on:aStream.
+ CallingLevel := lvl := lvl - 1.
+ inside := nil
+ ].
+ retVal
+ ]
!
tracelogMethod:aMethod
@@ -1573,49 +1573,49 @@
|lvl inside|
^ self wrapMethod:aMethod
- onEntry:[:con |
- | msg |
- inside isNil ifTrue:[
- inside := true.
- CallingLevel isNil ifTrue:[
- CallingLevel := 0.
- ].
- lvl notNil ifTrue:[
- lvl := lvl + 1
- ] ifFalse:[
- CallingLevel := lvl := CallingLevel + 1.
- ].
- msg := String streamContents:[:s|MessageTracer printEntryFull:con level:lvl on:s].
- Logger log: msg severity: #trace attachment: con args.
- inside := nil
- ]
- ]
- onExit:[:con :retVal |
- | msg |
- inside isNil ifTrue:[
- inside := true.
- msg := String streamContents:[:s|MessageTracer printExit:con with:retVal level:lvl on:s].
- Logger log: msg severity: #trace attachment: retVal.
- CallingLevel := lvl := lvl - 1.
- inside := nil
- ].
- retVal
- ]
+ onEntry:[:con |
+ | msg |
+ inside isNil ifTrue:[
+ inside := true.
+ CallingLevel isNil ifTrue:[
+ CallingLevel := 0.
+ ].
+ lvl notNil ifTrue:[
+ lvl := lvl + 1
+ ] ifFalse:[
+ CallingLevel := lvl := CallingLevel + 1.
+ ].
+ msg := String streamContents:[:s|MessageTracer printEntryFull:con level:lvl on:s].
+ Logger log: msg severity: #trace attachment: con args.
+ inside := nil
+ ]
+ ]
+ onExit:[:con :retVal |
+ | msg |
+ inside isNil ifTrue:[
+ inside := true.
+ msg := String streamContents:[:s|MessageTracer printExit:con with:retVal level:lvl on:s].
+ Logger log: msg severity: #trace attachment: retVal.
+ CallingLevel := lvl := lvl - 1.
+ inside := nil
+ ].
+ retVal
+ ]
"
MessageTracer traceMethod:(Integer compiledMethodAt:#factorial) on:Transcript.
5 factorial.
- MessageTracer untraceMethod:(Integer compiledMethodAt:#factorial)
+ MessageTracer untraceMethod:(Integer compiledMethodAt:#factorial)
"
"
MessageTracer traceMethod:(Integer compiledMethodAt:#factorialR) on:Transcript.
5 factorialR.
- MessageTracer untraceMethod:(Integer compiledMethodAt:#factorialR)
+ MessageTracer untraceMethod:(Integer compiledMethodAt:#factorialR)
"
"
MessageTracer traceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:) on:Transcript.
#(6 1 9 66 2 17) copy sort.
- MessageTracer untraceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
+ MessageTracer untraceMethod:(SequenceableCollection compiledMethodAt:#quickSortFrom:to:).
"
"Created: / 15-03-2013 / 11:04:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -1637,8 +1637,8 @@
on them; this removes them all"
WrappedMethod allInstancesDo:[:aWrapperMethod |
- aWrapperMethod unregister.
- self unwrapMethod:aWrapperMethod.
+ aWrapperMethod unregister.
+ self unwrapMethod:aWrapperMethod.
]
"
@@ -1648,41 +1648,41 @@
"Modified: / 01-07-2011 / 10:02:47 / cg"
!
-unwrapMethod:aMethod
+unwrapMethod:aMethod
"remove any wrapper on aMethod"
|selector class originalMethod dict mthd|
aMethod isWrapped ifTrue:[
- originalMethod := aMethod originalMethod.
+ originalMethod := aMethod originalMethod.
].
MethodCounts notNil ifTrue:[
- aMethod isWrapped ifTrue:[
- MethodCounts removeKey:originalMethod ifAbsent:nil.
- ].
- MethodCounts removeKey:aMethod ifAbsent:nil.
- MethodCounts := MethodCounts asNilIfEmpty.
+ aMethod isWrapped ifTrue:[
+ MethodCounts removeKey:originalMethod ifAbsent:nil.
+ ].
+ MethodCounts removeKey:aMethod ifAbsent:nil.
+ MethodCounts := MethodCounts asNilIfEmpty.
].
MethodMemoryUsage notNil ifTrue:[
- aMethod isWrapped ifTrue:[
- MethodMemoryUsage removeKey:originalMethod ifAbsent:nil.
- ].
- MethodMemoryUsage removeKey:aMethod ifAbsent:nil.
- MethodMemoryUsage := MethodMemoryUsage asNilIfEmpty.
+ aMethod isWrapped ifTrue:[
+ MethodMemoryUsage removeKey:originalMethod ifAbsent:nil.
+ ].
+ MethodMemoryUsage removeKey:aMethod ifAbsent:nil.
+ MethodMemoryUsage := MethodMemoryUsage asNilIfEmpty.
].
MethodTiming notNil ifTrue:[
- aMethod isWrapped ifTrue:[
- MethodTiming removeKey:originalMethod ifAbsent:nil.
- ].
- MethodTiming removeKey:aMethod ifAbsent:nil.
- MethodTiming := MethodTiming asNilIfEmpty.
+ aMethod isWrapped ifTrue:[
+ MethodTiming removeKey:originalMethod ifAbsent:nil.
+ ].
+ MethodTiming removeKey:aMethod ifAbsent:nil.
+ MethodTiming := MethodTiming asNilIfEmpty.
].
CallingLevel := 0.
(aMethod isNil or:[aMethod isWrapped not]) ifTrue:[
- ^ aMethod
+ ^ aMethod
].
"
@@ -1690,33 +1690,33 @@
"
class := aMethod containingClass.
class isNil ifTrue:[
- 'MessageTracer [info]: no containing class for method found' infoPrintCR.
- ^ aMethod
+ 'MessageTracer [info]: no containing class for method found' infoPrintCR.
+ ^ aMethod
].
selector := class selectorAtMethod:aMethod.
originalMethod isNil ifTrue:[
- self error:'oops, could not find original method' mayProceed:true.
- ^ aMethod
+ self error:'oops, could not find original method' mayProceed:true.
+ ^ aMethod
].
dict := class methodDictionary.
mthd := dict at:selector ifAbsent:nil.
mthd notNil ifTrue:[
- dict at:selector put:originalMethod.
- class methodDictionary:dict.
+ dict at:selector put:originalMethod.
+ class methodDictionary:dict.
] ifFalse:[
- 'MessageTracer [info]: no containing class for method found' infoPrintCR.
+ 'MessageTracer [info]: no containing class for method found' infoPrintCR.
"/ self halt:'oops, unexpected error - cannot remove wrap'.
- aMethod becomeSameAs:originalMethod.
- ^ aMethod
+ aMethod becomeSameAs:originalMethod.
+ ^ aMethod
].
ObjectMemory flushCaches.
class changed:#methodTrap with:selector. "/ tell browsers
- MethodTrapChangeNotificationParameter notNil ifTrue:[
- Smalltalk changed:#methodTrap with:(MethodTrapChangeNotificationParameter changeClass:class changeSelector:selector).
+ MethodTrapChangeNotificationParameter notNil ifTrue:[
+ Smalltalk changed:#methodTrap with:(MethodTrapChangeNotificationParameter changeClass:class changeSelector:selector).
].
^ originalMethod
@@ -1732,9 +1732,9 @@
wrapMethod:aMethod onEntry:entryBlock onExit:exitBlock onUnwind:unwindBlock
"arrange for the two blocks entryBlock and exitBlock to be evaluated whenever
- aMethod is evaluated.
- EntryBlock will be called on entry, and gets the current context passed as argument.
- ExitBlock will be called, when the method is left, and gets the context and
+ aMethod is evaluated.
+ EntryBlock will be called on entry, and gets the current context passed as argument.
+ ExitBlock will be called, when the method is left, and gets the context and
the methods return value as arguments.
UnwindBlock will be called when the contxt of aMethod is unwound.
If there is an unwindBlock, the entry and exitBlocks will be called within the unwind block,
@@ -1750,10 +1750,10 @@
but only if not already being trapped.
"
(aMethod isNil or:[aMethod isWrapped]) ifTrue:[
- ^ aMethod
+ ^ aMethod
].
aMethod isLazyMethod ifTrue:[
- aMethod makeRealMethod
+ aMethod makeRealMethod
].
"
@@ -1761,8 +1761,8 @@
"
class := aMethod containingClass.
class isNil ifTrue:[
- self error:'cannot place trap (no containing class found)' mayProceed:true.
- ^ aMethod
+ self error:'cannot place trap (no containing class found)' mayProceed:true.
+ ^ aMethod
].
selector := class selectorAtMethod:aMethod.
@@ -1773,7 +1773,7 @@
"
xselector := '_x'.
aMethod numArgs timesRepeat:[
- xselector := xselector , '_:'
+ xselector := xselector , '_:'
].
spec := Parser methodSpecificationForSelector:xselector.
@@ -1786,47 +1786,47 @@
s nextPutAll:' |retVal context| '.
s nextPutAll:' context := thisContext.'.
unwindBlock notNil ifTrue:[
- s nextPutAll:'['.
+ s nextPutAll:'['.
].
entryBlock notNil ifTrue:[
- s nextPutAll:'#entryBlock yourself value:context. '.
+ s nextPutAll:'#entryBlock yourself value:context. '.
].
s nextPutAll:'retVal := #originalMethod yourself';
- nextPutAll: ' valueWithReceiver:(context receiver)';
+ nextPutAll: ' valueWithReceiver:(context receiver)';
nextPutAll: ' arguments:(context args)';
- nextPutAll: ' selector:(context selector)';
+ nextPutAll: ' selector:(context selector)';
nextPutAll: ' search:(context searchClass)';
nextPutAll: ' sender:nil. '.
exitBlock notNil ifTrue:[
- s nextPutAll:'^ #exitBlock yourself value:context value:retVal.'.
+ s nextPutAll:'^ #exitBlock yourself value:context value:retVal.'.
].
unwindBlock notNil ifTrue:[
- s nextPutAll:'] ifCurtailed:#unwindBlock yourself.'.
+ s nextPutAll:'] ifCurtailed:#unwindBlock yourself.'.
].
s nextPutAll:'^ retVal'; cr.
src := s contents.
saveUS := Compiler allowUnderscoreInIdentifier.
- ParserFlags
- withSTCCompilation:#never
- do:[
- [
- Compiler allowUnderscoreInIdentifier:true.
- Class withoutUpdatingChangesDo:[
- trapMethod := Compiler
- compile:src
- forClass:UndefinedObject
- inCategory:aMethod category
- notifying:nil
- install:false
- skipIfSame:false
- silent:false. "/ true.
- ]
- ] ensure:[
- Compiler allowUnderscoreInIdentifier:saveUS.
- ].
- ].
+ ParserFlags
+ withSTCCompilation:#never
+ do:[
+ [
+ Compiler allowUnderscoreInIdentifier:true.
+ Class withoutUpdatingChangesDo:[
+ trapMethod := Compiler
+ compile:src
+ forClass:UndefinedObject
+ inCategory:aMethod category
+ notifying:nil
+ install:false
+ skipIfSame:false
+ silent:false. "/ true.
+ ]
+ ] ensure:[
+ Compiler allowUnderscoreInIdentifier:saveUS.
+ ].
+ ].
trapMethod setPackage:aMethod package.
trapMethod changeClassTo:WrappedMethod.
@@ -1836,14 +1836,14 @@
raising our eyebrows here ...
"
entryBlock notNil ifTrue:[
- trapMethod changeLiteral:#entryBlock to:entryBlock.
+ trapMethod changeLiteral:#entryBlock to:entryBlock.
].
trapMethod changeLiteral:#originalMethod to:aMethod.
exitBlock notNil ifTrue:[
- trapMethod changeLiteral:#exitBlock to:exitBlock.
+ trapMethod changeLiteral:#exitBlock to:exitBlock.
].
unwindBlock notNil ifTrue:[
- trapMethod changeLiteral:#unwindBlock to:unwindBlock.
+ trapMethod changeLiteral:#unwindBlock to:unwindBlock.
].
"
change the source of this new method
@@ -1855,8 +1855,8 @@
dict := class methodDictionary.
sel := dict at:selector ifAbsent:[0].
sel == 0 ifTrue:[
- self error:'oops, unexpected error' mayProceed:true.
- ^ aMethod
+ self error:'oops, unexpected error' mayProceed:true.
+ ^ aMethod
].
dict at:selector put:trapMethod.
@@ -1864,62 +1864,62 @@
ObjectMemory flushCaches.
class changed:#methodTrap with:selector. "/ tell browsers
- MethodTrapChangeNotificationParameter notNil ifTrue:[
- Smalltalk changed:#methodTrap with:(MethodTrapChangeNotificationParameter changeClass:class changeSelector:selector).
+ MethodTrapChangeNotificationParameter notNil ifTrue:[
+ Smalltalk changed:#methodTrap with:(MethodTrapChangeNotificationParameter changeClass:class changeSelector:selector).
].
^ trapMethod
"
- MessageTracer
- wrapMethod:(Point compiledMethodAt:#scaleBy:)
- onEntry:nil
- onExit:[:con :retVal |
- Transcript show:'leave Point>>scaleBy:; returning:'.
- Transcript showCR:retVal printString.
- Transcript endEntry
- ].
- (1@2) scaleBy:5.
- MessageTracer unwrapMethod:(Point compiledMethodAt:#scaleBy:).
- (1@2) scaleBy:5.
+ MessageTracer
+ wrapMethod:(Point compiledMethodAt:#scaleBy:)
+ onEntry:nil
+ onExit:[:con :retVal |
+ Transcript show:'leave Point>>scaleBy:; returning:'.
+ Transcript showCR:retVal printString.
+ Transcript endEntry
+ ].
+ (1@2) scaleBy:5.
+ MessageTracer unwrapMethod:(Point compiledMethodAt:#scaleBy:).
+ (1@2) scaleBy:5.
"
"
- MessageTracer
- wrapMethod:(Integer compiledMethodAt:#factorial)
- onEntry:[:con |
- Transcript showCR:('entering ' , con receiver printString , '>>factorial').
- ]
- onExit:[:con :retVal |
- Transcript show:'leave Integer>>factorial; returning:'.
- Transcript showCR:retVal printString.
- Transcript endEntry
- ].
+ MessageTracer
+ wrapMethod:(Integer compiledMethodAt:#factorial)
+ onEntry:[:con |
+ Transcript showCR:('entering ' , con receiver printString , '>>factorial').
+ ]
+ onExit:[:con :retVal |
+ Transcript show:'leave Integer>>factorial; returning:'.
+ Transcript showCR:retVal printString.
+ Transcript endEntry
+ ].
Transcript showCR:'5 factorial traced'.
- 5 factorial.
- MessageTracer unwrapMethod:(Integer compiledMethodAt:#factorial).
+ 5 factorial.
+ MessageTracer unwrapMethod:(Integer compiledMethodAt:#factorial).
Transcript showCR:'5 factorial normal'.
- 5 factorial.
+ 5 factorial.
"
"
|lvl|
lvl := 0.
- MessageTracer
- wrapMethod:(Integer compiledMethodAt:#factorial)
- onEntry:[:con |
- Transcript spaces:lvl. lvl := lvl + 2.
- Transcript showCR:('entering ' , con receiver printString , '>>factorial').
- ]
- onExit:[:con :retVal |
- lvl := lvl - 2. Transcript spaces:lvl.
- Transcript show:('leave ' , con receiver printString , '>>factorial; returning:').
- Transcript showCR:retVal printString.
- Transcript endEntry
- ].
+ MessageTracer
+ wrapMethod:(Integer compiledMethodAt:#factorial)
+ onEntry:[:con |
+ Transcript spaces:lvl. lvl := lvl + 2.
+ Transcript showCR:('entering ' , con receiver printString , '>>factorial').
+ ]
+ onExit:[:con :retVal |
+ lvl := lvl - 2. Transcript spaces:lvl.
+ Transcript show:('leave ' , con receiver printString , '>>factorial; returning:').
+ Transcript showCR:retVal printString.
+ Transcript endEntry
+ ].
Transcript showCR:'5 factorial traced'.
- 5 factorial.
- MessageTracer unwrapMethod:(Integer compiledMethodAt:#factorial).
+ 5 factorial.
+ MessageTracer unwrapMethod:(Integer compiledMethodAt:#factorial).
Transcript showCR:'5 factorial normal'.
- 5 factorial.
+ 5 factorial.
"
"Modified: / 25-06-1996 / 22:04:51 / stefan"
@@ -1938,20 +1938,20 @@
"return anObjects real class"
(anObject class category == #'* trapping *') ifFalse:[
- ^ anObject class
+ ^ anObject class
].
^ anObject class superclass
!
trap:anObject selector:aSelector
- "arrange for the debugger to be entered when a message with aSelector is
+ "arrange for the debugger to be entered when a message with aSelector is
sent to anObject. Use untrap to remove this trap.
The current implementation does not allow integers or nil to be trapped."
self wrap:anObject
- selector:aSelector
- onEntry:BreakBlock
- onExit:LeaveBreakBlock.
+ selector:aSelector
+ onEntry:BreakBlock
+ onExit:LeaveBreakBlock.
"
|p|
@@ -1966,9 +1966,9 @@
trap:anObject selectors:aCollection
self wrap:anObject
- selectors:aCollection
- onEntry:BreakBlock
- onExit:LeaveBreakBlock.
+ selectors:aCollection
+ onEntry:BreakBlock
+ onExit:LeaveBreakBlock.
"Modified: 22.10.1996 / 17:39:50 / cg"
!
@@ -1977,8 +1977,8 @@
"trap on all messages which are understood by anObject"
self wrapAll:anObject
- onEntry:BreakBlock
- onExit:LeaveBreakBlock.
+ onEntry:BreakBlock
+ onExit:LeaveBreakBlock.
"Modified: 22.10.1996 / 17:39:54 / cg"
!
@@ -2000,7 +2000,7 @@
orgClass := anObject class.
orgClass category == #'* trapping *' ifFalse:[
- ^ self
+ ^ self
].
anObject changeClassTo:orgClass superclass.
@@ -2036,12 +2036,12 @@
dict at:aSelector ifAbsent:[^ self].
dict size == 1 ifTrue:[
- "the last trap got removed"
- anObject changeClassTo:orgClass superclass.
- ObjectCopyHolders notNil ifTrue:[
- ObjectCopyHolders removeKey:anObject ifAbsent:nil.
+ "the last trap got removed"
+ anObject changeClassTo:orgClass superclass.
+ ObjectCopyHolders notNil ifTrue:[
+ ObjectCopyHolders removeKey:anObject ifAbsent:nil.
].
- ^ self
+ ^ self
].
dict removeKey:aSelector.
orgClass methodDictionary:dict.
@@ -2074,7 +2074,7 @@
"return the set of wrapped selectors (if any)"
(anObject class category == #'* trapping *') ifFalse:[
- ^ #()
+ ^ #()
].
^ anObject class selectors
! !
@@ -2084,8 +2084,8 @@
trapModificationsIn:anObject
"trap modifications in anObject"
- self
- trapModificationsIn:anObject filter:[:old :new | true]
+ self
+ trapModificationsIn:anObject filter:[:old :new | true]
"
|a|
@@ -2116,7 +2116,7 @@
allSelectors := IdentitySet new.
anObject class withAllSuperclassesDo:[:aClass |
- aClass methodDictionary keys addAllTo:allSelectors
+ aClass methodDictionary keys addAllTo:allSelectors
].
self trapModificationsIn:anObject selectors:allSelectors filter:aFilterBlock
@@ -2148,13 +2148,13 @@
trapModificationsIn:anObject selector:aSelector filter:aFilterBlock
"install a trap for modifications in anObject by aSelector-messages.
the filterBlock will be invoked (after a modification) with the old and
- new values as arguments and should return true,
+ new values as arguments and should return true,
if the debugger is really wanted."
self
- trapModificationsIn:anObject
- selectors:(Array with:aSelector)
- filter:aFilterBlock
+ trapModificationsIn:anObject
+ selectors:(Array with:aSelector)
+ filter:aFilterBlock
"Modified: / 21.4.1998 / 15:34:44 / cg"
!
@@ -2162,27 +2162,27 @@
trapModificationsIn:anObject selectors:aCollectionOfSelectors filter:aFilterBlock
"install a trap for modifications in anObject by aSelector-messages.
the filterBlock will be invoked (after a modification) with the old and
- new values as arguments and should return true,
+ new values as arguments and should return true,
if the debugger is really wanted."
|copyHolder sels checkBlock|
- (anObject isNil
- or:[anObject isSymbol
- or:[anObject class == SmallInteger
- or:[anObject == true
- or:[anObject == false]]]])
+ (anObject isNil
+ or:[anObject isSymbol
+ or:[anObject class == SmallInteger
+ or:[anObject == true
+ or:[anObject == false]]]])
ifTrue:[
- self error:'cannot place trap on this object' mayProceed:true.
- ^ self.
+ self error:'cannot place trap on this object' mayProceed:true.
+ ^ self.
].
ObjectCopyHolders isNil ifTrue:[
- ObjectCopyHolders := WeakIdentityDictionary new.
+ ObjectCopyHolders := WeakIdentityDictionary new.
].
copyHolder := ObjectCopyHolders at:anObject ifAbsent:nil.
copyHolder isNil ifTrue:[
- ObjectCopyHolders at:anObject put:(copyHolder := ValueHolder new).
+ ObjectCopyHolders at:anObject put:(copyHolder := ValueHolder new).
].
copyHolder value:(anObject shallowCopy).
@@ -2190,40 +2190,40 @@
"/ some required ones, which are used in the wrapped code and are known to
"/ do no harm to the object ... consider this a kludge
sels := aCollectionOfSelectors copy.
- sels removeAll:#(#class #species #yourself #'sameContentsAs:'
- #'instVarAt:' #'at:' #'basicAt:'
- #'shallowCopy' #'copy'
- #'=' #'==' #'~=' #'~~'
- #'size'
- ).
+ sels removeAll:#(#class #species #yourself #'sameContentsAs:'
+ #'instVarAt:' #'at:' #'basicAt:'
+ #'shallowCopy' #'copy'
+ #'=' #'==' #'~=' #'~~'
+ #'size'
+ ).
checkBlock :=
- [:con :retVal |
- |oldValue|
-
- oldValue := copyHolder value.
-
- "/ compare with copy ...
- (anObject sameContentsAs:oldValue) ifFalse:[
- "/ see oldValue vs. anObject
- (aFilterBlock value:oldValue value:anObject) ifTrue:[
- copyHolder value:(anObject shallowCopy).
- ObjectWrittenBreakpointSignal
- raiseRequestWith:(oldValue -> anObject)
- errorString:('object was modififed in: ' , con sender selector)
- in:con sender
- ]
- ]
- ].
+ [:con :retVal |
+ |oldValue|
+
+ oldValue := copyHolder value.
+
+ "/ compare with copy ...
+ (anObject sameContentsAs:oldValue) ifFalse:[
+ "/ see oldValue vs. anObject
+ (aFilterBlock value:oldValue value:anObject) ifTrue:[
+ copyHolder value:(anObject shallowCopy).
+ ObjectWrittenBreakpointSignal
+ raiseRequestWith:(oldValue -> anObject)
+ errorString:('object was modififed in: ' , con sender selector)
+ in:con sender
+ ]
+ ]
+ ].
sels do:[:aSelector |
- self
- wrap:anObject
- selector:aSelector
- onEntry:[:con | ]
- onExit:checkBlock
- withOriginalClass:true
- flushCaches:false.
+ self
+ wrap:anObject
+ selector:aSelector
+ onEntry:[:con | ]
+ onExit:checkBlock
+ withOriginalClass:true
+ flushCaches:false.
].
ObjectMemory flushCaches
@@ -2237,20 +2237,20 @@
|idx selectors definingClass|
anInstVarOrOffset isInteger ifTrue:[
- "/ indexed slot
- self
- trapModificationsIn:anObject filter:[:old :new | (old at:anInstVarOrOffset) ~~ (new at:anInstVarOrOffset)]
+ "/ indexed slot
+ self
+ trapModificationsIn:anObject filter:[:old :new | (old at:anInstVarOrOffset) ~~ (new at:anInstVarOrOffset)]
] ifFalse:[
- "/ instVar by name
- selectors := IdentitySet new.
- definingClass := anObject class whichClassDefinesInstVar:anInstVarOrOffset.
-
- definingClass withAllSuperclassesDo:[:aClass |
- aClass methodDictionary keys addAllTo:selectors
- ].
- idx := anObject class instVarIndexFor:anInstVarOrOffset.
- self
- trapModificationsIn:anObject selectors:selectors filter:[:old :new | (old instVarAt:idx) ~~ (new instVarAt:idx)]
+ "/ instVar by name
+ selectors := IdentitySet new.
+ definingClass := anObject class whichClassDefinesInstVar:anInstVarOrOffset.
+
+ definingClass withAllSuperclassesDo:[:aClass |
+ aClass methodDictionary keys addAllTo:selectors
+ ].
+ idx := anObject class instVarIndexFor:anInstVarOrOffset.
+ self
+ trapModificationsIn:anObject selectors:selectors filter:[:old :new | (old instVarAt:idx) ~~ (new instVarAt:idx)]
]
"
@@ -2277,7 +2277,7 @@
!MessageTracer class methodsFor:'object tracing'!
trace:anObject selector:aSelector
- "arrange for a trace message to be output on Stderr, when a message with
+ "arrange for a trace message to be output on Stderr, when a message with
aSelector is sent to anObject. Both entry and exit are traced.
Use untrap to remove this trace.
The current implementation does not allow integers or nil to be traced."
@@ -2308,15 +2308,15 @@
!
trace:anObject selector:aSelector on:aStream
- "arrange for a trace message to be output on Stderr, when a message with
+ "arrange for a trace message to be output on Stderr, when a message with
aSelector is sent to anObject. Both entry and exit are traced.
Use untrap to remove this trace.
The current implementation does not allow integers or nil to be traced."
self
- trace:anObject
- selectors:(Array with:aSelector)
- on:aStream
+ trace:anObject
+ selectors:(Array with:aSelector)
+ on:aStream
"
|p|
@@ -2342,8 +2342,8 @@
!
trace:anObject selectors:aCollectionOfSelectors
- "arrange for a trace message to be output on Stderr, when any message
- from aCollectionOfSelectors is sent to anObject.
+ "arrange for a trace message to be output on Stderr, when any message
+ from aCollectionOfSelectors is sent to anObject.
Both entry and exit are traced.
Use untrap:/untrace: to remove this trace.
The current implementation does not allow integers or nil to be traced."
@@ -2374,35 +2374,35 @@
!
trace:anObject selectors:aCollectionOfSelectors on:aStream
- "arrange for a trace message to be output on Stderr, when any message
- from aCollectionOfSelectors is sent to anObject.
+ "arrange for a trace message to be output on Stderr, when any message
+ from aCollectionOfSelectors is sent to anObject.
Both entry and exit are traced.
Use untrap:/untrace: to remove this trace.
The current implementation does not allow integers or nil to be traced."
aCollectionOfSelectors do:[:aSelector |
- |methodName|
-
- methodName := anObject class name , '>>' , aSelector.
- self
- wrap:anObject
- selector:aSelector
- onEntry:[:con |
- aStream nextPutAll:'enter '; nextPutAll:methodName.
- aStream nextPutAll:' receiver='.
- con receiver printOn:aStream.
- aStream nextPutAll:' args='. (con args) printOn:aStream.
- aStream nextPutAll:' from:'. con sender printOn:aStream.
- aStream cr; flush
- ]
- onExit:[:con :retVal |
- aStream nextPutAll:'leave '; nextPutAll:methodName.
- aStream nextPutAll:' receiver='. con receiver printOn:aStream.
- aStream nextPutAll:' returning:'. retVal printOn:aStream.
- aStream cr; flush
- ]
- withOriginalClass:true
- flushCaches:false
+ |methodName|
+
+ methodName := anObject class name , '>>' , aSelector.
+ self
+ wrap:anObject
+ selector:aSelector
+ onEntry:[:con |
+ aStream nextPutAll:'enter '; nextPutAll:methodName.
+ aStream nextPutAll:' receiver='.
+ con receiver printOn:aStream.
+ aStream nextPutAll:' args='. (con args) printOn:aStream.
+ aStream nextPutAll:' from:'. con sender printOn:aStream.
+ aStream cr; flush
+ ]
+ onExit:[:con :retVal |
+ aStream nextPutAll:'leave '; nextPutAll:methodName.
+ aStream nextPutAll:' receiver='. con receiver printOn:aStream.
+ aStream nextPutAll:' returning:'. retVal printOn:aStream.
+ aStream cr; flush
+ ]
+ withOriginalClass:true
+ flushCaches:false
].
ObjectMemory flushCaches
@@ -2489,7 +2489,7 @@
allSelectors := IdentitySet new.
anObject class withAllSuperclassesDo:[:aClass |
- aClass methodDictionary keys addAllTo:allSelectors
+ aClass methodDictionary keys addAllTo:allSelectors
].
self trace:anObject selectors:allSelectors on:aStream
@@ -2507,14 +2507,14 @@
!
traceEntry:anObject selectors:aCollectionOfSelectors on:aStream
- "arrange for a trace message to be output on Stderr, when any message
- from aCollectionOfSelectors is sent to anObject.
+ "arrange for a trace message to be output on Stderr, when any message
+ from aCollectionOfSelectors is sent to anObject.
Only entry is traced.
Use untrap:/untrace: to remove this trace.
The current implementation does not allow integers or nil to be traced."
self
- traceEntry:anObject selectors:aCollectionOfSelectors on:Stderr
+ traceEntry:anObject selectors:aCollectionOfSelectors on:Stderr
"
|p|
@@ -2539,7 +2539,7 @@
!
traceSender:anObject selector:aSelector
- "arrange for a trace message to be output on Stderr, when a message with
+ "arrange for a trace message to be output on Stderr, when a message with
aSelector is sent to anObject. Only the sender is traced on entry.
Use untrap to remove this trace.
The current implementation does not allow integers or nil to be traced."
@@ -2570,7 +2570,7 @@
!
traceSender:anObject selector:aSelector on:aStream
- "arrange for a trace message to be output on Stderr, when a message with
+ "arrange for a trace message to be output on Stderr, when a message with
aSelector is sent to anObject. Only the sender is traced on entry.
Use untrap to remove this trace.
The current implementation does not allow integers or nil to be traced."
@@ -2579,14 +2579,14 @@
methodName := anObject class name , '>>' , aSelector.
self wrap:anObject
- selector:aSelector
- onEntry:[:con |
- aStream nextPutAll:methodName.
- aStream nextPutAll:' from '.
- con sender printOn:aStream.
- aStream cr; flush.
- ]
- onExit:LeaveTraceBlock.
+ selector:aSelector
+ onEntry:[:con |
+ aStream nextPutAll:methodName.
+ aStream nextPutAll:' from '.
+ con sender printOn:aStream.
+ aStream cr; flush.
+ ]
+ onExit:LeaveTraceBlock.
"
|p|
@@ -2639,19 +2639,19 @@
The current implementation does not allow integers or nil to be wrapped."
"I have not yet enough experience, if the wrapped original method should
- run as an instance of the original, or of the catching class;
+ run as an instance of the original, or of the catching class;
The latter has the advantage of catching recursive and other sends, while
it might lead into trouble when the message is sent from a debugger or a long
return is done out of the original method ...
Time will show, you can experiment by setting the withOriginalClass: flag to false
"
- ^ self
- wrap:anObject
- selector:aSelector
- onEntry:entryBlock
- onExit:exitBlock
- withOriginalClass:true
- flushCaches:true
+ ^ self
+ wrap:anObject
+ selector:aSelector
+ onEntry:entryBlock
+ onExit:exitBlock
+ withOriginalClass:true
+ flushCaches:true
"Modified: / 21.4.1998 / 15:29:50 / cg"
!
@@ -2671,10 +2671,10 @@
"
some are not allowed (otherwise we get into trouble ...)
"
- (aSelector == #class
+ (aSelector == #class
or:[aSelector == #changeClassTo:]) ifTrue:[
- Transcript showCR:'sorry, cannot place trap on: ' , aSelector.
- ^ self
+ Transcript showCR:'sorry, cannot place trap on: ' , aSelector.
+ ^ self
].
WrappedMethod autoload. "/ just to make sure ...
@@ -2685,19 +2685,19 @@
"
orgClass := anObject class.
orgClass category == #'* trapping *' ifTrue:[
- newClass := orgClass
+ newClass := orgClass
] ifFalse:[
- myMetaclass := orgClass class.
-
- newClass := myMetaclass copy new.
- newClass setSuperclass:orgClass.
- newClass instSize:orgClass instSize.
- newClass flags:orgClass flags.
- newClass isMeta ifFalse:[newClass setClassVariableString:''].
- newClass setInstanceVariableString:''.
- newClass setName:orgClass name.
- newClass setCategory:#'* trapping *'.
- newClass methodDictionary:MethodDictionary new.
+ myMetaclass := orgClass class.
+
+ newClass := myMetaclass copy new.
+ newClass setSuperclass:orgClass.
+ newClass instSize:orgClass instSize.
+ newClass flags:orgClass flags.
+ newClass isMeta ifFalse:[newClass setClassVariableString:''].
+ newClass setInstanceVariableString:''.
+ newClass setName:orgClass name.
+ newClass setCategory:#'* trapping *'.
+ newClass methodDictionary:MethodDictionary new.
].
"
@@ -2709,68 +2709,68 @@
s nextPutAll:' <context: #return>'.
s nextPutAll:' |retVal stubClass '.
additionalVariables notNil ifTrue:[
- s nextPutAll:additionalVariables.
+ s nextPutAll:additionalVariables.
].
s nextPutAll:'| '.
withOriginalClass ifTrue:[
- s nextPutAll:'stubClass := self class. '.
- s nextPutAll:'self changeClassTo:(stubClass superclass). '.
+ s nextPutAll:'stubClass := self class. '.
+ s nextPutAll:'self changeClassTo:(stubClass superclass). '.
].
additionalEntryCode notNil ifTrue:[
- s nextPutAll:additionalEntryCode.
+ s nextPutAll:additionalEntryCode.
].
entryBlock notNil ifTrue:[
- s nextPutAll:'#literal1 yourself value:thisContext. '. "/ #literal1 will be replaced by the entryBlock
+ s nextPutAll:'#literal1 yourself value:thisContext. '. "/ #literal1 will be replaced by the entryBlock
].
s nextPutAll:('retVal := #originalMethod. '). "/ just to get a place for the originalMethod
s nextPutAll:('retVal := super ' , spec , '. ').
exitBlock notNil ifTrue:[
- s nextPutAll:'#literal2 yourself value:thisContext value:retVal. '. "/ #literal2 will be replaced by the exitBlock
+ s nextPutAll:'#literal2 yourself value:thisContext value:retVal. '. "/ #literal2 will be replaced by the exitBlock
].
additionalExitCode notNil ifTrue:[
- s nextPutAll:additionalExitCode.
+ s nextPutAll:additionalExitCode.
].
withOriginalClass ifTrue:[
- s nextPutAll:'self changeClassTo:stubClass. '.
+ s nextPutAll:'self changeClassTo:stubClass. '.
].
s nextPutAll:'^ retVal'; cr.
ParserFlags
- withSTCCompilation:#never
- do:[
- Class withoutUpdatingChangesDo:[
- trapMethod := Compiler
- compile:s contents
- forClass:newClass
- inCategory:'breakpointed'
- notifying:nil
- install:false
- skipIfSame:false
- silent:true.
- ]
- ].
+ withSTCCompilation:#never
+ do:[
+ Class withoutUpdatingChangesDo:[
+ trapMethod := Compiler
+ compile:s contents
+ forClass:newClass
+ inCategory:'breakpointed'
+ notifying:nil
+ install:false
+ skipIfSame:false
+ silent:true.
+ ]
+ ].
trapMethod == #Error ifTrue:[
- Transcript showCR:('cannot place trap on method: ' , aSelector).
- ^ self
+ Transcript showCR:('cannot place trap on method: ' , aSelector).
+ ^ self
].
implClass := orgClass whichClassIncludesSelector:aSelector.
implClass isNil ifTrue:[
- Transcript showCR:aSelector , ' is not understood by ' , orgClass name.
+ Transcript showCR:aSelector , ' is not understood by ' , orgClass name.
] ifFalse:[
- originalMethod := (implClass compiledMethodAt:aSelector).
- originalMethod notNil ifTrue:[
- trapMethod setPackage:originalMethod package.
- ].
-
- trapMethod changeLiteral:#originalMethod to:originalMethod.
+ originalMethod := (implClass compiledMethodAt:aSelector).
+ originalMethod notNil ifTrue:[
+ trapMethod setPackage:originalMethod package.
+ ].
+
+ trapMethod changeLiteral:#originalMethod to:originalMethod.
].
entryBlock notNil ifTrue:[
- trapMethod changeLiteral:#literal1 to:entryBlock.
+ trapMethod changeLiteral:#literal1 to:entryBlock.
].
exitBlock notNil ifTrue:[
- trapMethod changeLiteral:#literal2 to:exitBlock.
+ trapMethod changeLiteral:#literal2 to:exitBlock.
].
"
change the source of this new method
@@ -2786,33 +2786,33 @@
dict := newClass methodDictionary.
dict := dict at:aSelector putOrAppend:trapMethod.
flushCaches ifTrue:[
- newClass methodDictionary:dict.
+ newClass methodDictionary:dict.
] ifFalse:[
- newClass setMethodDictionary:dict.
+ newClass setMethodDictionary:dict.
].
"
and finally, the big trick:
"
newClass ~~ orgClass ifTrue:[
- anObject changeClassTo:newClass
+ anObject changeClassTo:newClass
].
"
- [exBegin]
+ [exBegin]
|p|
p := Point new copy.
- MessageTracer
- wrap:p
- selector:#y:
- onEntry:nil
- onExit:[:context :retVal |
- Transcript show:'leave Point>>y:, returning:'.
- Transcript showCR:retVal printString.
- Transcript endEntry
- ]
- withOriginalClass:true.
+ MessageTracer
+ wrap:p
+ selector:#y:
+ onEntry:nil
+ onExit:[:context :retVal |
+ Transcript show:'leave Point>>y:, returning:'.
+ Transcript showCR:retVal printString.
+ Transcript endEntry
+ ]
+ withOriginalClass:true.
Transcript showCR:'sending x: ...'.
p x:1.
Transcript showCR:'sending y: ...'.
@@ -2822,19 +2822,19 @@
p x:2.
Transcript showCR:'sending y: ...'.
p y:1.
- [exEnd]
+ [exEnd]
"
"
- [exBegin]
+ [exBegin]
|p|
p := Point new copy.
MessageTracer wrap:p
- selector:#y:
- onEntry:[:context | self halt:'y: you are trapped']
- onExit:nil
- withOriginalClass:false.
+ selector:#y:
+ onEntry:[:context | self halt:'y: you are trapped']
+ onExit:nil
+ withOriginalClass:false.
Transcript showCR:'sending x: ...'.
p x:1.
Transcript showCR:'sending y: ...'.
@@ -2844,7 +2844,7 @@
p x:2.
Transcript showCR:'sending y: ...'.
p y:1.
- [exEnd]
+ [exEnd]
"
"Modified: / 25-06-1996 / 22:11:21 / stefan"
@@ -2861,20 +2861,20 @@
NOTICE: The current implementation does not allow integers or nil to be wrapped."
^ self
- wrap:anObject selector:aSelector onEntry:entryBlock onExit:exitBlock
- additionalEntryCode:nil additionalExitCode:nil additionalVariables:nil
- withOriginalClass:withOriginalClass flushCaches:flushCaches
+ wrap:anObject selector:aSelector onEntry:entryBlock onExit:exitBlock
+ additionalEntryCode:nil additionalExitCode:nil additionalVariables:nil
+ withOriginalClass:withOriginalClass flushCaches:flushCaches
!
wrap:anObject selectors:aCollection onEntry:entryBlock onExit:exitBlock
"install wrappers for anObject on all selectors from aCollection"
aCollection do:[:aSelector |
- self
- wrap:anObject selector:aSelector
- onEntry:entryBlock onExit:exitBlock
- withOriginalClass:true
- flushCaches:false
+ self
+ wrap:anObject selector:aSelector
+ onEntry:entryBlock onExit:exitBlock
+ withOriginalClass:true
+ flushCaches:false
].
ObjectMemory flushCaches
@@ -2888,7 +2888,7 @@
allSelectors := IdentitySet new.
anObject class withAllSuperclassesDo:[:aClass |
- aClass methodDictionary keys addAllTo:allSelectors
+ aClass methodDictionary keys addAllTo:allSelectors
].
self wrap:anObject selectors:allSelectors onEntry:entryBlock onExit:exitBlock
@@ -2903,7 +2903,7 @@
areAnyMethodsWrapped
Smalltalk allMethodsDo:[:mthd |
- mthd isWrapped ifTrue:[ ^ true ]
+ mthd isWrapped ifTrue:[ ^ true ]
].
^ false
!
@@ -2912,16 +2912,16 @@
"return true if aMethod is counted"
MethodCounts notNil ifTrue:[
- (MethodCounts includesKey:aMethod) ifTrue:[^ true].
- aMethod isWrapped ifTrue:[
- (MethodCounts includesKey:aMethod originalMethod)ifTrue:[^ true].
- ].
+ (MethodCounts includesKey:aMethod) ifTrue:[^ true].
+ aMethod isWrapped ifTrue:[
+ (MethodCounts includesKey:aMethod originalMethod)ifTrue:[^ true].
+ ].
].
MethodCountsPerReceiverClass notNil ifTrue:[
- (MethodCountsPerReceiverClass includesKey:aMethod) ifTrue:[^ true].
- aMethod isWrapped ifTrue:[
- (MethodCountsPerReceiverClass includesKey:aMethod originalMethod)ifTrue:[^ true].
- ].
+ (MethodCountsPerReceiverClass includesKey:aMethod) ifTrue:[^ true].
+ aMethod isWrapped ifTrue:[
+ (MethodCountsPerReceiverClass includesKey:aMethod originalMethod)ifTrue:[^ true].
+ ].
].
^ false
@@ -2935,7 +2935,7 @@
MethodCountsPerReceiverClass isNil ifTrue:[^ false].
(MethodCountsPerReceiverClass includesKey:aMethod) ifTrue:[^ true].
aMethod isWrapped ifTrue:[
- ^ MethodCountsPerReceiverClass includesKey:aMethod originalMethod
+ ^ MethodCountsPerReceiverClass includesKey:aMethod originalMethod
].
^ false
!
@@ -2946,7 +2946,7 @@
MethodTiming isNil ifTrue:[^ false].
(MethodTiming includesKey:aMethod) ifTrue:[^ true].
aMethod isWrapped ifTrue:[
- ^ MethodTiming includesKey:aMethod originalMethod
+ ^ MethodTiming includesKey:aMethod originalMethod
].
^ false
@@ -2999,7 +2999,7 @@
"/ depends on whether there is already some statistic data)
10 timesRepeat:[
- self dummyEmptyMethod.
+ self dummyEmptyMethod.
].
"/ fetch min time & unwrap
@@ -3025,9 +3025,9 @@
!
printEntryFull:aContext level:lvl on:aStream
- aStream
- spaces:lvl;
- nextPutAll:'enter '.
+ aStream
+ spaces:lvl;
+ nextPutAll:'enter '.
self printFull:aContext on:aStream withSender:true.
!
@@ -3040,24 +3040,24 @@
mClass := aContext methodClass.
mClass isNil ifTrue:[
- mClassName := '???'
+ mClassName := '???'
] ifFalse:[
- mClassName := mClass name
+ mClassName := mClass name
].
- aStream
- nextPutAll:mClassName;
- space;
- bold;
- nextPutAll:aContext selector;
- normal;
- nextPutAll:' from '.
+ aStream
+ nextPutAll:mClassName;
+ space;
+ bold;
+ nextPutAll:aContext selector;
+ normal;
+ nextPutAll:' from '.
sender := aContext sender.
sender notNil ifTrue:[
- (sender selector startsWith:'perform:') ifTrue:[
- sender := sender sender.
- ].
+ (sender selector startsWith:'perform:') ifTrue:[
+ sender := sender sender.
+ ].
].
sender printOn:aStream.
aStream cr; flush.
@@ -3078,19 +3078,19 @@
mClass := aContext methodClass.
mClass isNil ifTrue:[
- mClassName := '???'
+ mClassName := '???'
] ifFalse:[
- mClassName := mClass name
+ mClassName := mClass name
].
- aStream
- spaces:lvl;
- nextPutAll:'leave ';
- nextPutAll:mClassName;
- space;
- bold;
- nextPutAll:aContext selector;
- normal;
- nextPutAll:' rec=['.
+ aStream
+ spaces:lvl;
+ nextPutAll:'leave ';
+ nextPutAll:mClassName;
+ space;
+ bold;
+ nextPutAll:aContext selector;
+ normal;
+ nextPutAll:' rec=['.
self printObject:aContext receiver on:aStream.
aStream nextPutAll:'] return: ['.
@@ -3104,9 +3104,9 @@
printFull:aContext on:aStream withSender:withSender
self
- printFull:aContext on:aStream
- withSenderContext:(withSender ifTrue:[aContext sender]
- ifFalse:[nil])
+ printFull:aContext on:aStream
+ withSenderContext:(withSender ifTrue:[aContext sender]
+ ifFalse:[nil])
!
printFull:aContext on:aStream withSenderContext:aSenderContextOrNil
@@ -3114,30 +3114,30 @@
mClass := aContext methodClass.
mClass isNil ifTrue:[
- mClassName := '???'
+ mClassName := '???'
] ifFalse:[
- mClassName := mClass name
+ mClassName := mClass name
].
- aStream
- nextPutAll:mClassName;
- space;
- bold;
- nextPutAll:aContext selector;
- normal;
- nextPutAll:' rec=['.
+ aStream
+ nextPutAll:mClassName;
+ space;
+ bold;
+ nextPutAll:aContext selector;
+ normal;
+ nextPutAll:' rec=['.
self printObject:aContext receiver on:aStream.
- aStream nextPutAll:'] '.
+ aStream nextPutAll:'] '.
(aContext args) keysAndValuesDo:[:idx :arg |
- aStream nextPutAll:'arg'. idx printOn:aStream. aStream nextPutAll:'=['.
- self printObject:arg on:aStream.
- aStream nextPutAll:'] '.
+ aStream nextPutAll:'arg'. idx printOn:aStream. aStream nextPutAll:'=['.
+ self printObject:arg on:aStream.
+ aStream nextPutAll:'] '.
].
aSenderContextOrNil notNil ifTrue:[
- self printSender:aSenderContextOrNil on:aStream.
+ self printSender:aSenderContextOrNil on:aStream.
].
aStream cr; flush.
!
@@ -3147,7 +3147,7 @@
s := anObject printString.
s size > 40 ifTrue:[
- s := s chopTo:40.
+ s := s chopTo:40.
].
aStream nextPutAll:s
!
@@ -3157,11 +3157,11 @@
sender := aSenderContext.
sender notNil ifTrue:[
- (sender selector startsWith:'perform:') ifTrue:[
- sender := sender sender.
- ].
+ (sender selector startsWith:'perform:') ifTrue:[
+ sender := sender sender.
+ ].
].
- aStream nextPutAll:'from:'.
+ aStream nextPutAll:'from:'.
aStream bold.
sender printOn:aStream.
aStream normal.
@@ -3173,32 +3173,32 @@
con := aContext.
[con notNil
- and:[con selector ~~ #'changed:with:']
+ and:[con selector ~~ #'changed:with:']
] whileTrue:[
- con := con sender.
+ con := con sender.
].
"/ con is #'changed:with:'
con isNil ifTrue:[
- ^ self printEntryFull:aContext level:lvl on:aStream.
+ ^ self printEntryFull:aContext level:lvl on:aStream.
].
(con sender notNil
and:[ con sender selector == #'changed:']) ifTrue:[
- con := con sender.
+ con := con sender.
].
(con sender notNil
and:[ con sender selector == #'changed']) ifTrue:[
- con := con sender.
+ con := con sender.
].
(con sender notNil) ifTrue:[
- con := con sender.
+ con := con sender.
].
aStream spaces:lvl; nextPutAll:'enter '.
self
- printFull:aContext
- on:aStream
- withSenderContext:con
+ printFull:aContext
+ on:aStream
+ withSenderContext:con
!
traceEntryFull:aContext on:aStream
@@ -3213,10 +3213,10 @@
"avoid generation of fullBlocks"
aStream == Transcript ifTrue:[
- ^ TraceFullBlock2
+ ^ TraceFullBlock2
].
aStream == Stderr ifTrue:[
- ^ TraceFullBlock
+ ^ TraceFullBlock
].
^ [:con | con fullPrintAllOn:aStream]
@@ -3228,10 +3228,10 @@
"avoid generation of fullBlocks"
aStream == Transcript ifTrue:[
- ^ TraceSenderBlock2
+ ^ TraceSenderBlock2
].
aStream == Stderr ifTrue:[
- ^ TraceSenderBlock
+ ^ TraceSenderBlock
].
^ [:con | MessageTracer printEntrySender:con on:aStream]
@@ -3249,24 +3249,24 @@
ObjectMemory stepInterruptHandler:self.
^ [
- ObjectMemory flushInlineCaches.
- StepInterruptPending := 1.
- InterruptPending := 1.
- aBlock value
+ ObjectMemory flushInlineCaches.
+ StepInterruptPending := 1.
+ InterruptPending := 1.
+ aBlock value
] ensure:[
- tracedBlock := nil.
- StepInterruptPending := nil.
- ObjectMemory stepInterruptHandler:nil.
+ tracedBlock := nil.
+ StepInterruptPending := nil.
+ ObjectMemory stepInterruptHandler:nil.
]
"
PrintingMessageTracer new trace:[#(6 5 4 3 2 1) sort] detail:false
- PrintingMessageTracer new trace:[#(6 5 4 3 2 1) sort] detail:true
-
- PrintingMessageTracer new trace:[#(6 5 4 3 2 1) sort] detail:#indent
-
- PrintingMessageTracer new trace:[#(6 5 4 3 2 1) sort] detail:#fullIndent
+ PrintingMessageTracer new trace:[#(6 5 4 3 2 1) sort] detail:true
+
+ PrintingMessageTracer new trace:[#(6 5 4 3 2 1) sort] detail:#indent
+
+ PrintingMessageTracer new trace:[#(6 5 4 3 2 1) sort] detail:#fullIndent
"
! !
@@ -3283,7 +3283,7 @@
avgTime
sumTimes notNil ifTrue:[
- ^ sumTimes / count
+ ^ sumTimes / count
].
^ nil
@@ -3306,7 +3306,7 @@
^ count
!
-count:countArg minTime:minTimeArg maxTime:maxTimeArg sumTimes:sumTimesArg
+count:countArg minTime:minTimeArg maxTime:maxTimeArg sumTimes:sumTimesArg
count := countArg.
minTime := minTimeArg.
maxTime := maxTimeArg.
@@ -3347,18 +3347,18 @@
rememberExecutionTime:t
(count isNil or:[count == 0]) ifTrue:[
- minTime := maxTime := sumTimes := t.
- count := 1.
+ minTime := maxTime := sumTimes := t.
+ count := 1.
] ifFalse:[
- t < minTime ifTrue:[
- minTime := t.
- ] ifFalse:[
- t > maxTime ifTrue:[
- maxTime := t.
- ]
- ].
- sumTimes := (sumTimes + t).
- count := count + 1
+ t < minTime ifTrue:[
+ minTime := t.
+ ] ifFalse:[
+ t > maxTime ifTrue:[
+ maxTime := t.
+ ]
+ ].
+ sumTimes := (sumTimes + t).
+ count := count + 1
].
"Created: / 05-03-2007 / 15:32:43 / cg"
@@ -3383,53 +3383,53 @@
outStream := output ? Stderr.
con receiver == Processor ifTrue:[
- (sel := con selector) == #threadSwitch: ifTrue:[
- ignore := true.
- ].
- sel == #timerInterrupt ifTrue:[
- ignore := true.
- ]
+ (sel := con selector) == #threadSwitch: ifTrue:[
+ ignore := true.
+ ].
+ sel == #timerInterrupt ifTrue:[
+ ignore := true.
+ ]
].
con lineNumber == 1 ifFalse:[
- ignore := true
+ ignore := true
].
ignore ifFalse:[
- con markForInterruptOnUnwind.
-
- ((r := con receiver) ~~ self
- and:[r ~~ tracedBlock]) ifTrue:[
- traceDetail == #fullIndent ifTrue:[
- [con notNil
- and:[(r := con receiver) ~~ self
- and:[r ~~ tracedBlock]]] whileTrue:[
- ' ' printOn:outStream.
- con := con sender.
- ].
- con := senderContext.
- self class printFull:con on:outStream withSender:false.
- ] ifFalse:[
- traceDetail == #indent ifTrue:[
- [con notNil
- and:[(r := con receiver) ~~ self
- and:[r ~~ tracedBlock]]] whileTrue:[
- ' ' printOn:outStream.
- con := con sender.
- ].
- con := senderContext.
- con printOn:outStream.
- outStream cr.
- ] ifFalse:[
- traceDetail == true ifTrue:[
- self class printFull:con on:outStream withSender:true.
- ] ifFalse:[
- con printOn:outStream.
- outStream cr.
- ]
- ]
- ].
- ].
+ con markForInterruptOnUnwind.
+
+ ((r := con receiver) ~~ self
+ and:[r ~~ tracedBlock]) ifTrue:[
+ traceDetail == #fullIndent ifTrue:[
+ [con notNil
+ and:[(r := con receiver) ~~ self
+ and:[r ~~ tracedBlock]]] whileTrue:[
+ ' ' printOn:outStream.
+ con := con sender.
+ ].
+ con := senderContext.
+ self class printFull:con on:outStream withSender:false.
+ ] ifFalse:[
+ traceDetail == #indent ifTrue:[
+ [con notNil
+ and:[(r := con receiver) ~~ self
+ and:[r ~~ tracedBlock]]] whileTrue:[
+ ' ' printOn:outStream.
+ con := con sender.
+ ].
+ con := senderContext.
+ con printOn:outStream.
+ outStream cr.
+ ] ifFalse:[
+ traceDetail == true ifTrue:[
+ self class printFull:con on:outStream withSender:true.
+ ] ifFalse:[
+ con printOn:outStream.
+ outStream cr.
+ ]
+ ]
+ ].
+ ].
].
ObjectMemory flushInlineCaches.
@@ -3439,19 +3439,19 @@
"
self new trace:[#(6 5 4 3 2 1) sort] detail:false
- self new trace:[#(6 5 4 3 2 1) sort] detail:true
-
- self new trace:[#(6 5 4 3 2 1) sort] detail:#indent
-
- self new trace:[#(6 5 4 3 2 1) sort] detail:#fullIndent
- self new trace:[ View new ] detail:#fullIndent
+ self new trace:[#(6 5 4 3 2 1) sort] detail:true
+
+ self new trace:[#(6 5 4 3 2 1) sort] detail:#indent
+
+ self new trace:[#(6 5 4 3 2 1) sort] detail:#fullIndent
+ self new trace:[ View new ] detail:#fullIndent
"
! !
!MessageTracer class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.129 2014-02-13 19:49:55 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.130 2014-06-10 10:21:37 cg Exp $'
! !