--- a/MessageTracer.st Thu Sep 22 15:13:59 2016 +0200
+++ b/MessageTracer.st Fri Sep 30 16:45:41 2016 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
@@ -354,47 +356,47 @@
"
spec := Parser methodSpecificationForSelector:aSelector.
- s := WriteStream on:String new.
+ s := WriteStream on:''.
s nextPutAll:spec.
s cr.
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.
- ]
- ].
+ 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.
].
"
@@ -411,31 +413,31 @@
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.
@@ -443,30 +445,30 @@
"
MessageTracer
- wrapClass:Point
- selector:#scaleBy:
- onEntry:nil
- onExit:[:con :retVal |
- Transcript show:'leave Point>>scaleBy:; returning:'.
- Transcript showCR:retVal printString.
- Transcript endEntry
- ].
+ 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
- ].
+ 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.
@@ -478,18 +480,18 @@
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
- ].
+ 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.
@@ -1455,7 +1457,7 @@
"
create a method, executing the trap-blocks and the original method via a direct call
"
- s := WriteStream on:String new.
+ s := WriteStream on:''.
s nextPutAll:spec.
s nextPutAll:' <context: #return>'.
s nextPutAll:' |retVal context| '.
@@ -2160,10 +2162,10 @@
but only if not already being trapped.
"
(aMethod isNil or:[aMethod isWrapped]) ifTrue:[
- ^ aMethod
+ ^ aMethod
].
aMethod isLazyMethod ifTrue:[
- aMethod makeRealMethod
+ aMethod makeRealMethod
].
"
@@ -2171,8 +2173,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.
@@ -2183,23 +2185,23 @@
"
xselector := '_x'.
aMethod numArgs timesRepeat:[
- xselector := xselector , '_:'
+ xselector := xselector , '_:'
].
spec := Parser methodSpecificationForSelector:xselector.
"
create a method, executing the trap-blocks and the original method via a direct call
"
- s := WriteStream on:String new.
+ s := WriteStream on:''.
s nextPutAll:spec.
s nextPutAll:' <context: #return>'.
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)';
@@ -2209,34 +2211,34 @@
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.
- ].
- ].
+ 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.
@@ -2246,14 +2248,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
@@ -2265,8 +2267,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.
@@ -2275,34 +2277,34 @@
class changed:#methodTrap with:selector. "/ tell browsers
MethodTrapChangeNotificationParameter notNil ifTrue:[
- Smalltalk changed:#methodTrap with:(MethodTrapChangeNotificationParameter changeClass:class changeSelector:selector).
+ 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
- ].
+ 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).
@@ -2314,17 +2316,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).
@@ -3114,7 +3116,7 @@
create a method, executing the trap-blocks and the original method via a super-send
"
spec := Parser methodSpecificationForSelector:aSelector.
- s := WriteStream on:String new.
+ s := WriteStream on:''.
s nextPutAll:spec.
s nextPutAll:' <context: #return>'.
s nextPutAll:' |retVal stubClass '.