--- a/Method.st Wed Oct 15 14:31:32 1997 +0200
+++ b/Method.st Wed Oct 15 14:32:25 1997 +0200
@@ -71,26 +71,26 @@
[Instance variables:]
- source <String> the source itself (if sourcePosition isNil)
- or the fileName where the source is found
-
- sourcePosition <Integer> the position of the methods chunk in the file
-
- category <Symbol> the methods category
- package <Symbol> the package, in which the methods was defined
+ source <String> the source itself (if sourcePosition isNil)
+ or the fileName where the source is found
+
+ sourcePosition <Integer> the position of the methods chunk in the file
+
+ category <Symbol> the methods category
+ package <Symbol> the package, in which the methods was defined
[Class variables:]
- PrivateMethodSignal raised on privacy violation (see docu)
-
- LastFileReference weak reference to the last sourceFile
- LastSourceFileName to speedup source access via NFS
+ PrivateMethodSignal raised on privacy violation (see docu)
+
+ LastFileReference weak reference to the last sourceFile
+ LastSourceFileName to speedup source access via NFS
WARNING: layout known by compiler and runtime system - dont change
[author:]
- Claus Gittinger
+ Claus Gittinger
"
!
@@ -148,16 +148,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.
].
"Modified: 22.4.1996 / 16:34:38 / cg"
@@ -215,12 +215,12 @@
sourceFilename := manager nextObject.
sourcePos := manager nextObject.
sourcePos isNil ifTrue:[
- source := manager nextObject.
+ source := manager nextObject.
].
code := manager nextObject.
snapId == ObjectMemory snapshotID ifTrue:[
- ObjectMemory incrementSnapshotID
+ ObjectMemory incrementSnapshotID
].
m := Method basicNew:(lits size).
@@ -229,9 +229,9 @@
m literals:lits.
m byteCode:code.
sourcePos isNil ifTrue:[
- m source:source
+ m source:source
] ifFalse:[
- m sourceFilename:sourceFilename position:sourcePos
+ m sourceFilename:sourceFilename position:sourcePos
].
^ m
@@ -303,7 +303,7 @@
comments := parser comments.
comments size == 0 ifTrue:[^ nil].
(comments first withoutSpaces endsWith:'}') ifTrue:[
- ^ comments at:2 ifAbsent:nil
+ ^ comments at:2 ifAbsent:nil
].
^ comments first.
@@ -422,70 +422,70 @@
"/ aStream close
"/ ]
- LastMethodSources notNil ifTrue:[
- junk := LastMethodSources at:self ifAbsent:nil.
- junk notNil ifTrue:[
- ^ junk
- ]
- ].
-
- "/ keep the last source file open, because open/close
- "/ operations maybe slow on NFS-mounted file systems.
- "/ Since the reference to the file is weak, it will be closed
- "/ automatically if the file is not referenced for a while.
- "/ Neat trick.
-
- LastFileLock critical:[
- aStream := LastFileReference at:1.
- LastFileReference at:1 put:0.
-
- aStream == 0 ifTrue:[
- aStream := nil.
- ] ifFalse:[
- LastSourceFileName = source ifFalse:[
- aStream close.
- aStream := nil.
- ].
- ].
- ].
-
- "/ a negative sourcePosition indicates
- "/ that this is a local file (not to be requested
- "/ via the sourceCodeManager)
- "/ This kludge was added, to allow sourceCode to be
- "/ saved to a local source file (i.e. 'st.src')
- "/ and having a clue for which file is meant later.
-
- sourcePosition < 0 ifTrue:[
- aStream := source asFilename readStream.
- aStream isNil ifTrue:[
- fileName := Smalltalk getSourceFileName:source.
- fileName notNil ifTrue:[
- aStream := fileName asFilename readStream.
- ].
- ].
- ].
-
- aStream isNil ifTrue:[
- "/
- "/ if there is no SourceManager, look in standard places
- "/ first
- "/
- (mgr := Smalltalk at:#SourceCodeManager) isNil ifTrue:[
- fileName := Smalltalk getSourceFileName:source.
- fileName notNil ifTrue:[
- aStream := fileName asFilename readStream.
- ].
- ].
-
- aStream isNil ifTrue:[
- "/
- "/ nope - ask my class for the source (this also invokes the SCMgr)
- "/
- who := self who.
- who notNil ifTrue:[
- myClass := who methodClass.
- aStream := myClass sourceStreamFor:source.
+ LastMethodSources notNil ifTrue:[
+ junk := LastMethodSources at:self ifAbsent:nil.
+ junk notNil ifTrue:[
+ ^ junk
+ ]
+ ].
+
+ "/ keep the last source file open, because open/close
+ "/ operations maybe slow on NFS-mounted file systems.
+ "/ Since the reference to the file is weak, it will be closed
+ "/ automatically if the file is not referenced for a while.
+ "/ Neat trick.
+
+ LastFileLock critical:[
+ aStream := LastFileReference at:1.
+ LastFileReference at:1 put:0.
+
+ aStream == 0 ifTrue:[
+ aStream := nil.
+ ] ifFalse:[
+ LastSourceFileName = source ifFalse:[
+ aStream close.
+ aStream := nil.
+ ].
+ ].
+ ].
+
+ "/ a negative sourcePosition indicates
+ "/ that this is a local file (not to be requested
+ "/ via the sourceCodeManager)
+ "/ This kludge was added, to allow sourceCode to be
+ "/ saved to a local source file (i.e. 'st.src')
+ "/ and having a clue for which file is meant later.
+
+ sourcePosition < 0 ifTrue:[
+ aStream := source asFilename readStream.
+ aStream isNil ifTrue:[
+ fileName := Smalltalk getSourceFileName:source.
+ fileName notNil ifTrue:[
+ aStream := fileName asFilename readStream.
+ ].
+ ].
+ ].
+
+ aStream isNil ifTrue:[
+ "/
+ "/ if there is no SourceManager, look in standard places
+ "/ first
+ "/
+ (mgr := Smalltalk at:#SourceCodeManager) isNil ifTrue:[
+ fileName := Smalltalk getSourceFileName:source.
+ fileName notNil ifTrue:[
+ aStream := fileName asFilename readStream.
+ ].
+ ].
+
+ aStream isNil ifTrue:[
+ "/
+ "/ nope - ask my class for the source (this also invokes the SCMgr)
+ "/
+ who := self who.
+ who notNil ifTrue:[
+ myClass := who methodClass.
+ aStream := myClass sourceStreamFor:source.
"/ the check below is no good -
"/ the classes stream may be an HTTP-stream, cached fileStream
@@ -498,70 +498,70 @@
"/ aStream close.
"/ aStream := nil.
"/ ]
- ].
-
- aStream isNil ifTrue:[
- "/
- "/ nope - look in standard places
- "/ (if there is a source-code manager - otherwise, we already did that)
- "/
- mgr notNil ifTrue:[
- fileName := Smalltalk getSourceFileName:source.
- fileName notNil ifTrue:[
- aStream := fileName asFilename readStream.
- ]
- ].
-
- "/
- "/ final chance: try current directory
- "/
- aStream isNil ifTrue:[
- aStream := source asFilename readStream.
- ]
- ].
-
- (aStream isNil and:[who isNil and:[source notNil]]) ifTrue:[
- "/
- "/ mhmh - seems to be a method which used to be in some
- "/ class, but has been overwritten by another or removed.
- "/ (i.e. it has no containing class anyMore)
- "/ try to guess the class from the sourceFileName.
- "/ and retry.
- "/
- className := Smalltalk classNameForFile:source.
- className knownAsSymbol ifTrue:[
- myClass := Smalltalk at:className asSymbol ifAbsent:nil.
- myClass notNil ifTrue:[
- aStream := myClass sourceStreamFor:source.
- ]
- ]
- ]
- ]
- ].
-
- aStream notNil ifTrue:[
- aStream position:sourcePosition abs.
- junk := aStream nextChunk.
-
- "
- keep a weak reference - it may be needed again soon ...
- "
- LastFileLock critical:[
- (LastFileReference at:1) == 0 ifTrue:[
- LastFileReference at:1 put:aStream.
- LastSourceFileName := source.
- ] ifFalse:[
- aStream close.
- ].
- ].
- ]
+ ].
+
+ aStream isNil ifTrue:[
+ "/
+ "/ nope - look in standard places
+ "/ (if there is a source-code manager - otherwise, we already did that)
+ "/
+ mgr notNil ifTrue:[
+ fileName := Smalltalk getSourceFileName:source.
+ fileName notNil ifTrue:[
+ aStream := fileName asFilename readStream.
+ ]
+ ].
+
+ "/
+ "/ final chance: try current directory
+ "/
+ aStream isNil ifTrue:[
+ aStream := source asFilename readStream.
+ ]
+ ].
+
+ (aStream isNil and:[who isNil and:[source notNil]]) ifTrue:[
+ "/
+ "/ mhmh - seems to be a method which used to be in some
+ "/ class, but has been overwritten by another or removed.
+ "/ (i.e. it has no containing class anyMore)
+ "/ try to guess the class from the sourceFileName.
+ "/ and retry.
+ "/
+ className := Smalltalk classNameForFile:source.
+ className knownAsSymbol ifTrue:[
+ myClass := Smalltalk at:className asSymbol ifAbsent:nil.
+ myClass notNil ifTrue:[
+ aStream := myClass sourceStreamFor:source.
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ aStream notNil ifTrue:[
+ aStream position:sourcePosition abs.
+ junk := aStream nextChunk.
+
+ "
+ keep a weak reference - it may be needed again soon ...
+ "
+ LastFileLock critical:[
+ (LastFileReference at:1) == 0 ifTrue:[
+ LastFileReference at:1 put:aStream.
+ LastSourceFileName := source.
+ ] ifFalse:[
+ aStream close.
+ ].
+ ].
+ ]
].
junk notNil ifTrue:[
- LastMethodSources isNil ifTrue:[
- LastMethodSources := CacheDictionary new:20.
- ].
- LastMethodSources at:self put:junk.
+ LastMethodSources isNil ifTrue:[
+ LastMethodSources := CacheDictionary new:20.
+ ].
+ LastMethodSources at:self put:junk.
].
^ junk
@@ -972,16 +972,16 @@
|doMachineCode mthd|
byteCode notNil ifTrue:[
- "
- is already a bytecoded method
- "
- ^ self
+ "
+ is already a bytecoded method
+ "
+ ^ self
].
doMachineCode := Compiler stcCompilation:#never.
[
- mthd := self asExecutableMethod.
+ mthd := self asExecutableMethod.
] valueNowOrOnUnwindDo:[
- Compiler stcCompilation:doMachineCode.
+ Compiler stcCompilation:doMachineCode.
].
^ mthd
@@ -1001,21 +1001,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
].
"
@@ -1024,41 +1024,44 @@
dont want a lazy method ...
"
Class withoutUpdatingChangesDo:[
- silent := Smalltalk silentLoading:true.
- lazy := Compiler compileLazy:false.
-
- [
- |compiler|
-
- 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:skipIfSame:)
- 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.
- ]
+ 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:skipIfSame:)
+ 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)
@@ -1072,8 +1075,8 @@
readBinaryContentsFrom: stream manager: manager
self code notNil ifTrue:[
- "built-in method - already complete"
- ^ self
+ "built-in method - already complete"
+ ^ self
].
^ super readBinaryContentsFrom: stream manager: manager
@@ -1096,27 +1099,27 @@
|storedMethod who|
byteCode isNil ifTrue:[
- self code notNil ifTrue:[
- (who := self who) notNil ifTrue:[
- "
- machine code only - assume its a built-in method,
- and store the class/selector information.
- The restored method may not be exactly the same ...
- "
- manager putIdOfClass:(self class) on:stream.
- stream nextPutByte:0. "means: built-in method"
- manager putIdOf:(who methodClass) on:stream.
- manager putIdOf:(who methodSelector) on:stream.
- ^ self
- ]
- ].
-
- storedMethod := self asByteCodeMethod.
- storedMethod isNil ifTrue:[
- self error:'store of built-in method failed'.
- ^ nil
- ].
- ^ storedMethod storeBinaryDefinitionOn:stream manager:manager
+ self code notNil ifTrue:[
+ (who := self who) notNil ifTrue:[
+ "
+ machine code only - assume its a built-in method,
+ and store the class/selector information.
+ The restored method may not be exactly the same ...
+ "
+ manager putIdOfClass:(self class) on:stream.
+ stream nextPutByte:0. "means: built-in method"
+ manager putIdOf:(who methodClass) on:stream.
+ manager putIdOf:(who methodSelector) on:stream.
+ ^ self
+ ]
+ ].
+
+ storedMethod := self asByteCodeMethod.
+ storedMethod isNil ifTrue:[
+ self error:'store of built-in method failed'.
+ ^ nil
+ ].
+ ^ storedMethod storeBinaryDefinitionOn:stream manager:manager
].
manager putIdOfClass:(self class) on:stream.
@@ -1135,11 +1138,11 @@
m := self.
code := byteCode.
code isNil ifTrue:[
- m := self asByteCodeMethod.
- code := m byteCode.
- code isNil ifTrue:[
- m := self
- ]
+ m := self asByteCodeMethod.
+ code := m byteCode.
+ code isNil ifTrue:[
+ m := self
+ ]
].
ObjectMemory snapshotID storeBinaryOn:stream manager:manager.
@@ -1148,23 +1151,23 @@
m flags storeBinaryOn:stream manager:manager.
m literals storeBinaryOn:stream manager:manager.
manager sourceMode == #discard ifTrue:[
- "/ add nil, nil, nil
- nil storeBinaryOn:stream manager:manager. "/ sourceFileName
- nil storeBinaryOn:stream manager:manager. "/ sourcePosition
- nil storeBinaryOn:stream manager:manager. "/ source
+ "/ add nil, nil, nil
+ nil storeBinaryOn:stream manager:manager. "/ sourceFileName
+ nil storeBinaryOn:stream manager:manager. "/ sourcePosition
+ nil storeBinaryOn:stream manager:manager. "/ source
] ifFalse:[
- "/ add sourceFilename, srcPos
- "/ or nil, nil, source
- m sourceFilename storeBinaryOn:stream manager:manager.
- manager sourceMode == #reference ifTrue:[
- srcPos := m sourcePosition.
- ] ifFalse:[
- srcPos := nil
- ].
- srcPos storeBinaryOn:stream manager:manager.
- srcPos isNil ifTrue:[
- m source storeBinaryOn:stream manager:manager.
- ].
+ "/ add sourceFilename, srcPos
+ "/ or nil, nil, source
+ m sourceFilename storeBinaryOn:stream manager:manager.
+ manager sourceMode == #reference ifTrue:[
+ srcPos := m sourcePosition.
+ ] ifFalse:[
+ srcPos := nil
+ ].
+ srcPos storeBinaryOn:stream manager:manager.
+ srcPos isNil ifTrue:[
+ m source storeBinaryOn:stream manager:manager.
+ ].
].
code storeBinaryOn:stream manager:manager.
@@ -1182,7 +1185,7 @@
aCopy := super copy.
sourcePosition notNil ifTrue:[
- aCopy source:(self source)
+ aCopy source:(self source)
].
^ aCopy
@@ -1214,7 +1217,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Modified: 4.11.1996 / 22:45:06 / cg"
!
@@ -1233,7 +1236,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:16:16 / cg"
"Modified: 4.11.1996 / 22:45:12 / cg"
@@ -1253,7 +1256,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:16:41 / cg"
"Modified: 4.11.1996 / 22:45:15 / cg"
@@ -1273,7 +1276,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:16:51 / cg"
"Modified: 4.11.1996 / 22:45:18 / cg"
@@ -1293,7 +1296,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:00 / cg"
"Modified: 4.11.1996 / 22:45:22 / cg"
@@ -1313,7 +1316,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:09 / cg"
"Modified: 4.11.1996 / 22:45:25 / cg"
@@ -1333,7 +1336,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:17 / cg"
"Modified: 4.11.1996 / 22:45:28 / cg"
@@ -1353,7 +1356,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:25 / cg"
"Modified: 4.11.1996 / 22:45:31 / cg"
@@ -1373,7 +1376,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:32 / cg"
"Modified: 4.11.1996 / 22:45:38 / cg"
@@ -1393,7 +1396,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:37 / cg"
"Modified: 4.11.1996 / 22:45:41 / cg"
@@ -1413,7 +1416,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:45 / cg"
"Modified: 4.11.1996 / 22:45:44 / cg"
@@ -1433,7 +1436,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:17:52 / cg"
"Modified: 4.11.1996 / 22:45:47 / cg"
@@ -1453,7 +1456,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 20:51:28 / cg"
"Modified: 4.11.1996 / 22:46:01 / cg"
@@ -1473,7 +1476,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:18:09 / cg"
"Modified: 4.11.1996 / 22:45:57 / cg"
@@ -1493,7 +1496,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:18:17 / cg"
"Modified: 4.11.1996 / 22:45:55 / cg"
@@ -1513,7 +1516,7 @@
*/
%}.
^ InvalidCodeSignal
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: 4.11.1996 / 21:18:22 / cg"
"Modified: 4.11.1996 / 22:45:52 / cg"
@@ -1562,8 +1565,8 @@
*/
%}.
^ InvalidCodeSignal
- raiseRequestWith:self
- errorString:'invalid method - not compiled'.
+ raiseRequestWith:self
+ errorString:'invalid method - not compiled'.
"Modified: 4.11.1996 / 22:58:02 / cg"
!
@@ -1582,8 +1585,8 @@
*/
%}.
^ InvalidCodeSignal
- raiseRequestWith:self
- errorString:'invalid method - unloaded'.
+ raiseRequestWith:self
+ errorString:'invalid method - unloaded'.
"Created: 4.11.1996 / 22:57:54 / cg"
"Modified: 4.11.1996 / 22:58:28 / cg"
@@ -1605,28 +1608,28 @@
classAndSelector := self who.
classAndSelector isNil ifTrue:[
- "
- not anchored in any class.
- check if wrapped (to be more informative in inspectors)
- "
- m := self wrapper.
- m notNil ifTrue:[
- classAndSelector := m who.
- wrapped := true.
- ]
+ "
+ not anchored in any class.
+ check if wrapped (to be more informative in inspectors)
+ "
+ m := self wrapper.
+ m notNil ifTrue:[
+ classAndSelector := m who.
+ wrapped := true.
+ ]
].
classAndSelector notNil ifTrue:[
- (classAndSelector methodClass) name printOn:aStream.
- aStream nextPutAll:' '.
- (classAndSelector methodSelector) printOn:aStream.
- wrapped ifTrue:[
- aStream nextPutAll:'; wrapped'
- ].
+ (classAndSelector methodClass) name printOn:aStream.
+ aStream nextPutAll:' '.
+ (classAndSelector methodSelector) printOn:aStream.
+ wrapped ifTrue:[
+ aStream nextPutAll:'; wrapped'
+ ].
] ifFalse:[
- "
- sorry, a method which is nowhere anchored
- "
- aStream nextPutAll:'unbound'
+ "
+ sorry, a method which is nowhere anchored
+ "
+ aStream nextPutAll:'unbound'
].
aStream nextPut:$)
@@ -1648,54 +1651,54 @@
privInfo := ''.
self isWrapped ifTrue:[
- (MessageTracer isCounting:self) ifTrue:[
- (MessageTracer isCountingMemoryUsage:self) ifTrue:[
- moreInfo := moreInfo ,
- ' (mem usage ' , (MessageTracer memoryUsageOfMethod:self) printString , ' Bytes)'.
- ] ifFalse:[
- moreInfo := moreInfo ,
- ' (called ' , (MessageTracer executionCountOfMethod:self) printString , ' times)'.
- ]
- ] ifFalse:[
- (MessageTracer isTiming:self) ifTrue:[
- i := MessageTracer executionTimesOfMethod:self.
- i notNil ifTrue:[
- moreInfo := moreInfo ,
- ' (avg: ' , (i at:#avgTime) printString,
- ' min: ' , (i at:#minTime) printString ,
- ' max: ' , (i at:#maxTime) printString ,
- ' cnt: ' , (i at:#count) printString , ')'
- ].
- ] ifFalse:[
- moreInfo := ' !!'
- ]
- ].
- p := self originalMethod privacy
+ (MessageTracer isCounting:self) ifTrue:[
+ (MessageTracer isCountingMemoryUsage:self) ifTrue:[
+ moreInfo := moreInfo ,
+ ' (mem usage ' , (MessageTracer memoryUsageOfMethod:self) printString , ' Bytes)'.
+ ] ifFalse:[
+ moreInfo := moreInfo ,
+ ' (called ' , (MessageTracer executionCountOfMethod:self) printString , ' times)'.
+ ]
+ ] ifFalse:[
+ (MessageTracer isTiming:self) ifTrue:[
+ i := MessageTracer executionTimesOfMethod:self.
+ i notNil ifTrue:[
+ moreInfo := moreInfo ,
+ ' (avg: ' , (i at:#avgTime) printString,
+ ' min: ' , (i at:#minTime) printString ,
+ ' max: ' , (i at:#maxTime) printString ,
+ ' cnt: ' , (i at:#count) printString , ')'
+ ].
+ ] ifFalse:[
+ moreInfo := ' !!'
+ ]
+ ].
+ p := self originalMethod privacy
] ifFalse:[
- p := self privacy
+ p := self privacy
].
p ~~ #public ifTrue:[
- privInfo := (' (* ' , p , ' *)') asText emphasizeAllWith:#italic.
+ privInfo := (' (* ' , p , ' *)') asText emphasizeAllWith:#italic.
].
self isInvalid ifTrue:[
- moreInfo := ' (** not executable **)'.
+ moreInfo := ' (** not executable **)'.
].
(self isLazyMethod not and:[self isUnloaded]) ifTrue:[
- moreInfo := ' (** unloaded **)'
+ moreInfo := ' (** unloaded **)'
].
privInfo size ~~ 0 ifTrue:[
- moreInfo := privInfo , ' ' , moreInfo
+ moreInfo := privInfo , ' ' , moreInfo
].
moreInfo size == 0 ifTrue:[^ selector].
s := selector , moreInfo.
self isInvalid ifTrue:[
- s := s asText emphasizeAllWith:#color->Color red.
+ s := s asText emphasizeAllWith:#color->Color red.
].
^ s
@@ -1711,7 +1714,7 @@
who := self who.
who notNil ifTrue:[
- ^ (who methodClass) name , '>>' , (who methodSelector)
+ ^ (who methodClass) name , '>>' , (who methodSelector)
].
^ 'unbound'
@@ -1753,15 +1756,15 @@
src := self source.
src notNil ifTrue:[
- parser := Parser
- parseMethod:src
- in:self containingClass
- ignoreErrors:true
- ignoreWarnings:true.
-
- (parser notNil and:[parser ~~ #Error]) ifTrue:[
- ^ parser usedInstVars
- ].
+ parser := Parser
+ parseMethod:src
+ in:self containingClass
+ ignoreErrors:true
+ ignoreWarnings:true.
+
+ (parser notNil and:[parser ~~ #Error]) ifTrue:[
+ ^ parser usedInstVars
+ ].
].
^ #() "/ actually: unknown
@@ -1807,10 +1810,10 @@
src := self source.
src notNil ifTrue:[
- (src includesString:'%{' ) ifFalse:[
- "/ cannot contain primitive code.
- ^ false
- ]
+ (src includesString:'%{' ) ifFalse:[
+ "/ cannot contain primitive code.
+ ^ false
+ ]
].
"/ ok; it may or may not ...
@@ -1865,20 +1868,20 @@
m := self trapMethodForNumArgs:(self numArgs).
(m notNil and:[self ~~ m]) ifTrue:[
- (myCode notNil and:[myCode = m code]) ifTrue:[^ true].
- (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
+ (myCode notNil and:[myCode = m code]) ifTrue:[^ true].
+ (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
].
m := Method compiledMethodAt:#uncompiledCodeObject.
(m notNil and:[self ~~ m]) ifTrue:[
- (myCode notNil and:[myCode = m code]) ifTrue:[^ true].
- (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
+ (myCode notNil and:[myCode = m code]) ifTrue:[^ true].
+ (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
].
m := Method compiledMethodAt:#unloadedCodeObject.
(m notNil and:[self ~~ m]) ifTrue:[
- (myCode notNil and:[myCode = m code]) ifTrue:[^ true].
- (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
+ (myCode notNil and:[myCode = m code]) ifTrue:[^ true].
+ (byteCode notNil and:[byteCode == m byteCode]) ifTrue:[^ true].
].
^ false
@@ -2001,15 +2004,15 @@
src := self source.
src notNil ifTrue:[
- parser := Parser
- parseMethod:src
- in:self containingClass
- ignoreErrors:true
- ignoreWarnings:true.
-
- (parser notNil and:[parser ~~ #Error]) ifTrue:[
- ^ parser modifiedInstVars
- ].
+ parser := Parser
+ parseMethod:src
+ in:self containingClass
+ ignoreErrors:true
+ ignoreWarnings:true.
+
+ (parser notNil and:[parser ~~ #Error]) ifTrue:[
+ ^ parser modifiedInstVars
+ ].
].
^ #() "/ actually: unknown
@@ -2032,8 +2035,8 @@
list size == 0 ifTrue:[^ nil].
histLine := list last.
^ AbsoluteTime
- fromDate:histLine date
- andTime:histLine time
+ fromDate:histLine date
+ andTime:histLine time
"
(Method compiledMethodAt:#modificationTime) modificationTime
@@ -2053,9 +2056,9 @@
sourceString := self source.
sourceString notNil ifTrue:[
- parser := Parser perform:parseSelector with:sourceString.
- (parser isNil or:[parser == #Error]) ifTrue:[^ valueIfNoSource].
- ^ parser perform:accessSelector
+ parser := Parser perform:parseSelector with:sourceString.
+ (parser isNil or:[parser == #Error]) ifTrue:[^ valueIfNoSource].
+ ^ parser perform:accessSelector
].
^ valueIfNoSource
@@ -2102,30 +2105,30 @@
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|
@@ -2136,21 +2139,21 @@
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 := Smalltalk at:LastWhoClass ifAbsent:nil.
+ cls notNil ifTrue:[
+ sel := cls selectorAtMethod:self.
+ sel notNil ifTrue:[
+ ^ MethodWhoInfo class:cls selector:sel
"/ ^ Array with:cls with:sel
- ].
-
- cls := cls class.
- 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
"/ ^ Array with:cls with:sel
- ].
- ]
+ ].
+ ]
].
"
@@ -2162,55 +2165,55 @@
instance methods are usually more common - search those first
"
classes do:[:aClass |
- |sel|
-
- sel := aClass selectorAtMethod:self ifAbsent:nil.
- sel notNil ifTrue:[
- aClass isMeta ifTrue:[
- cls := aClass soleInstance.
- cls notNil ifTrue:[
- LastWhoClass := cls name
- ].
- ] ifFalse:[
- LastWhoClass := aClass name.
- ].
-
- ^ MethodWhoInfo class:aClass selector:sel
+ |sel|
+
+ sel := aClass selectorAtMethod:self ifAbsent:nil.
+ sel notNil ifTrue:[
+ aClass isMeta ifTrue:[
+ cls := aClass soleInstance.
+ cls notNil ifTrue:[
+ LastWhoClass := cls name
+ ].
+ ] ifFalse:[
+ LastWhoClass := aClass name.
+ ].
+
+ ^ MethodWhoInfo class:aClass selector:sel
"/ ^ Array with:aClass with:sel
- ].
+ ].
].
LastWhoClass := nil.
classes do:[:aClass |
- |sel|
-
- sel := aClass class selectorAtMethod:self.
- sel notNil ifTrue:[
- aClass isMeta ifTrue:[
- cls := aClass soleInstance.
- cls notNil ifTrue:[
- LastWhoClass := cls name
- ].
- ] ifFalse:[
- LastWhoClass := aClass name.
- ].
-
- ^ MethodWhoInfo class:aClass class selector:sel
+ |sel|
+
+ sel := aClass class selectorAtMethod:self.
+ sel notNil ifTrue:[
+ aClass isMeta ifTrue:[
+ cls := aClass soleInstance.
+ cls notNil ifTrue:[
+ LastWhoClass := cls name
+ ].
+ ] ifFalse:[
+ LastWhoClass := aClass name.
+ ].
+
+ ^ MethodWhoInfo class:aClass class selector:sel
"/ ^ Array with:aClass class with:sel
- ].
+ ].
].
"
mhmh - must be a method of some anonymous class (i.e. one not
in the Smalltalk dictionary). Search all instances of Behavior
"
Behavior allSubInstancesDo:[:someClass |
- |sel|
-
- sel := someClass selectorAtMethod:self.
- sel notNil ifTrue:[
- ^ MethodWhoInfo class:someClass selector:sel
+ |sel|
+
+ sel := someClass selectorAtMethod:self.
+ sel notNil ifTrue:[
+ ^ MethodWhoInfo class:someClass selector:sel
"/ ^ Array with:someClass with:sel
- ]
+ ]
].
"
none found - sorry
@@ -2229,11 +2232,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.
@@ -2310,23 +2313,23 @@
|trapSel|
trapSel := #(
- #'invalidCodeObject'
- #'invalidCodeObjectWith:'
- #'invalidCodeObjectWith:with:'
- #'invalidCodeObjectWith:with:with:'
- #'invalidCodeObjectWith:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:with:'
- #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:with:with:'
- ) at:(numArgs + 1).
+ #'invalidCodeObject'
+ #'invalidCodeObjectWith:'
+ #'invalidCodeObjectWith:with:'
+ #'invalidCodeObjectWith:with:with:'
+ #'invalidCodeObjectWith:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:with:'
+ #'invalidCodeObjectWith:with:with:with:with:with:with:with:with:with:with:with:with:with:with:'
+ ) at:(numArgs + 1).
^ Method compiledMethodAt:trapSel.
@@ -2343,17 +2346,17 @@
This was done, since a smalltalk method cannot return multiple
values, but 2 values had to be returned from that method.
Thus, the who-interface was used as:
- info := <someMethod> who.
- class := info at:1.
- sel := info at:2.
+ info := <someMethod> who.
+ class := info at:1.
+ sel := info at:2.
Sure, this is ugly coding style, and the system has been changed to return
an object (an instance of MethodWhoInfo) which responds to the two
messages: #methodClass and #methodSelector.
This allows to write things much more intuitive:
- info := <someMethod> who.
- class := info methodClass.
- sel := info methodSelector.
+ info := <someMethod> who.
+ class := info methodClass.
+ sel := info methodSelector.
However, to be backward compatible, the returned object still responds to
the #at: message, but only allows inices of 1 and 2 to be used.
@@ -2362,10 +2365,10 @@
classes.
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- Method
+ Method
"
! !
@@ -2410,16 +2413,16 @@
"simulate the old behavior (when Method>>who returned an array)"
index == 1 ifTrue:[
- ^ myClass
+ ^ myClass
].
index == 2 ifTrue:[
- ^ mySelector
+ ^ mySelector
].
"/ sigh - full compatibility ?
index isInteger ifFalse:[
- ^ self indexNotInteger
+ ^ self indexNotInteger
].
^ self subscriptBoundsError:index
@@ -2437,6 +2440,6 @@
!Method class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.141 1997-09-24 02:48:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.142 1997-10-15 12:32:25 cg Exp $'
! !
Method initialize!