--- a/Method.st Fri Mar 24 13:50:43 2000 +0100
+++ b/Method.st Fri Mar 24 13:53:35 2000 +0100
@@ -417,6 +417,13 @@
].
!
+mclass:aClass
+ mclass notNil ifTrue:[
+ 'Method [warning]: mclass already set' errorPrintCR.
+ ].
+ mclass := aClass.
+!
+
package
"return the package-symbol"
@@ -1784,6 +1791,8 @@
|who|
+ mclass notNil ifTrue:[^ mclass].
+
who := self who.
who notNil ifTrue:[^ who methodClass].
"
@@ -2164,55 +2173,62 @@
nil is returned for unbound methods.
ST/X special notice:
- returns an instance of MethodWhoInfo, which
- responds to #methodClass and #methodSelector query messages.
- For backward- (& ST-80) compatibility, the returned object also
- responds to #at:1 and #at:2 messages.
+ returns an instance of MethodWhoInfo, which
+ responds to #methodClass and #methodSelector query messages.
+ For backward- (& ST-80) compatibility, the returned object also
+ responds to #at:1 and #at:2 messages.
Implementation notice:
- Since there is no information of the containing class
- in the method, we have to do a search here.
-
- Normally, this is not a problem, except when a method is
- accepted in the debugger or redefined from within a method
- (maybe done indirectly, if #doIt is done recursively)
- - the information about which class the original method was
- defined in is lost in this case.
+ Since there is no information of the containing class
+ in the method, we have to do a search here.
+
+ Normally, this is not a problem, except when a method is
+ accepted in the debugger or redefined from within a method
+ (maybe done indirectly, if #doIt is done recursively)
+ - the information about which class the original method was
+ defined in is lost in this case.
Problem:
- this is heavily called for in the debugger to create
- a readable context walkback. For unbound methods, it is
- slow, since the search (over all classes) will always fail.
+ this is heavily called for in the debugger to create
+ a readable context walkback. For unbound methods, it is
+ slow, since the search (over all classes) will always fail.
Q: should we add a backref from the method to the class
- and/or add a subclass of Method for unbound ones ?
+ and/or add a subclass of Method for unbound ones ?
Q2: if so, what about the bad guy then, who copies methods around to
- other classes ?"
+ other classes ?"
|classes cls sel fn clsName|
+ mclass notNil ifTrue:[
+ sel := mclass selectorAtMethod:self.
+ sel notNil ifTrue:[
+ ^ MethodWhoInfo class:mclass selector:sel
+ ].
+ ].
+
"
speedup kludge: if my sourceFileName is valid,
extract the className from it and try that class first.
"
(fn := self sourceFilename) notNil ifTrue:[
- clsName := fn asFilename withoutSuffix name.
- clsName := clsName asSymbolIfInterned.
- clsName notNil ifTrue:[
- cls := Smalltalk at:clsName ifAbsent:nil.
- cls notNil ifTrue:[
- sel := cls selectorAtMethod:self.
- sel notNil ifTrue:[
- ^ MethodWhoInfo class:cls selector:sel
- ].
-
- cls := cls class.
- sel := cls selectorAtMethod:self.
- sel notNil ifTrue:[
- ^ MethodWhoInfo class:cls selector:sel
- ].
- ]
- ].
+ clsName := fn asFilename withoutSuffix name.
+ clsName := clsName asSymbolIfInterned.
+ clsName notNil ifTrue:[
+ cls := Smalltalk at:clsName ifAbsent:nil.
+ cls notNil ifTrue:[
+ sel := cls selectorAtMethod:self.
+ sel notNil ifTrue:[
+ ^ MethodWhoInfo class:cls selector:sel
+ ].
+
+ cls := cls class.
+ sel := cls selectorAtMethod:self.
+ sel notNil ifTrue:[
+ ^ MethodWhoInfo class:cls selector:sel
+ ].
+ ]
+ ].
].
"
@@ -2222,19 +2238,19 @@
being garbage collected)
"
LastWhoClass notNil ifTrue:[
- cls := Smalltalk at:LastWhoClass ifAbsent:nil.
- cls notNil ifTrue:[
- sel := cls selectorAtMethod:self.
- sel notNil ifTrue:[
- ^ MethodWhoInfo class:cls selector:sel
- ].
-
- cls := cls class.
- sel := cls selectorAtMethod:self.
- sel notNil ifTrue:[
- ^ MethodWhoInfo class:cls selector:sel
- ].
- ]
+ cls := Smalltalk at:LastWhoClass ifAbsent:nil.
+ cls notNil ifTrue:[
+ sel := cls selectorAtMethod:self.
+ sel notNil ifTrue:[
+ ^ MethodWhoInfo class:cls selector:sel
+ ].
+
+ cls := cls class.
+ sel := cls selectorAtMethod:self.
+ sel notNil ifTrue:[
+ ^ MethodWhoInfo class:cls selector:sel
+ ].
+ ]
].
"
@@ -2246,23 +2262,23 @@
instance methods are usually more common - search those first
"
classes do:[:aClass |
- |sel|
-
- sel := aClass selectorAtMethod:self ifAbsent:nil.
- sel notNil ifTrue:[
- LastWhoClass := aClass theNonMetaclass name.
- ^ MethodWhoInfo class:aClass selector:sel
- ].
+ |sel|
+
+ sel := aClass selectorAtMethod:self ifAbsent:nil.
+ sel notNil ifTrue:[
+ LastWhoClass := aClass theNonMetaclass name.
+ ^ MethodWhoInfo class:aClass selector:sel
+ ].
].
classes do:[:aClass |
- |sel|
-
- sel := aClass class selectorAtMethod:self.
- sel notNil ifTrue:[
- LastWhoClass := aClass theNonMetaclass name.
- ^ MethodWhoInfo class:aClass class selector:sel
- ].
+ |sel|
+
+ sel := aClass class selectorAtMethod:self.
+ sel notNil ifTrue:[
+ LastWhoClass := aClass theNonMetaclass name.
+ ^ MethodWhoInfo class:aClass class selector:sel
+ ].
].
LastWhoClass := nil.
@@ -2271,14 +2287,14 @@
in the Smalltalk dictionary). Search all instances of Behavior
"
Behavior allSubInstancesDo:[:someClass |
- |sel|
-
- (classes includes:someClass) ifFalse:[
- sel := someClass selectorAtMethod:self.
- sel notNil ifTrue:[
- ^ MethodWhoInfo class:someClass selector:sel
- ]
- ]
+ |sel|
+
+ (classes includes:someClass) ifFalse:[
+ sel := someClass selectorAtMethod:self.
+ sel notNil ifTrue:[
+ ^ MethodWhoInfo class:someClass selector:sel
+ ]
+ ]
].
"
none found - sorry
@@ -2297,11 +2313,11 @@
|m cls|
Object
- subclass:#FunnyClass
- instanceVariableNames:'foo'
- classVariableNames:''
- poolDictionaries:''
- category:'testing'.
+ subclass:#FunnyClass
+ instanceVariableNames:'foo'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'testing'.
cls := Smalltalk at:#FunnyClass.
Smalltalk removeClass:cls.
@@ -2509,6 +2525,6 @@
!Method class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.186 2000-03-24 11:54:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.187 2000-03-24 12:53:35 cg Exp $'
! !
Method initialize!