compile without updating changes-file (also disables historyManager for the wrap)
--- a/MessageTracer.st Wed Dec 13 14:32:46 1995 +0100
+++ b/MessageTracer.st Wed Dec 13 16:10:39 1995 +0100
@@ -11,11 +11,11 @@
"
Object subclass:#MessageTracer
- instanceVariableNames:'traceDetail'
- classVariableNames:'BreakpointSignal CallingLevel BreakBlock TraceSenderBlock
- LeaveBlock'
- poolDictionaries:''
- category:'System-Debugging-Support'
+ instanceVariableNames:'traceDetail'
+ classVariableNames:'BreakpointSignal CallingLevel BreakBlock TraceSenderBlock
+ LeaveBlock'
+ poolDictionaries:''
+ category:'System-Debugging-Support'
!
!MessageTracer class methodsFor:'documentation'!
@@ -263,34 +263,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.
[
- 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
@@ -302,67 +304,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.
@@ -374,23 +376,25 @@
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.
Transcript showCr:'5 factorial normal'.
5 factorial.
"
+
+ "Modified: 13.12.1995 / 16:05:26 / cg"
! !
!MessageTracer class methodsFor:'cleanup'!
@@ -732,10 +736,10 @@
but only if not already being trapped.
"
(aMethod isNil or:[aMethod isWrapped]) ifTrue:[
- ^ aMethod
+ ^ aMethod
].
aMethod isLazyMethod ifTrue:[
- aMethod makeRealMethod
+ aMethod makeRealMethod
].
"
@@ -743,8 +747,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.
@@ -763,7 +767,7 @@
s nextPutAll:spec.
s nextPutAll:' |retVal| '.
entryBlock notNil ifTrue:[
- s nextPutAll:'#entryBlock yourself value:thisContext. '.
+ s nextPutAll:'#entryBlock yourself value:thisContext. '.
].
s nextPutAll:'retVal := #originalMethod yourself';
nextPutAll: ' valueWithReceiver:(thisContext receiver)';
@@ -773,7 +777,7 @@
nextPutAll: ' sender:nil. '.
exitBlock notNil ifTrue:[
- s nextPutAll:'#exitBlock yourself value:thisContext value:retVal.'.
+ s nextPutAll:'#exitBlock yourself value:thisContext value:retVal.'.
].
s nextPutAll:'^ retVal'; cr.
@@ -781,15 +785,17 @@
save := Compiler stcCompilation.
Compiler stcCompilation:#never.
[
- 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.
@@ -799,11 +805,11 @@
"
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.
].
"
change the source of this new method
@@ -813,10 +819,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.
@@ -824,28 +830,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).
@@ -857,23 +863,25 @@
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).
Transcript showCr:'5 factorial normal'.
5 factorial.
"
+
+ "Modified: 13.12.1995 / 16:06:22 / cg"
! !
!MessageTracer class methodsFor:'object breakpointing'!
@@ -1179,8 +1187,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 ...
@@ -1191,19 +1199,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).
].
"
@@ -1214,48 +1222,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.
[
- 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
@@ -1268,8 +1278,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:
@@ -1281,14 +1291,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: ...'.
@@ -1305,9 +1315,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: ...'.
@@ -1318,6 +1328,8 @@
Transcript showCr:'sending y: ...'.
p y:1.
"
+
+ "Modified: 13.12.1995 / 16:06:56 / cg"
!
wrap:anObject selectors:aCollection onEntry:entryBlock onExit:exitBlock
@@ -1427,6 +1439,6 @@
!MessageTracer class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.25 1995-12-09 15:07:00 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.26 1995-12-13 15:10:39 cg Exp $'
! !
MessageTracer initialize!
--- a/MsgTracer.st Wed Dec 13 14:32:46 1995 +0100
+++ b/MsgTracer.st Wed Dec 13 16:10:39 1995 +0100
@@ -11,11 +11,11 @@
"
Object subclass:#MessageTracer
- instanceVariableNames:'traceDetail'
- classVariableNames:'BreakpointSignal CallingLevel BreakBlock TraceSenderBlock
- LeaveBlock'
- poolDictionaries:''
- category:'System-Debugging-Support'
+ instanceVariableNames:'traceDetail'
+ classVariableNames:'BreakpointSignal CallingLevel BreakBlock TraceSenderBlock
+ LeaveBlock'
+ poolDictionaries:''
+ category:'System-Debugging-Support'
!
!MessageTracer class methodsFor:'documentation'!
@@ -263,34 +263,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.
[
- 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
@@ -302,67 +304,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.
@@ -374,23 +376,25 @@
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.
Transcript showCr:'5 factorial normal'.
5 factorial.
"
+
+ "Modified: 13.12.1995 / 16:05:26 / cg"
! !
!MessageTracer class methodsFor:'cleanup'!
@@ -732,10 +736,10 @@
but only if not already being trapped.
"
(aMethod isNil or:[aMethod isWrapped]) ifTrue:[
- ^ aMethod
+ ^ aMethod
].
aMethod isLazyMethod ifTrue:[
- aMethod makeRealMethod
+ aMethod makeRealMethod
].
"
@@ -743,8 +747,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.
@@ -763,7 +767,7 @@
s nextPutAll:spec.
s nextPutAll:' |retVal| '.
entryBlock notNil ifTrue:[
- s nextPutAll:'#entryBlock yourself value:thisContext. '.
+ s nextPutAll:'#entryBlock yourself value:thisContext. '.
].
s nextPutAll:'retVal := #originalMethod yourself';
nextPutAll: ' valueWithReceiver:(thisContext receiver)';
@@ -773,7 +777,7 @@
nextPutAll: ' sender:nil. '.
exitBlock notNil ifTrue:[
- s nextPutAll:'#exitBlock yourself value:thisContext value:retVal.'.
+ s nextPutAll:'#exitBlock yourself value:thisContext value:retVal.'.
].
s nextPutAll:'^ retVal'; cr.
@@ -781,15 +785,17 @@
save := Compiler stcCompilation.
Compiler stcCompilation:#never.
[
- 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.
@@ -799,11 +805,11 @@
"
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.
].
"
change the source of this new method
@@ -813,10 +819,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.
@@ -824,28 +830,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).
@@ -857,23 +863,25 @@
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).
Transcript showCr:'5 factorial normal'.
5 factorial.
"
+
+ "Modified: 13.12.1995 / 16:06:22 / cg"
! !
!MessageTracer class methodsFor:'object breakpointing'!
@@ -1179,8 +1187,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 ...
@@ -1191,19 +1199,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).
].
"
@@ -1214,48 +1222,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.
[
- 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
@@ -1268,8 +1278,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:
@@ -1281,14 +1291,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: ...'.
@@ -1305,9 +1315,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: ...'.
@@ -1318,6 +1328,8 @@
Transcript showCr:'sending y: ...'.
p y:1.
"
+
+ "Modified: 13.12.1995 / 16:06:56 / cg"
!
wrap:anObject selectors:aCollection onEntry:entryBlock onExit:exitBlock
@@ -1427,6 +1439,6 @@
!MessageTracer class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/Attic/MsgTracer.st,v 1.25 1995-12-09 15:07:00 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/Attic/MsgTracer.st,v 1.26 1995-12-13 15:10:39 cg Exp $'
! !
MessageTracer initialize!