--- a/MessageTracer.st Sat Jan 06 15:38:07 1996 +0100
+++ b/MessageTracer.st Sat Jan 06 19:23:58 1996 +0100
@@ -183,14 +183,14 @@
initialize
BreakpointSignal isNil ifTrue:[
- BreakpointSignal := HaltSignal newSignalMayProceed:true.
- BreakpointSignal nameClass:self message:#breakpointSignal.
- BreakpointSignal notifierString:'breakpoint encountered'.
+ BreakpointSignal := HaltSignal newSignalMayProceed:true.
+ BreakpointSignal nameClass:self message:#breakpointSignal.
+ BreakpointSignal notifierString:'breakpoint encountered'.
- BreakBlock := [:con | BreakpointSignal raiseIn:con].
- TraceSenderBlock := [:con | MessageTracer printEntrySender:con].
- TraceFullBlock := [:con | con fullPrintAll].
- LeaveBlock := [:con :retVal | ].
+ BreakBlock := [:con | BreakpointSignal raiseIn:con].
+ TraceSenderBlock := [:con | MessageTracer printEntrySender:con].
+ TraceFullBlock := [:con | con fullPrintAll].
+ LeaveBlock := [:con :retVal | ].
]
"
@@ -273,36 +273,36 @@
s 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 := 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.
save := Compiler stcCompilation.
Compiler stcCompilation:#never.
[
- Class withoutUpdatingChangesDo:[
- trapMethod := Compiler compile:s contents
- forClass:aClass
- inCategory:'trapping'
- notifying:nil
- install:false
- skipIfSame:false
- silent:true.
- ]
+ Class withoutUpdatingChangesDo:[
+ trapMethod := Compiler compile:s contents
+ forClass:aClass
+ inCategory:'trapping'
+ notifying:nil
+ install:false
+ skipIfSame:false
+ silent:true.
+ ]
] valueNowOrOnUnwindDo:[
- Compiler stcCompilation:save
+ Compiler stcCompilation:save
].
lits := trapMethod literals.
entryBlock notNil ifTrue:[
- lits at:(lits indexOf:#literal1) put:entryBlock.
+ lits at:(lits indexOf:#literal1) put:entryBlock.
].
exitBlock notNil ifTrue:[
- lits at:(lits indexOf:#literal2) put:exitBlock.
+ lits at:(lits indexOf:#literal2) put:exitBlock.
].
"
change the source of this new method
@@ -314,67 +314,67 @@
if not already trapping, create a new class
"
aClass category == #trapping ifTrue:[
- idx := aClass selectorArray indexOf:aSelector.
- idx ~~ 0 ifTrue:[
- aClass methodArray at:idx put:trapMethod
- ] ifFalse:[
- aClass
- setSelectors:(aClass selectorArray copyWith:aSelector)
- methods:(aClass methodArray copyWith:trapMethod)
- ].
- lits at:(lits indexOf:#literal3) put:aClass superclass.
+ idx := aClass selectorArray indexOf:aSelector.
+ idx ~~ 0 ifTrue:[
+ aClass methodArray at:idx put:trapMethod
+ ] ifFalse:[
+ aClass
+ setSelectors:(aClass selectorArray copyWith:aSelector)
+ methods:(aClass methodArray copyWith:trapMethod)
+ ].
+ lits at:(lits indexOf:#literal3) put:aClass superclass.
] ifFalse:[
- myMetaclass := aClass class.
+ myMetaclass := aClass class.
- newClass := myMetaclass copy new.
- newClass setSuperclass:aClass superclass.
- newClass instSize:aClass instSize.
- newClass flags:aClass flags.
- newClass setClassVariableString:aClass classVariableString.
- newClass setInstanceVariableString:aClass instanceVariableString.
- newClass setName:aClass name.
- newClass category:aClass category.
- newClass
- setSelectors:aClass selectorArray
- methods:aClass methodArray.
+ newClass := myMetaclass copy new.
+ newClass setSuperclass:aClass superclass.
+ newClass instSize:aClass instSize.
+ newClass flags:aClass flags.
+ newClass setClassVariableString:aClass classVariableString.
+ newClass setInstanceVariableString:aClass instanceVariableString.
+ newClass setName:aClass name.
+ newClass category:aClass category.
+ newClass
+ setSelectors:aClass selectorArray
+ methods:aClass methodArray.
- aClass setSuperclass:newClass.
- aClass setClassVariableString:''.
- aClass setInstanceVariableString:''.
- aClass category:#trapping.
- aClass
- setSelectors:(Array with:aSelector)
- methods:(Array with:trapMethod).
+ aClass setSuperclass:newClass.
+ aClass setClassVariableString:''.
+ aClass setInstanceVariableString:''.
+ aClass category:#trapping.
+ aClass
+ setSelectors:(Array with:aSelector)
+ methods:(Array with:trapMethod).
- lits at:(lits indexOf:#literal3) put:newClass.
+ lits at:(lits indexOf:#literal3) put:newClass.
].
ObjectMemory flushCaches.
"
MessageTracer
- wrapMethod:(Point compiledMethodAt:#scaleBy:)
- onEntry:nil
- onExit:[:con :retVal |
- Transcript show:'leave Point>>scaleBy:; returning:'.
- Transcript showCr:retVal printString.
- Transcript endEntry
- ].
+ 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 untrapClass:Point.
(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
- ].
+ 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 untrapClass:Integer.
@@ -386,17 +386,17 @@
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
- ].
+ 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 untrapClass:Integer.
@@ -615,19 +615,19 @@
|lvl inside|
MethodCounts isNil ifTrue:[
- MethodCounts := IdentityDictionary new.
+ MethodCounts := IdentityDictionary new.
].
MethodCounts at:aMethod put:0.
^ self wrapMethod:aMethod
- onEntry:[:con |
- |cnt|
+ onEntry:[:con |
+ |cnt|
- cnt := MethodCounts at:aMethod ifAbsent:0.
- MethodCounts at:aMethod put:(cnt + 1).
- ]
- onExit:[:con :retVal |
- ]
+ cnt := MethodCounts at:aMethod ifAbsent:0.
+ MethodCounts at:aMethod put:(cnt + 1).
+ ]
+ onExit:[:con :retVal |
+ ]
"
MessageTracer countMethod:(Integer compiledMethodAt:#factorial).
@@ -647,8 +647,8 @@
MethodCounts isNil ifTrue:[^ 0].
aMethod isWrapped ifTrue:[
- count := MethodCounts at:aMethod originalMethod ifAbsent:nil.
- count notNil ifTrue:[^ count].
+ count := MethodCounts at:aMethod originalMethod ifAbsent:nil.
+ count notNil ifTrue:[^ count].
].
^ MethodCounts at:aMethod ifAbsent:0
@@ -662,7 +662,7 @@
MethodCounts isNil ifTrue:[^ false].
(MethodCounts includesKey:aMethod) ifTrue:[^ true].
aMethod isWrapped ifTrue:[
- ^ MethodCounts includesKey:aMethod originalMethod
+ ^ MethodCounts includesKey:aMethod originalMethod
].
^ false
@@ -687,41 +687,45 @@
|lvl inside 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|
+ 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)
+ ].
- memUse := ObjectMemory newSpaceUsed - oldNewUsed.
- scavenges := ObjectMemory scavengeCount - oldScavengeCount.
- scavenges ~= 0 ifTrue:[
- memUse := memUse + (ObjectMemory newSpaceSize * scavenges)
- ].
-
- cnt := MethodCounts at:aMethod ifAbsent:0.
- MethodCounts at:aMethod put:(cnt + 1).
- cnt := MethodMemoryUsage at:aMethod ifAbsent:0.
- MethodMemoryUsage at:aMethod put:(cnt + memUse).
- Processor activeProcess priority:oldPriority
- ]
- onUnwind:[
- oldPriority notNil ifTrue:[
- Processor activeProcess priority:oldPriority
- ]
- ]
+ 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
+ ]
+ onUnwind:[
+ oldPriority notNil ifTrue:[
+ Processor activeProcess priority:oldPriority
+ ]
+ ]
"
MessageTracer countMemoryUsageOfMethod:(Integer compiledMethodAt:#factorial).
@@ -740,7 +744,7 @@
MethodMemoryUsage isNil ifTrue:[^ false].
(MethodMemoryUsage includesKey:aMethod) ifTrue:[^ true].
aMethod isWrapped ifTrue:[
- ^ MethodMemoryUsage includesKey:aMethod originalMethod
+ ^ MethodMemoryUsage includesKey:aMethod originalMethod
].
^ false
@@ -754,12 +758,12 @@
(MethodCounts isNil or:[MethodMemoryUsage isNil]) ifTrue:[^ 0].
aMethod isWrapped ifTrue:[
- count := MethodCounts at:aMethod originalMethod ifAbsent:nil.
- memUse := MethodMemoryUsage at:aMethod originalMethod ifAbsent:nil.
+ count := MethodCounts at:aMethod originalMethod ifAbsent:nil.
+ memUse := MethodMemoryUsage at:aMethod originalMethod 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
@@ -836,8 +840,8 @@
Use untraceMethod to remove this trace."
^ self wrapMethod:aMethod
- onEntry:[:con | ObjectMemory flushCaches. Smalltalk sendTraceOn.]
- onExit:[:con :val | Smalltalk sendTraceOff.].
+ onEntry:[:con | ObjectMemory flushCaches. Smalltalk sendTraceOn.]
+ onExit:[:con :val | Smalltalk sendTraceOff.].
"Created: 17.12.1995 / 17:08:28 / cg"
"Modified: 17.12.1995 / 17:12:50 / cg"
@@ -849,8 +853,8 @@
Use untraceMethod to remove this trace."
^ self wrapMethod:aMethod
- onEntry:TraceFullBlock
- onExit:LeaveBlock.
+ onEntry:TraceFullBlock
+ onExit:LeaveBlock.
"Created: 15.12.1995 / 18:19:31 / cg"
!
@@ -891,17 +895,24 @@
|selector class originalMethod idx|
MethodCounts notNil ifTrue:[
- aMethod isWrapped ifTrue:[
- MethodCounts removeKey:aMethod originalMethod ifAbsent:nil.
- ].
- MethodCounts removeKey:aMethod ifAbsent:nil.
- MethodCounts isEmpty ifTrue:[MethodCounts := nil].
+ aMethod isWrapped ifTrue:[
+ MethodCounts removeKey:aMethod originalMethod ifAbsent:nil.
+ ].
+ MethodCounts removeKey:aMethod ifAbsent:nil.
+ MethodCounts isEmpty ifTrue:[MethodCounts := nil].
+ ].
+ MethodMemoryUsage notNil ifTrue:[
+ aMethod isWrapped ifTrue:[
+ MethodMemoryUsage removeKey:aMethod originalMethod ifAbsent:nil.
+ ].
+ MethodMemoryUsage removeKey:aMethod ifAbsent:nil.
+ MethodMemoryUsage isEmpty ifTrue:[MethodMemoryUsage := nil].
].
CallingLevel := 0.
(aMethod isNil or:[aMethod isWrapped not]) ifTrue:[
- ^ aMethod
+ ^ aMethod
].
"
@@ -909,29 +920,27 @@
"
class := aMethod containingClass.
class isNil ifTrue:[
- 'MSGTRACER: no containing class for method found' infoPrintNL.
- ^ aMethod
+ 'MSGTRACER: no containing class for method found' infoPrintNL.
+ ^ aMethod
].
selector := class selectorAtMethod:aMethod.
originalMethod := aMethod originalMethod.
originalMethod isNil ifTrue:[
- self error:'oops, could not find original method'.
- ^ aMethod
+ self error:'oops, could not find original method'.
+ ^ aMethod
].
idx := class selectorArray indexOf:selector.
idx ~~ 0 ifTrue:[
- class methodArray at:idx put:originalMethod
+ class methodArray at:idx put:originalMethod
] ifFalse:[
- self halt:'oops, unexpected error'.
- ^ aMethod
+ self halt:'oops, unexpected error'.
+ ^ aMethod
].
ObjectMemory flushCaches.
^ originalMethod
-
- "Modified: 17.12.1995 / 16:00:55 / cg"
!
wrapMethod:aMethod onEntry:entryBlock onExit:exitBlock
@@ -960,10 +969,10 @@
but only if not already being trapped.
"
(aMethod isNil or:[aMethod isWrapped]) ifTrue:[
- ^ aMethod
+ ^ aMethod
].
aMethod isLazyMethod ifTrue:[
- aMethod makeRealMethod
+ aMethod makeRealMethod
].
"
@@ -971,8 +980,8 @@
"
class := aMethod containingClass.
class isNil ifTrue:[
- self error:'cannot place trap (no containing class found)'.
- ^ aMethod
+ self error:'cannot place trap (no containing class found)'.
+ ^ aMethod
].
selector := class selectorAtMethod:aMethod.
@@ -992,10 +1001,10 @@
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)';
@@ -1005,10 +1014,10 @@
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:'] valueOnUnwindDo:#unwindBlock yourself.'.
+ s nextPutAll:'] valueOnUnwindDo:#unwindBlock yourself.'.
].
s nextPutAll:'^ retVal'; cr.
@@ -1016,17 +1025,17 @@
save := Compiler stcCompilation.
Compiler stcCompilation:#never.
[
- Class withoutUpdatingChangesDo:[
- trapMethod := Compiler compile:src
- forClass:UndefinedObject
- inCategory:aMethod category
- notifying:nil
- install:false
- skipIfSame:false
- silent:true.
- ]
+ Class withoutUpdatingChangesDo:[
+ trapMethod := Compiler compile:src
+ forClass:UndefinedObject
+ inCategory:aMethod category
+ notifying:nil
+ install:false
+ skipIfSame:false
+ silent:true.
+ ]
] valueNowOrOnUnwindDo:[
- Compiler stcCompilation:save
+ Compiler stcCompilation:save
].
trapMethod changeClassTo:WrappedMethod.
@@ -1036,14 +1045,14 @@
"
lits := trapMethod basicLiterals.
entryBlock notNil ifTrue:[
- lits at:(lits indexOf:#entryBlock) put:entryBlock.
+ lits at:(lits indexOf:#entryBlock) put:entryBlock.
].
lits at:(lits indexOf:#originalMethod) put:aMethod.
exitBlock notNil ifTrue:[
- lits at:(lits indexOf:#exitBlock) put:exitBlock.
+ lits at:(lits indexOf:#exitBlock) put:exitBlock.
].
unwindBlock notNil ifTrue:[
- lits at:(lits indexOf:#unwindBlock) put:unwindBlock.
+ lits at:(lits indexOf:#unwindBlock) put:unwindBlock.
].
"
change the source of this new method
@@ -1053,10 +1062,10 @@
idx := class selectorArray indexOf:selector.
idx ~~ 0 ifTrue:[
- class methodArray at:idx put:trapMethod
+ class methodArray at:idx put:trapMethod
] ifFalse:[
- self halt:'oops, unexpected error'.
- ^ aMethod
+ self halt:'oops, unexpected error'.
+ ^ aMethod
].
ObjectMemory flushCaches.
@@ -1064,28 +1073,28 @@
"
MessageTracer
- wrapMethod:(Point compiledMethodAt:#scaleBy:)
- onEntry:nil
- onExit:[:con :retVal |
- Transcript show:'leave Point>>scaleBy:; returning:'.
- Transcript showCr:retVal printString.
- Transcript endEntry
- ].
+ 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
- ].
+ 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).
@@ -1097,17 +1106,17 @@
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
- ].
+ 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).
@@ -1422,8 +1431,8 @@
some are not allowed (otherwise we get into trouble ...)
"
(#(class changeClassTo:) includes:aSelector) 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 ...
@@ -1434,19 +1443,19 @@
"
orgClass := anObject class.
orgClass category == #trapping ifTrue:[
- newClass := orgClass
+ newClass := orgClass
] ifFalse:[
- myMetaclass := orgClass class.
+ myMetaclass := orgClass class.
- newClass := myMetaclass copy new.
- newClass setSuperclass:orgClass.
- newClass instSize:orgClass instSize.
- newClass flags:orgClass flags.
- newClass setClassVariableString:''.
- newClass setInstanceVariableString:''.
- newClass setName:orgClass name.
- newClass category:#trapping.
- newClass setSelectors:(Array new) methods:(Array new).
+ newClass := myMetaclass copy new.
+ newClass setSuperclass:orgClass.
+ newClass instSize:orgClass instSize.
+ newClass flags:orgClass flags.
+ newClass setClassVariableString:''.
+ newClass setInstanceVariableString:''.
+ newClass setName:orgClass name.
+ newClass category:#trapping.
+ newClass setSelectors:(Array new) methods:(Array new).
].
"
@@ -1457,50 +1466,50 @@
s nextPutAll:spec.
s nextPutAll:' |retVal stubClass| '.
withOriginalClass ifTrue:[
- s nextPutAll:'stubClass := self class. '.
- s nextPutAll:'self changeClassTo:(stubClass superclass). '.
+ s nextPutAll:'stubClass := self class. '.
+ s nextPutAll:'self changeClassTo:(stubClass superclass). '.
].
entryBlock notNil ifTrue:[
- s nextPutAll:'#literal1 yourself value:thisContext. '.
+ s nextPutAll:'#literal1 yourself value:thisContext. '.
].
s nextPutAll:('retVal := #originalMethod. '). "/ just to get a place for the origianlMethod
s nextPutAll:('retVal := super ' , spec , '. ').
exitBlock notNil ifTrue:[
- s nextPutAll:'#literal2 yourself value:thisContext value:retVal. '.
+ s nextPutAll:'#literal2 yourself value:thisContext value:retVal. '.
].
withOriginalClass ifTrue:[
- s nextPutAll:'self changeClassTo:stubClass. '.
+ s nextPutAll:'self changeClassTo:stubClass. '.
].
s nextPutAll:'^ retVal'; cr.
save := Compiler stcCompilation.
Compiler stcCompilation:#never.
[
- Class withoutUpdatingChangesDo:[
- trapMethod := Compiler compile:s contents
- forClass:newClass
- inCategory:'breakpointed'
- notifying:nil
- install:false
- skipIfSame:false
- silent:true.
- ]
+ Class withoutUpdatingChangesDo:[
+ trapMethod := Compiler compile:s contents
+ forClass:newClass
+ inCategory:'breakpointed'
+ notifying:nil
+ install:false
+ skipIfSame:false
+ silent:true.
+ ]
] valueNowOrOnUnwindDo:[
- Compiler stcCompilation:save
+ Compiler stcCompilation:save
].
lits := trapMethod literals.
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:[
- lits at:(lits indexOf:#originalMethod) put:(implClass compiledMethodAt:aSelector).
+ lits at:(lits indexOf:#originalMethod) put:(implClass compiledMethodAt:aSelector).
].
entryBlock notNil ifTrue:[
- lits at:(lits indexOf:#literal1) put:entryBlock.
+ lits at:(lits indexOf:#literal1) put:entryBlock.
].
exitBlock notNil ifTrue:[
- lits at:(lits indexOf:#literal2) put:exitBlock.
+ lits at:(lits indexOf:#literal2) put:exitBlock.
].
"
change the source of this new method
@@ -1513,8 +1522,8 @@
install this new method
"
newClass
- setSelectors:(newClass selectorArray copyWith:aSelector)
- methods:(newClass methodArray copyWith:trapMethod).
+ setSelectors:(newClass selectorArray copyWith:aSelector)
+ methods:(newClass methodArray copyWith:trapMethod).
"
and finally, the big trick:
@@ -1526,14 +1535,14 @@
p := Point new copy.
MessageTracer
- wrap:p
- Selector:#y:
- onEntry:nil
- onExit:[:retVal |
- Transcript show:'leave Point>>x:, returning:'.
- Transcript showCr:retVal printString.
- Transcript endEntry
- ].
+ wrap:p
+ Selector:#y:
+ onEntry:nil
+ onExit:[:retVal |
+ Transcript show:'leave Point>>x:, returning:'.
+ Transcript showCr:retVal printString.
+ Transcript endEntry
+ ].
Transcript showCr:'sending x: ...'.
p x:1.
Transcript showCr:'sending y: ...'.
@@ -1550,9 +1559,9 @@
p := Point new copy.
MessageTracer wrap:p
- Selector:#y:
- onEntry:[:context | self halt:'you are trapped']
- onExit:nil.
+ Selector:#y:
+ onEntry:[:context | self halt:'you are trapped']
+ onExit:nil.
Transcript showCr:'sending x: ...'.
p x:1.
Transcript showCr:'sending y: ...'.
@@ -1674,6 +1683,6 @@
!MessageTracer class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.31 1995-12-19 09:52:40 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.32 1996-01-06 18:23:58 cg Exp $'
! !
MessageTracer initialize!