--- a/Method.st Thu Sep 28 21:25:55 2000 +0200
+++ b/Method.st Fri Sep 29 10:13:26 2000 +0200
@@ -168,16 +168,16 @@
"create signals"
PrivateMethodSignal isNil ifTrue:[
- "EXPERIMENTAL"
- PrivateMethodSignal := ExecutionErrorSignal newSignalMayProceed:true.
- PrivateMethodSignal nameClass:self message:#privateMethodSignal.
- PrivateMethodSignal notifierString:'attempt to execute private/protected method'.
+ "EXPERIMENTAL"
+ PrivateMethodSignal := ExecutionErrorSignal newSignalMayProceed:true.
+ PrivateMethodSignal nameClass:self message:#privateMethodSignal.
+ PrivateMethodSignal notifierString:'attempt to execute private/protected method'.
].
LastFileLock isNil ifTrue:[
- LastFileLock := Semaphore forMutualExclusion name:'LastFileLock'.
- LastFileReference := WeakArray new:1.
- LastFileReference at:1 put:0.
+ LastFileLock := Semaphore forMutualExclusion name:'LastFileLock'.
+ LastFileReference := WeakArray new:1.
+ LastFileReference at:1 put:0.
].
CompilationLock := RecursionLock new name:'MethodCompilation'.
@@ -421,7 +421,7 @@
mclass:aClass
mclass notNil ifTrue:[
- 'Method [warning]: mclass already set' errorPrintCR.
+ 'Method [warning]: mclass already set' errorPrintCR.
].
mclass := aClass.
!
@@ -433,7 +433,7 @@
package notNil ifTrue:[ ^ package ].
(cls := self mclass) isNil ifTrue:[
- ^ ''
+ ^ ''
].
^ cls package ? ''
@@ -996,9 +996,9 @@
doMachineCode := Compiler stcCompilation:#never.
[
- mthd := self asExecutableMethodWithSource:newSource.
+ mthd := self asExecutableMethodWithSource:newSource.
] valueNowOrOnUnwindDo:[
- Compiler stcCompilation:doMachineCode.
+ Compiler stcCompilation:doMachineCode.
].
^ mthd
@@ -1018,21 +1018,21 @@
|temporaryMethod cls sourceString silent lazy|
byteCode notNil ifTrue:[
- "
- is already a bytecoded method
- "
- ^ self
+ "
+ is already a bytecoded method
+ "
+ ^ self
].
cls := self containingClass.
cls isNil ifTrue:[
- 'Method [warning]: cannot generate bytecode (no class for compilation)' errorPrintCR.
- ^ nil
+ 'Method [warning]: cannot generate bytecode (no class for compilation)' errorPrintCR.
+ ^ nil
].
sourceString := self source.
sourceString isNil ifTrue:[
- 'Method [warning]: cannot generate bytecode (no source for compilation)' errorPrintCR.
- ^ nil
+ 'Method [warning]: cannot generate bytecode (no source for compilation)' errorPrintCR.
+ ^ nil
].
"we have to sequentialize this using a lock-semaphore,
@@ -1042,51 +1042,51 @@
(happened when autoloading animation demos)
"
CompilationLock critical:[
- "
- dont want this to go into the changes file,
- dont want output on Transcript and definitely
- dont want a lazy method ...
- "
- Class withoutUpdatingChangesDo:[
- silent := Smalltalk silentLoading:true.
- lazy := Compiler compileLazy:false.
-
- [
- |compiler|
-
- Class nameSpaceQuerySignal answer:(cls nameSpace)
- do:[
- compiler := cls compilerClass.
-
- "/
- "/ kludge - have to make ST/X's compiler protocol
- "/ be compatible to ST-80's
- "/
- (compiler respondsTo:#compile:forClass:inCategory:notifying:install:)
- ifTrue:[
- temporaryMethod := compiler
- compile:sourceString
- forClass:cls
- inCategory:(self category)
- notifying:nil
- install:false.
- ] ifFalse:[
- temporaryMethod := compiler new
- compile:sourceString
- in:cls
- notifying:nil
- ifFail:nil
- ].
- ].
- ] valueNowOrOnUnwindDo:[
- Compiler compileLazy:lazy.
- Smalltalk silentLoading:silent.
- ]
- ].
+ "
+ dont want this to go into the changes file,
+ dont want output on Transcript and definitely
+ dont want a lazy method ...
+ "
+ Class withoutUpdatingChangesDo:[
+ silent := Smalltalk silentLoading:true.
+ lazy := Compiler compileLazy:false.
+
+ [
+ |compiler|
+
+ Class nameSpaceQuerySignal answer:(cls nameSpace)
+ do:[
+ compiler := cls compilerClass.
+
+ "/
+ "/ kludge - have to make ST/X's compiler protocol
+ "/ be compatible to ST-80's
+ "/
+ (compiler respondsTo:#compile:forClass:inCategory:notifying:install:)
+ ifTrue:[
+ temporaryMethod := compiler
+ compile:sourceString
+ forClass:cls
+ inCategory:(self category)
+ notifying:nil
+ install:false.
+ ] ifFalse:[
+ temporaryMethod := compiler new
+ compile:sourceString
+ in:cls
+ notifying:nil
+ ifFail:nil
+ ].
+ ].
+ ] valueNowOrOnUnwindDo:[
+ Compiler compileLazy:lazy.
+ Smalltalk silentLoading:silent.
+ ]
+ ].
].
(temporaryMethod isNil or:[temporaryMethod == #Error]) ifTrue:[
- 'Method [warning]: cannot generate bytecode (contains primitive code or error)' errorPrintCR.
- ^ nil.
+ 'Method [warning]: cannot generate bytecode (contains primitive code or error)' errorPrintCR.
+ ^ nil.
].
"/
"/ try to save a bit of memory, by sharing the source (whatever it is)
@@ -1108,8 +1108,8 @@
cls := self containingClass.
cls isNil ifTrue:[
- 'Method [warning]: cannot generate bytecode (no class for compilation)' errorPrintCR.
- ^ nil
+ 'Method [warning]: cannot generate bytecode (no class for compilation)' errorPrintCR.
+ ^ nil
].
"we have to sequentialize this using a lock-semaphore,
@@ -1119,51 +1119,51 @@
(happened when autoloading animation demos)
"
CompilationLock critical:[
- "
- dont want this to go into the changes file,
- dont want output on Transcript and definitely
- dont want a lazy method ...
- "
- Class withoutUpdatingChangesDo:[
- silent := Smalltalk silentLoading:true.
- lazy := Compiler compileLazy:false.
-
- [
- |compiler|
-
- Class nameSpaceQuerySignal answer:(cls nameSpace)
- do:[
- compiler := cls compilerClass.
-
- "/
- "/ kludge - have to make ST/X's compiler protocol
- "/ be compatible to ST-80's
- "/
- (compiler respondsTo:#compile:forClass:inCategory:notifying:install:)
- ifTrue:[
- temporaryMethod := compiler
- compile:newSource
- forClass:cls
- inCategory:(self category)
- notifying:nil
- install:false.
- ] ifFalse:[
- temporaryMethod := compiler new
- compile:newSource
- in:cls
- notifying:nil
- ifFail:nil
- ].
- ].
- ] valueNowOrOnUnwindDo:[
- Compiler compileLazy:lazy.
- Smalltalk silentLoading:silent.
- ]
- ].
+ "
+ dont want this to go into the changes file,
+ dont want output on Transcript and definitely
+ dont want a lazy method ...
+ "
+ Class withoutUpdatingChangesDo:[
+ silent := Smalltalk silentLoading:true.
+ lazy := Compiler compileLazy:false.
+
+ [
+ |compiler|
+
+ Class nameSpaceQuerySignal answer:(cls nameSpace)
+ do:[
+ compiler := cls compilerClass.
+
+ "/
+ "/ kludge - have to make ST/X's compiler protocol
+ "/ be compatible to ST-80's
+ "/
+ (compiler respondsTo:#compile:forClass:inCategory:notifying:install:)
+ ifTrue:[
+ temporaryMethod := compiler
+ compile:newSource
+ forClass:cls
+ inCategory:(self category)
+ notifying:nil
+ install:false.
+ ] ifFalse:[
+ temporaryMethod := compiler new
+ compile:newSource
+ in:cls
+ notifying:nil
+ ifFail:nil
+ ].
+ ].
+ ] valueNowOrOnUnwindDo:[
+ Compiler compileLazy:lazy.
+ Smalltalk silentLoading:silent.
+ ]
+ ].
].
(temporaryMethod isNil or:[temporaryMethod == #Error]) ifTrue:[
- 'Method [warning]: cannot generate bytecode (contains primitive code or error)' errorPrintCR.
- ^ nil.
+ 'Method [warning]: cannot generate bytecode (contains primitive code or error)' errorPrintCR.
+ ^ nil.
].
"/
"/ try to save a bit of memory, by sharing the source (whatever it is)
@@ -1754,42 +1754,42 @@
privInfo := ''.
self isWrapped ifTrue:[
- (MessageTracer isCounting:self) ifTrue:[
- (MessageTracer isCountingMemoryUsage:self) ifTrue:[
- moreInfo := moreInfo ,
- ' (mem usage avg: ' , (MessageTracer memoryUsageOfMethod:self) printString asText allBold , ' bytes)'.
- ] ifFalse:[
- moreInfo := moreInfo ,
- ' (called ' , (MessageTracer executionCountOfMethod:self) printString asText allBold , ' times)'.
- ]
- ] ifFalse:[
- (MessageTracer isTiming:self) ifTrue:[
- i := MessageTracer executionTimesOfMethod:self.
- (i isNil or:[(n := i at:#count) == 0]) ifTrue:[
- moreInfo := moreInfo ,
- ' (cnt: ' , (i at:#count) printString , ')'
- ] ifFalse:[
- n == 1 ifTrue:[
- moreInfo := moreInfo ,
- ' (t: ' , (i at:#avgTime) printString asText allBold,
- 'ms cnt: ' , (i at:#count) printString , ')'
- ] ifFalse:[
- moreInfo := moreInfo ,
- ' (avg: ' , (i at:#avgTime) printString asText allBold,
- 'ms min: ' , (i at:#minTime) printString ,
- ' max: ' , (i at:#maxTime) printString ,
- ' cnt: ' , (i at:#count) printString , ')'
- ].
- ].
- ] ifFalse:[
- moreInfo := ' !!'
- ]
- ].
+ (MessageTracer isCounting:self) ifTrue:[
+ (MessageTracer isCountingMemoryUsage:self) ifTrue:[
+ moreInfo := moreInfo ,
+ ' (mem usage avg: ' , (MessageTracer memoryUsageOfMethod:self) printString asText allBold , ' bytes)'.
+ ] ifFalse:[
+ moreInfo := moreInfo ,
+ ' (called ' , (MessageTracer executionCountOfMethod:self) printString asText allBold , ' times)'.
+ ]
+ ] ifFalse:[
+ (MessageTracer isTiming:self) ifTrue:[
+ i := MessageTracer executionTimesOfMethod:self.
+ (i isNil or:[(n := i at:#count) == 0]) ifTrue:[
+ moreInfo := moreInfo ,
+ ' (cnt: ' , (i at:#count) printString , ')'
+ ] ifFalse:[
+ n == 1 ifTrue:[
+ moreInfo := moreInfo ,
+ ' (t: ' , (i at:#avgTime) printString asText allBold,
+ 'ms cnt: ' , (i at:#count) printString , ')'
+ ] ifFalse:[
+ moreInfo := moreInfo ,
+ ' (avg: ' , (i at:#avgTime) printString asText allBold,
+ 'ms min: ' , (i at:#minTime) printString ,
+ ' max: ' , (i at:#maxTime) printString ,
+ ' cnt: ' , (i at:#count) printString , ')'
+ ].
+ ].
+ ] ifFalse:[
+ moreInfo := ' !!'
+ ]
+ ].
].
p := self privacy.
p ~~ #public ifTrue:[
- privInfo := (' (* ' , p , ' *)') asText emphasizeAllWith:#italic.
+ privInfo := (' (* ' , p , ' *)') asText emphasizeAllWith:#italic.
].
"/ self isInvalid ifTrue:[
@@ -1797,19 +1797,19 @@
"/ ].
(self isLazyMethod not and:[self isUnloaded]) ifTrue:[
- moreInfo := ' (** unloaded **)'
+ moreInfo := ' (** unloaded **)'
].
privInfo size ~~ 0 ifTrue:[
- moreInfo := privInfo , ' ' , moreInfo
+ moreInfo := privInfo , ' ' , moreInfo
].
s := selector.
(cls := aClass) isNil ifTrue:[
- cls := self containingClass
+ cls := self containingClass
].
(cls isNil or:[self package ~= cls package]) ifTrue:[
- s := s , ' [' , (self package asText emphasizeAllWith:(Array with:#italic with:(#color->Color red darkened))), ']'
+ s := s , ' [' , (self package asText emphasizeAllWith:(Array with:#italic with:(#color->Color red darkened))), ']'
].
moreInfo size == 0 ifTrue:[^ s].
@@ -1817,7 +1817,7 @@
s := selector , moreInfo.
self isInvalid ifTrue:[
- s := s asText emphasizeAllWith:#color->Color red.
+ s := s asText emphasizeAllWith:#color->Color red.
].
^ s
@@ -1856,10 +1856,10 @@
#ifdef F_PRIMITIVE
INT f = __intVal(__INST(flags));
- INT nr = nil;
+ INT nr = 0;
if (f & F_PRIMITIVE) {
- nr = __INST(code_);
+ nr = __INST(code_);
}
RETURN (nr);
#endif
@@ -1975,10 +1975,10 @@
src := self source.
src notNil ifTrue:[
- (src includesString:(String with:$% with:${) "<- no constant here - to avoid trouble with stupid scanners" ) ifFalse:[
- "/ cannot contain primitive code.
- ^ false
- ]
+ (src includesString:(String with:$% with:${) "<- no constant here - to avoid trouble with stupid scanners" ) ifFalse:[
+ "/ cannot contain primitive code.
+ ^ false
+ ]
].
"/ ok; it may or may not ...
@@ -2238,7 +2238,7 @@
"
(Method compiledMethodAt:#parse:return:or:)
- parse:#'parseMethodSilent:' return:#sentMessages or:#()
+ parse:#'parseMethodSilent:' return:#sentMessages or:#()
"
!
@@ -2251,19 +2251,19 @@
sourceString := self source.
sourceString notNil ifTrue:[
- parseSelector numArgs == 2 ifTrue:[
- parser := Parser perform:parseSelector with:sourceString with:arg2.
- ] ifFalse:[
- parser := Parser perform:parseSelector with:sourceString.
- ].
- (parser isNil or:[parser == #Error]) ifTrue:[^ valueIfNoSource].
- ^ parser perform:accessSelector
+ parseSelector numArgs == 2 ifTrue:[
+ parser := Parser perform:parseSelector with:sourceString with:arg2.
+ ] ifFalse:[
+ parser := Parser perform:parseSelector with:sourceString.
+ ].
+ (parser isNil or:[parser == #Error]) ifTrue:[^ valueIfNoSource].
+ ^ parser perform:accessSelector
].
^ valueIfNoSource
"
(Method compiledMethodAt:#parse:return:or:)
- parse:#'parseMethodSilent:' return:#sentMessages or:#()
+ parse:#'parseMethodSilent:' return:#sentMessages or:#()
"
!
@@ -2274,16 +2274,16 @@
history isNil ifTrue:[^ nil].
entry := history detect:[:entry | |type old new|
- type := entry first.
- type == #methodChange ifTrue:[
- old := entry second.
- new := entry third.
- new == self
- ] ifFalse:[
- false
- ]
- ]
- ifNone:nil.
+ type := entry first.
+ type == #methodChange ifTrue:[
+ old := entry second.
+ new := entry third.
+ new == self
+ ] ifFalse:[
+ false
+ ]
+ ]
+ ifNone:nil.
entry isNil ifTrue:[^nil].
^ entry second.
"/ ^ history at:self ifAbsent:nil
@@ -2378,7 +2378,7 @@
with aSelectorSymbol as selector."
(self referencesLiteral:aSelectorSymbol) ifTrue:[
- ^ self messagesSent includesIdentical:aSelectorSymbol
+ ^ self messagesSent includesIdentical:aSelectorSymbol
].
^ false
!
@@ -2412,38 +2412,38 @@
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
- ].
+ sel := mclass selectorAtMethod:self.
+ sel notNil ifTrue:[
+ ^ MethodWhoInfo class:mclass selector:sel
+ ].
].
"
@@ -2451,23 +2451,23 @@
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
+ ].
+ ]
+ ].
].
"
@@ -2477,19 +2477,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
+ ].
+ ]
].
"
@@ -2501,23 +2501,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.
@@ -2526,14 +2526,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
@@ -2552,11 +2552,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.
@@ -2775,6 +2775,6 @@
!Method class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.209 2000-09-27 07:47:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.210 2000-09-29 08:13:26 cg Exp $'
! !
Method initialize!