--- a/Method.st Thu Jul 23 12:40:48 2015 +0200
+++ b/Method.st Thu Jul 23 13:10:17 2015 +0200
@@ -2,7 +2,7 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -51,7 +51,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -93,27 +93,27 @@
[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
- mclass <Class> the class in which I am defined
- indexed slots literals
+ 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
+ mclass <Class> the class in which I am defined
+ indexed slots literals
[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
"
!
@@ -172,13 +172,13 @@
Be warned and send me suggestions & critics (constructive ;-)
Late note (Feb 2000):
- the privacy feature has new been in ST/X for some years and was NOT heavily
- used - neither at eXept, nor by customers.
- In Smalltalk, it seems to be a very questionable feature, actually limiting
- code reusability.
- The privacy features are left in the system to demonstrate that it can be
- done in Smalltalk (for religious C++ fans ... to avoid useless discussions)
- (the check is not expensive, w.r.t. the VM runtime behavior).
+ the privacy feature has new been in ST/X for some years and was NOT heavily
+ used - neither at eXept, nor by customers.
+ In Smalltalk, it seems to be a very questionable feature, actually limiting
+ code reusability.
+ The privacy features are left in the system to demonstrate that it can be
+ done in Smalltalk (for religious C++ fans ... to avoid useless discussions)
+ (the check is not expensive, w.r.t. the VM runtime behavior).
"
! !
@@ -188,18 +188,18 @@
"create signals"
PrivateMethodSignal isNil ifTrue:[
- "EXPERIMENTAL"
- PrivateMethodSignal := ExecutionError newSignalMayProceed:true.
- PrivateMethodSignal nameClass:self message:#privateMethodSignal.
- PrivateMethodSignal notifierString:'attempt to execute private/protected method'.
+ "EXPERIMENTAL"
+ PrivateMethodSignal := ExecutionError newSignalMayProceed:true.
+ PrivateMethodSignal nameClass:self message:#privateMethodSignal.
+ PrivateMethodSignal notifierString:'attempt to execute private/protected method'.
].
LastFileLock isNil ifTrue:[
- LastFileLock := RecursionLock new name:'Method-LastFile'.
- LastMethodSourcesLock := RecursionLock new name:'Method-LastMethodSources'.
-
- LastFileReference := WeakArray new:1.
- LastFileReference at:1 put:nil.
+ LastFileLock := RecursionLock new name:'Method-LastFile'.
+ LastMethodSourcesLock := RecursionLock new name:'Method-LastMethodSources'.
+
+ LastFileReference := WeakArray new:1.
+ LastFileReference at:1 put:nil.
].
CompilationLock := RecursionLock new name:'MethodCompilation'.
@@ -210,7 +210,7 @@
lastMethodSourcesLock
LastMethodSourcesLock isNil ifTrue:[
- self initialize
+ self initialize
].
^ LastMethodSourcesLock
! !
@@ -258,10 +258,10 @@
"
in ST/X, binops are allowed with up-to 3 characters;
for example:
- <->
- <=>
- +++
- :=:
+ <->
+ <=>
+ +++
+ :=:
etc. are valid binOps here
"
!
@@ -269,8 +269,8 @@
methodDefinitionTemplateForSelector:aSelector
"given a selector, return a prototype definition string"
- ^ self programmingLanguage
- methodDefinitionTemplateForSelector:aSelector
+ ^ self programmingLanguage
+ methodDefinitionTemplateForSelector:aSelector
"
Method methodDefinitionTemplateForSelector:#foo
@@ -282,11 +282,11 @@
methodDefinitionTemplateForSelector:aSelector andArgumentNames:argNames
"given a selector, return a prototype definition string"
- ^ self programmingLanguage
- methodDefinitionTemplateForSelector:aSelector andArgumentNames:argNames
+ ^ self programmingLanguage
+ methodDefinitionTemplateForSelector:aSelector andArgumentNames:argNames
"
- Method methodDefinitionTemplateForSelector:#foo andArgumentNames:#()
+ Method methodDefinitionTemplateForSelector:#foo andArgumentNames:#()
Method methodDefinitionTemplateForSelector:#+ andArgumentNames:#('aNumber')
Method methodDefinitionTemplateForSelector:#foo:bar:baz: andArgumentNames:#('fooArg' 'barArg' 'bazArg')
"
@@ -327,8 +327,8 @@
flushSourceStreamCache
LastFileLock critical:[
- LastSourceFileName := LastMethodSources := nil.
- LastFileReference at:1 put:0.
+ LastSourceFileName := LastMethodSources := nil.
+ LastFileReference at:1 put:0.
].
"
@@ -350,31 +350,31 @@
|trapSel trapMethod|
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).
(trapMethod := self compiledMethodAt:trapSel) isNil ifTrue:[
- trapMethod := Method compiledMethodAt:trapSel.
+ trapMethod := Method compiledMethodAt:trapSel.
].
^ trapMethod.
"
- self trapMethodForNumArgs:2
+ self trapMethodForNumArgs:2
"
"Created: / 04-11-1996 / 21:58:58 / cg"
@@ -423,19 +423,19 @@
annots := self annotationsAt:aSymbol.
annots isEmptyOrNil ifTrue:[
- (aSymbol endsWith:$:) ifFalse:[
- annots := self annotationsAt:(aSymbol,$:) asSymbol.
- ].
- annots isEmptyOrNil ifTrue:[
- ^ exceptionValue value
- ].
+ (aSymbol endsWith:$:) ifFalse:[
+ annots := self annotationsAt:(aSymbol,$:) asSymbol.
+ ].
+ annots isEmptyOrNil ifTrue:[
+ ^ exceptionValue value
+ ].
].
^ annots first arguments first
!
attributeMessages
- ^ self annotations
- collect:[:annot | Message selector:annot key arguments:annot arguments]
+ ^ self annotations
+ collect:[:annot | Message selector:annot key arguments:annot arguments]
!
classIsMeta
@@ -473,18 +473,18 @@
|newCategory oldCategory cls|
aStringOrSymbol notNil ifTrue:[
- newCategory := aStringOrSymbol.
- newCategory ~= (oldCategory := category) ifTrue:[
- self setCategory:newCategory.
-
- cls := self mclass.
- cls notNil ifTrue:[
- cls addChangeRecordForMethodCategory:self category:newCategory.
- self changed:#category with:oldCategory. "/ will vanish
- cls changed:#organization with:self selector. "/ will vanish
- Smalltalk changed:#methodCategory with:(Array with:cls with:self with:oldCategory).
- ]
- ]
+ newCategory := aStringOrSymbol.
+ newCategory ~= (oldCategory := category) ifTrue:[
+ self setCategory:newCategory.
+
+ cls := self mclass.
+ cls notNil ifTrue:[
+ cls addChangeRecordForMethodCategory:self category:newCategory.
+ self changed:#category with:oldCategory. "/ will vanish
+ cls changed:#organization with:self selector. "/ will vanish
+ Smalltalk changed:#methodCategory with:(Array with:cls with:self with:oldCategory).
+ ]
+ ]
]
"Modified: / 25-09-2007 / 16:15:24 / cg"
@@ -518,7 +518,7 @@
due to an accept in a browser or debugger. However, the mclass slot still contains a
reference to the once valid class"
- ^ mclass
+ ^ mclass
!
getPackage
@@ -566,9 +566,9 @@
lookupObject: anObject
anObject == BuiltinLookup instance ifTrue:[
- self setLookupObject: nil
+ self setLookupObject: nil
] ifFalse:[
- self setLookupObject: anObject.
+ self setLookupObject: anObject.
].
"Created: / 28-04-2010 / 18:36:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -583,12 +583,12 @@
sourceCode is not lost."
source notNil ifTrue:[
- sourcePosition notNil ifTrue:[
- "/ this looks wierd - but (self source) will retrieve the external source
- "/ (from the file) and store it. So afterwards, we will have the string and
- "/ sourcePosition will be nil
- self source:(self source)
- ]
+ sourcePosition notNil ifTrue:[
+ "/ this looks wierd - but (self source) will retrieve the external source
+ "/ (from the file) and store it. So afterwards, we will have the string and
+ "/ sourcePosition will be nil
+ self source:(self source)
+ ]
].
!
@@ -684,7 +684,7 @@
Overrides isNil ifTrue:[^ nil].
^ (Overrides includesKey: self)
- ifTrue:[Overrides at: self]
+ ifTrue:[Overrides at: self]
"Created: / 05-07-2012 / 10:49:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -709,12 +709,12 @@
"/ get it from my class
(cls := self mclass) isNil ifTrue:[
- ^ PackageId noProjectID.
+ ^ PackageId noProjectID.
].
"/ set it.
package := cls getPackage.
package isNil ifTrue:[
- ^ PackageId noProjectID.
+ ^ PackageId noProjectID.
].
^ package
@@ -727,36 +727,36 @@
|cls oldPackage newPackage|
aSymbol == PackageId noProjectID ifTrue:[
- newPackage := nil
+ newPackage := nil
] ifFalse:[
- newPackage := aSymbol
+ newPackage := aSymbol
].
package ~~ newPackage ifTrue:[
- oldPackage := package.
- "/ this is required, because otherwise I would no longer be able to
- "/ reconstruct my sourcecode (as the connection to the source-file is lost).
- self makeLocalStringSource.
- package := newPackage.
-
- cls := self mclass.
- "JV@2011-01-27: BUG FIX: method may be wrapped (breakpoint on it).
- Search for the wrapper, if none is found, return immediately
- (avoids DNU)"
- cls isNil ifTrue:[
- | wrapper |
-
- wrapper := self wrapper.
- wrapper isNil ifTrue:[ ^ self ].
- cls := wrapper mclass.
- cls isNil ifTrue:[ ^ self ].
- ].
-
- self changed:#package. "/ will vanish
- cls changed:#methodPackage with:self selector. "/ will vanish
-
- Smalltalk changed:#projectOrganization with:(Array with:cls with:self with:oldPackage).
- cls addChangeRecordForMethodPackage:self package:newPackage.
+ oldPackage := package.
+ "/ this is required, because otherwise I would no longer be able to
+ "/ reconstruct my sourcecode (as the connection to the source-file is lost).
+ self makeLocalStringSource.
+ package := newPackage.
+
+ cls := self mclass.
+ "JV@2011-01-27: BUG FIX: method may be wrapped (breakpoint on it).
+ Search for the wrapper, if none is found, return immediately
+ (avoids DNU)"
+ cls isNil ifTrue:[
+ | wrapper |
+
+ wrapper := self wrapper.
+ wrapper isNil ifTrue:[ ^ self ].
+ cls := wrapper mclass.
+ cls isNil ifTrue:[ ^ self ].
+ ].
+
+ self changed:#package. "/ will vanish
+ cls changed:#methodPackage with:self selector. "/ will vanish
+
+ Smalltalk changed:#projectOrganization with:(Array with:cls with:self with:oldPackage).
+ cls addChangeRecordForMethodPackage:self package:newPackage.
]
"Modified: / 23-11-2006 / 17:01:02 / cg"
@@ -776,7 +776,7 @@
"set the methods category (without change notification)"
aStringOrSymbol notNil ifTrue:[
- category := aStringOrSymbol asSymbol
+ category := aStringOrSymbol asSymbol
]
"Modified: / 13.11.1998 / 23:55:05 / cg"
@@ -802,75 +802,75 @@
source isNil ifTrue:[^ nil].
self class lastMethodSourcesLock critical:[
- LastMethodSources notNil ifTrue:[
- chunk := LastMethodSources at:self ifAbsent:nil.
- ].
+ LastMethodSources notNil ifTrue:[
+ chunk := LastMethodSources at:self ifAbsent:nil.
+ ].
].
chunk notNil ifTrue:[
- ^ chunk
+ ^ chunk
].
LastFileLock
- critical:[
- "have to protect sourceStream from being closed as a side effect
- of some other process fetching some the source from a different source file"
-
- sourceStream := self sourceStreamUsingCache:true.
- sourceStream notNil ifTrue:[
- [
- chunk := self sourceChunkFromStream:sourceStream.
- ] on:DecodingError do:[:ex|
- "CharacterEncoder>>#guessEncoding is not fail safe - retry with plain unencoded data"
-
- ('DecodingError ignored when reading <1p> (<2p>)' expandMacrosWith:self whoString with:ex description) infoPrintCR.
- sourceStream := self rawSourceStreamUsingCache:true.
- ex restart.
- ].
- ].
- ]
- timeoutMs:100
- ifBlocking:[
- "take care if LastFileLock is not available - maybe we are
- called by a debugger while someone holds the lock.
- Use uncached source streams"
- sourceStream := self sourceStreamUsingCache:false.
- sourceStream notNil ifTrue:[
- [
- chunk := self sourceChunkFromStream:sourceStream.
- sourceStream close.
- ] on:DecodingError do:[:ex|
- "CharacterEncoder>>#guessEncoding is not fail safe - retry with plain unencoded data"
- ('DecodingError ignored when reading <1p> (<2p>)' expandMacrosWith:self whoString with:ex description) infoPrintCR.
- sourceStream close.
- sourceStream := self rawSourceStreamUsingCache:false.
- ex restart.
- ].
- ].
- ].
+ critical:[
+ "have to protect sourceStream from being closed as a side effect
+ of some other process fetching some the source from a different source file"
+
+ sourceStream := self sourceStreamUsingCache:true.
+ sourceStream notNil ifTrue:[
+ [
+ chunk := self sourceChunkFromStream:sourceStream.
+ ] on:DecodingError do:[:ex|
+ "CharacterEncoder>>#guessEncoding is not fail safe - retry with plain unencoded data"
+
+ ('DecodingError ignored when reading <1p> (<2p>)' expandMacrosWith:self whoString with:ex description) infoPrintCR.
+ sourceStream := self rawSourceStreamUsingCache:true.
+ ex restart.
+ ].
+ ].
+ ]
+ timeoutMs:100
+ ifBlocking:[
+ "take care if LastFileLock is not available - maybe we are
+ called by a debugger while someone holds the lock.
+ Use uncached source streams"
+ sourceStream := self sourceStreamUsingCache:false.
+ sourceStream notNil ifTrue:[
+ [
+ chunk := self sourceChunkFromStream:sourceStream.
+ sourceStream close.
+ ] on:DecodingError do:[:ex|
+ "CharacterEncoder>>#guessEncoding is not fail safe - retry with plain unencoded data"
+ ('DecodingError ignored when reading <1p> (<2p>)' expandMacrosWith:self whoString with:ex description) infoPrintCR.
+ sourceStream close.
+ sourceStream := self rawSourceStreamUsingCache:false.
+ ex restart.
+ ].
+ ].
+ ].
"Cache the source of recently used methods"
chunk notNil ifTrue:[
- "JV@2013-08-19: Don't consult UserPreferences if the system is initilizing. This may
- lead in funny side-effect as #initializeDefaultPreferences is called which tries to
- initialize some colors. But Color itsels is likely not yet initialized, so DNU is
- thrown.
- CG: also care for standalone non-GUI progs, which have no userPreferences class"
- (Smalltalk isInitialized
- and:[UserPreferences notNil
- and:[UserPreferences current keepMethodSourceCode]]) ifTrue:[
- source := chunk.
- sourcePosition := nil.
- ^ source.
- ].
-
- CacheDictionary notNil ifTrue:[
- self class lastMethodSourcesLock critical:[
- LastMethodSources isNil ifTrue:[
- LastMethodSources := CacheDictionary new:50.
- ].
- LastMethodSources at:self put:chunk.
- ]
- ].
+ "JV@2013-08-19: Don't consult UserPreferences if the system is initilizing. This may
+ lead in funny side-effect as #initializeDefaultPreferences is called which tries to
+ initialize some colors. But Color itsels is likely not yet initialized, so DNU is
+ thrown.
+ CG: also care for standalone non-GUI progs, which have no userPreferences class"
+ (Smalltalk isInitialized
+ and:[UserPreferences notNil
+ and:[UserPreferences current keepMethodSourceCode]]) ifTrue:[
+ source := chunk.
+ sourcePosition := nil.
+ ^ source.
+ ].
+
+ CacheDictionary notNil ifTrue:[
+ self class lastMethodSourcesLock critical:[
+ LastMethodSources isNil ifTrue:[
+ LastMethodSources := CacheDictionary new:50.
+ ].
+ LastMethodSources at:self put:chunk.
+ ]
+ ].
].
^ chunk
@@ -931,18 +931,18 @@
index := self annotationIndexOf: annotation key.
index isNil ifTrue:[
- annotations := annotations isNil
- ifTrue:[Array with: annotation]
- ifFalse:[annotations copyWith:annotation]
+ annotations := annotations isNil
+ ifTrue:[Array with: annotation]
+ ifFalse:[annotations copyWith:annotation]
] ifFalse:[
- annotations at: index put: annotation
+ annotations at: index put: annotation
].
"/ annotation annotatesMethod: self.
"
- (Object >> #yourself) annotateWith: (Annotation namespace: 'Fictious').
- (Object >> #yourself) annotations.
- (Object >> #yourself) annotationAt: #namespace:
+ (Object >> #yourself) annotateWith: (Annotation namespace: 'Fictious').
+ (Object >> #yourself) annotations.
+ (Object >> #yourself) annotationAt: #namespace:
"
"Created: / 19-05-2010 / 16:20:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -958,7 +958,7 @@
^ self annotationAtIndex: index.
"
- (Object >> #yourself) annotationAt: #namespace:
+ (Object >> #yourself) annotationAt: #namespace:
"
"Created: / 19-05-2010 / 16:16:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -976,7 +976,7 @@
retval := Array new: annotations size.
1 to: annotations size do: [:i|
- retval at: i put: (self annotationAtIndex: i).
+ retval at: i put: (self annotationAtIndex: i).
].
^ retval.
@@ -999,10 +999,10 @@
annotationsAt: key
- ^OrderedCollection
- streamContents:[:annotStream|
- self annotationsAt: key do: [:annot| annotStream nextPut: annot]
- ]
+ ^OrderedCollection
+ streamContents:[:annotStream|
+ self annotationsAt: key do: [:annot| annotStream nextPut: annot]
+ ]
"Created: / 16-07-2010 / 11:41:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 26-07-2012 / 15:46:56 / cg"
@@ -1010,7 +1010,7 @@
annotationsAt: key do: block
self annotationsDo: [:annot|
- annot key == key ifTrue:[block value: annot]
+ annot key == key ifTrue:[block value: annot]
]
"Created: / 16-07-2010 / 11:48:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -1019,10 +1019,10 @@
annotationsAt: key1 orAt: key2
- ^OrderedCollection
- streamContents:[:annotStream|
- self annotationsAt: key1 orAt: key2 do: [:annot|annotStream nextPut: annot]
- ]
+ ^OrderedCollection
+ streamContents:[:annotStream|
+ self annotationsAt: key1 orAt: key2 do: [:annot|annotStream nextPut: annot]
+ ]
"Created: / 16-07-2010 / 11:41:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 26-07-2012 / 15:49:11 / cg"
@@ -1030,9 +1030,9 @@
annotationsAt: key1 orAt: key2 do: block
self annotationsDo:[:annot |
- (annot key == key1 or:[annot key == key2]) ifTrue:[
- block value: annot
- ]
+ (annot key == key1 or:[annot key == key2]) ifTrue:[
+ block value: annot
+ ]
]
"Created: / 16-07-2010 / 11:47:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -1042,7 +1042,7 @@
annotationsDo: aBlock
annotations isNil ifTrue:[^nil].
1 to: annotations size do: [:i|
- aBlock value: (self annotationAtIndex: i)
+ aBlock value: (self annotationAtIndex: i)
].
"Created: / 02-07-2010 / 22:33:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -1139,7 +1139,7 @@
INT f = __intVal(__INST(flags));
if (f & F_RESTRICTED) {
- RETURN (true);
+ RETURN (true);
}
#endif
%}.
@@ -1170,15 +1170,15 @@
INT p;
if (aSymbol == @symbol(public))
- p = 0;
+ p = 0;
else if (aSymbol == @symbol(protected))
- p = F_PRIVATE;
+ p = F_PRIVATE;
else if (aSymbol == @symbol(private))
- p = F_CLASSPRIVATE;
+ p = F_CLASSPRIVATE;
else if (aSymbol == @symbol(ignored))
- p = F_IGNORED;
+ p = F_IGNORED;
else
- RETURN(false); /* illegal symbol */
+ RETURN(false); /* illegal symbol */
f = (f & ~M_PRIVACY) | p;
@@ -1216,18 +1216,18 @@
# ifdef F_PRIVATE
case F_PRIVATE:
- RETURN (@symbol(protected));
- break;
+ RETURN (@symbol(protected));
+ break;
# endif
# ifdef F_CLASSPRIVATE
case F_CLASSPRIVATE:
- RETURN (@symbol(private));
- break;
+ RETURN (@symbol(private));
+ break;
# endif
# ifdef F_IGNORED
case F_IGNORED:
- RETURN (@symbol(ignored));
- break;
+ RETURN (@symbol(ignored));
+ break;
# endif
}
#endif
@@ -1254,19 +1254,19 @@
oldPrivacy := self privacy.
(self setPrivacy:aSymbol flushCaches:true) ifTrue:[
- |myClass mySelector|
-
- myClass := self mclass.
- mySelector := self selector.
-
- self changed:#privacy. "/ will vanish
- myClass notNil ifTrue:[
- mySelector notNil ifTrue:[
- myClass changed:#methodPrivacy with:mySelector. "/ will vanish
- Smalltalk changed:#privacyOfMethod with:(Array with:myClass with:self with:oldPrivacy).
- myClass addChangeRecordForMethodPrivacy:self.
- ]
- ]
+ |myClass mySelector|
+
+ myClass := self mclass.
+ mySelector := self selector.
+
+ self changed:#privacy. "/ will vanish
+ myClass notNil ifTrue:[
+ mySelector notNil ifTrue:[
+ myClass changed:#methodPrivacy with:mySelector. "/ will vanish
+ Smalltalk changed:#privacyOfMethod with:(Array with:myClass with:self with:oldPrivacy).
+ myClass addChangeRecordForMethodPrivacy:self.
+ ]
+ ]
]
"Modified: / 23-11-2006 / 17:03:20 / cg"
@@ -1293,12 +1293,12 @@
old = f;
if (aBoolean == true)
- f |= F_RESTRICTED;
+ f |= F_RESTRICTED;
else
- f &= ~F_RESTRICTED;
+ f &= ~F_RESTRICTED;
__INST(flags) = __mkSmallInteger(f);
if (old & F_RESTRICTED)
- RETURN(true);
+ RETURN(true);
#endif
%}.
^ false
@@ -1353,13 +1353,13 @@
"/ no need to flush, if changing from private to public
"/
doFlush ifTrue:[
- (aSymbol == #public and:[old ~~ #ignored]) ifFalse:[
- (sel := self selector) notNil ifTrue:[
- ObjectMemory flushCachesForSelector:sel numArgs:self argumentCount
- ] ifFalse:[
- ObjectMemory flushCaches.
- ].
- ].
+ (aSymbol == #public and:[old ~~ #ignored]) ifFalse:[
+ (sel := self selector) notNil ifTrue:[
+ ObjectMemory flushCachesForSelector:sel numArgs:self argumentCount
+ ] ifFalse:[
+ ObjectMemory flushCaches.
+ ].
+ ].
].
^ true
! !
@@ -1380,17 +1380,17 @@
|mthd|
byteCode notNil ifTrue:[
- "
- is already a bytecoded method
- "
- ^ self
+ "
+ is already a bytecoded method
+ "
+ ^ self
].
ParserFlags
- withSTCCompilation:#never
- do:[
- mthd := self asExecutableMethod.
- ].
+ withSTCCompilation:#never
+ do:[
+ mthd := self asExecutableMethod.
+ ].
^ mthd
"Created: 24.10.1995 / 14:02:32 / cg"
@@ -1401,10 +1401,10 @@
|mthd|
ParserFlags
- withSTCCompilation:#never
- do:[
- mthd := self asExecutableMethodWithSource:newSource.
- ].
+ withSTCCompilation:#never
+ do:[
+ mthd := self asExecutableMethodWithSource:newSource.
+ ].
^ mthd
"Created: 24.10.1995 / 14:02:32 / cg"
@@ -1423,23 +1423,23 @@
|temporaryMethod sourceString|
byteCode notNil ifTrue:[
- "
- is already a bytecoded method
- "
- ^ self
+ "
+ is already a bytecoded method
+ "
+ ^ self
].
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
].
temporaryMethod := self asExecutableMethodWithSource:sourceString.
(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)
@@ -1453,8 +1453,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,
@@ -1464,53 +1464,53 @@
(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 lazy|
-
- 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
- ].
- ].
- ] ensure:[
- 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 lazy|
+
+ 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
+ ].
+ ].
+ ] ensure:[
+ 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)
@@ -1533,7 +1533,7 @@
aCopy := super copy.
sourcePosition notNil ifTrue:[
- aCopy source:(self source)
+ aCopy source:(self source)
].
aCopy mclass:nil.
^ aCopy
@@ -1566,7 +1566,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Modified: 4.11.1996 / 22:45:06 / cg"
!
@@ -1585,7 +1585,7 @@
*/
%}.
^ InvalidCodeError
- raiseErrorString:'invalid method - not executable'.
+ raiseErrorString:'invalid method - not executable'.
"Created: / 14-09-2011 / 11:23:49 / sr"
!
@@ -1604,7 +1604,7 @@
*/
%}.
^ InvalidCodeError
- 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"
@@ -1624,7 +1624,7 @@
*/
%}.
^ InvalidCodeError
- 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"
@@ -1644,7 +1644,7 @@
*/
%}.
^ InvalidCodeError
- 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"
@@ -1664,7 +1664,7 @@
*/
%}.
^ InvalidCodeError
- 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"
@@ -1684,7 +1684,7 @@
*/
%}.
^ InvalidCodeError
- 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"
@@ -1704,7 +1704,7 @@
*/
%}.
^ InvalidCodeError
- 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"
@@ -1724,7 +1724,7 @@
*/
%}.
^ InvalidCodeError
- 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"
@@ -1744,7 +1744,7 @@
*/
%}.
^ InvalidCodeError
- 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"
@@ -1764,7 +1764,7 @@
*/
%}.
^ InvalidCodeError
- 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"
@@ -1784,7 +1784,7 @@
*/
%}.
^ InvalidCodeError
- 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"
@@ -1804,7 +1804,7 @@
*/
%}.
^ InvalidCodeError
- 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"
@@ -1824,7 +1824,7 @@
*/
%}.
^ InvalidCodeError
- 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"
@@ -1844,7 +1844,7 @@
*/
%}.
^ InvalidCodeError
- 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"
@@ -1864,7 +1864,7 @@
*/
%}.
^ InvalidCodeError
- 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"
@@ -1913,8 +1913,8 @@
*/
%}.
^ InvalidCodeError
- raiseRequestWith:self
- errorString:'invalid method - not compiled'.
+ raiseRequestWith:self
+ errorString:'invalid method - not compiled'.
"Modified: 4.11.1996 / 22:58:02 / cg"
!
@@ -1933,8 +1933,8 @@
*/
%}.
^ InvalidCodeError
- 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"
@@ -1957,30 +1957,30 @@
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.
+ (classAndSelector methodClass) name printOn:aStream.
+ aStream nextPutAll:' '.
+ (classAndSelector methodSelector) printOn:aStream.
] ifFalse:[
- "
- sorry, a method which is nowhere anchored
- "
- aStream nextPutAll:'unbound'
+ "
+ sorry, a method which is nowhere anchored
+ "
+ aStream nextPutAll:'unbound'
].
aStream nextPut:$).
wrapped ifTrue:[
- aStream nextPutAll:'; wrapped'
+ aStream nextPutAll:'; wrapped'
].
"
@@ -2002,7 +2002,7 @@
who := self who.
who notNil ifTrue:[
- ^ who methodClass name , ' >> ' , (who methodSelector storeString)
+ ^ who methodClass name , ' >> ' , (who methodSelector storeString)
].
^ 'unboundMethod'
@@ -2028,21 +2028,21 @@
annotationOrArray := annotation := annotations at: index.
annotationOrArray isArray ifTrue:[
- args := annotationOrArray size == 2
- ifTrue:[annotationOrArray second]
- ifFalse:[#()].
- args isArray ifFalse:[args := Array with: args].
- annotation := Annotation
- method:self
- key: annotationOrArray first
- arguments: args.
- annotation isUnknown ifFalse:[
- annotations isImmutable ifTrue:[
- annotations := annotations asArray
- ].
- annotations at: index put: annotation.
+ args := annotationOrArray size == 2
+ ifTrue:[annotationOrArray second]
+ ifFalse:[#()].
+ args isArray ifFalse:[args := Array with: args].
+ annotation := Annotation
+ method:self
+ key: annotationOrArray first
+ arguments: args.
+ annotation isUnknown ifFalse:[
+ annotations isImmutable ifTrue:[
+ annotations := annotations asArray
+ ].
+ annotations at: index put: annotation.
"/ annotation annotatesMethod: self
- ].
+ ].
].
^annotation
@@ -2059,9 +2059,9 @@
annotations isNil ifTrue:[^nil].
annotations keysAndValuesDo: [:index :annotationOrArray|
- annotationOrArray isArray
- ifTrue: [annotationOrArray first == key ifTrue:[^index]]
- ifFalse:[annotationOrArray key == key ifTrue:[^index]]
+ annotationOrArray isArray
+ ifTrue: [annotationOrArray first == key ifTrue:[^index]]
+ ifFalse:[annotationOrArray key == key ifTrue:[^index]]
].
^nil.
@@ -2076,14 +2076,16 @@
|lastStream|
(package notNil and:[package ~= PackageId noProjectID]) ifTrue:[
- LastFileLock critical:[
- lastStream := LastFileReference at:1.
- (lastStream notNil and:[lastStream ~= 0 and:[lastStream isOpen]]) ifTrue:[
- lastStream close.
- ].
- LastSourceFileName := package,'/',source.
- LastFileReference at:1 put:aStream.
- ].
+ LastFileLock critical:[
+ lastStream := LastFileReference at:1.
+ (lastStream notNil
+ and:[lastStream class ~~ SmallInteger
+ and:[lastStream isOpen]]) ifTrue:[
+ lastStream close.
+ ].
+ LastSourceFileName := package,'/',source.
+ LastFileReference at:1 put:aStream.
+ ].
].
!
@@ -2109,29 +2111,29 @@
|dir fileName aStream|
package notNil ifTrue:[
- "/
- "/ old: look in 'source/<filename>'
- "/ this is still kept in order to find user-private
- "/ classes in her currentDirectory.
- "/
- fileName := Smalltalk getSourceFileName:(package copyReplaceAll:$: with:$/) , '/' , source.
- fileName notNil ifTrue:[
- aStream := fileName asFilename readStreamOrNil.
- aStream notNil ifTrue:[^ aStream].
- ].
- "/
- "/ new: look in package-dir
- "/
- dir := Smalltalk getPackageDirectoryForPackage:package.
- dir notNil ifTrue:[
- fileName := dir construct:source.
- aStream := fileName asFilename readStreamOrNil.
- aStream notNil ifTrue:[^ aStream].
- ].
+ "/
+ "/ old: look in 'source/<filename>'
+ "/ this is still kept in order to find user-private
+ "/ classes in her currentDirectory.
+ "/
+ fileName := Smalltalk getSourceFileName:(package copyReplaceAll:$: with:$/) , '/' , source.
+ fileName notNil ifTrue:[
+ aStream := fileName asFilename readStreamOrNil.
+ aStream notNil ifTrue:[^ aStream].
+ ].
+ "/
+ "/ new: look in package-dir
+ "/
+ dir := Smalltalk getPackageDirectoryForPackage:package.
+ dir notNil ifTrue:[
+ fileName := dir construct:source.
+ aStream := fileName asFilename readStreamOrNil.
+ aStream notNil ifTrue:[^ aStream].
+ ].
].
fileName := Smalltalk getSourceFileName:source.
fileName notNil ifTrue:[
- aStream := fileName asFilename readStreamOrNil.
+ aStream := fileName asFilename readStreamOrNil.
].
^ aStream
!
@@ -2153,28 +2155,30 @@
sourcePosition isNil ifTrue:[^ source readStream].
usingCacheBoolean ifTrue:[
- (package notNil and:[package ~= PackageId noProjectID]) ifTrue:[
- "/ 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.
- (aStream isNil or:[aStream == 0 or:[aStream isOpen not]]) ifTrue:[
- aStream := nil.
- LastFileReference at:1 put:nil.
- ].
- (aStream notNil and:[LastSourceFileName ~= (package,'/',source)]) ifTrue:[
- aStream := nil.
- ].
- ].
-
- aStream notNil ifTrue:[
- ^ aStream
- ].
- ].
+ (package notNil and:[package ~= PackageId noProjectID]) ifTrue:[
+ "/ 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.
+ (aStream isNil
+ or:[aStream class == SmallInteger
+ or:[aStream isOpen not]]) ifTrue:[
+ aStream := nil.
+ LastFileReference at:1 put:nil.
+ ].
+ (aStream notNil and:[LastSourceFileName ~= (package,'/',source)]) ifTrue:[
+ aStream := nil.
+ ].
+ ].
+
+ aStream notNil ifTrue:[
+ ^ aStream
+ ].
+ ].
].
"/ a negative sourcePosition indicates
@@ -2185,47 +2189,47 @@
"/ and having a clue for which file is meant later.
sourcePosition < 0 ifTrue:[
- aStream := source asFilename readStreamOrNil.
- aStream isNil ifTrue:[
- "/ search in some standard places
- fileName := Smalltalk getSourceFileName:source.
- fileName notNil ifTrue:[
- aStream := fileName asFilename readStreamOrNil.
- ].
- ].
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ].
+ aStream := source asFilename readStreamOrNil.
+ aStream isNil ifTrue:[
+ "/ search in some standard places
+ fileName := Smalltalk getSourceFileName:source.
+ fileName notNil ifTrue:[
+ aStream := fileName asFilename readStreamOrNil.
+ ].
+ ].
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ].
].
"/
"/ if there is no SourceManager, look in local standard places first
"/
(mclass notNil and:[package == mclass package]) ifTrue:[
- mgr := mclass sourceCodeManagerFromBinaryRevision
+ mgr := mclass sourceCodeManagerFromBinaryRevision
] ifFalse:[
- "I'm an extension and we don't have binary revision info (!!)
- for extensions, try to guess here"
- pkgDef := ProjectDefinition definitionClassForPackage: package.
- pkgDef notNil ifTrue:[
- mgr := pkgDef sourceCodeManagerFromBinaryRevision
- ] ifFalse:[
- "OK, trust the configuration"
- mgr := AbstractSourceCodeManager managerForPackage: package
- ]
+ "I'm an extension and we don't have binary revision info (!!)
+ for extensions, try to guess here"
+ pkgDef := ProjectDefinition definitionClassForPackage: package.
+ pkgDef notNil ifTrue:[
+ mgr := pkgDef sourceCodeManagerFromBinaryRevision
+ ] ifFalse:[
+ "OK, trust the configuration"
+ mgr := AbstractSourceCodeManager managerForPackage: package
+ ]
].
(Class tryLocalSourceFirst or:[mgr isNil]) ifTrue:[
- aStream := self localSourceStream.
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ].
+ aStream := self localSourceStream.
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ].
].
"/
@@ -2233,39 +2237,39 @@
"/
who := self who.
who notNil ifTrue:[
- myClass := who methodClass.
-
- (package notNil and:[package ~= myClass package and:[package ~= #'__NoProject__']]) ifTrue:[
- "/ I am an extension
- mgr notNil ifTrue:[
- "/ try to get the source using my package information ...
- mod := package asPackageId module.
- dir := package asPackageId directory.
- aStream := mgr streamForExtensionFile:source package:package directory:dir module:mod cache:true.
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ].
- ].
- "/ consult the local fileSystem
- aStream := self localSourceStream.
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ]
- ].
-
- aStream := myClass sourceStreamFor:source.
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ].
+ myClass := who methodClass.
+
+ (package notNil and:[package ~= myClass package and:[package ~= #'__NoProject__']]) ifTrue:[
+ "/ I am an extension
+ mgr notNil ifTrue:[
+ "/ try to get the source using my package information ...
+ mod := package asPackageId module.
+ dir := package asPackageId directory.
+ aStream := mgr streamForExtensionFile:source package:package directory:dir module:mod cache:true.
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ].
+ ].
+ "/ consult the local fileSystem
+ aStream := self localSourceStream.
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ]
+ ].
+
+ aStream := myClass sourceStreamFor:source.
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ].
].
"/
@@ -2273,49 +2277,49 @@
"/ (if there is a source-code manager - otherwise, we already did that)
"/
(mgr notNil and:[Class tryLocalSourceFirst not]) ifTrue:[
- aStream := self localSourceStream.
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ].
+ aStream := self localSourceStream.
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ].
].
"/
"/ final chance: try current directory
"/
aStream isNil ifTrue:[
- aStream := source asFilename readStreamOrNil.
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ].
+ aStream := source asFilename readStreamOrNil.
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ].
].
(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.
- (classNameSymbol := className asSymbolIfInterned) notNil ifTrue:[
- myClass := Smalltalk at:classNameSymbol ifAbsent:nil.
- myClass notNil ifTrue:[
- aStream := myClass sourceStreamFor:source.
- aStream notNil ifTrue:[
- usingCacheBoolean ifTrue:[
- self cacheSourceStream:aStream.
- ].
- ^ aStream
- ].
- ]
- ]
+ "/
+ "/ 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.
+ (classNameSymbol := className asSymbolIfInterned) notNil ifTrue:[
+ myClass := Smalltalk at:classNameSymbol ifAbsent:nil.
+ myClass notNil ifTrue:[
+ aStream := myClass sourceStreamFor:source.
+ aStream notNil ifTrue:[
+ usingCacheBoolean ifTrue:[
+ self cacheSourceStream:aStream.
+ ].
+ ^ aStream
+ ].
+ ]
+ ]
].
^ nil
@@ -2327,8 +2331,8 @@
"set the lookupObject (low level - use lookupObject:)"
lookupObject ~~ lookup ifTrue:[
- lookupObject := lookup.
- ObjectMemory flushCaches.
+ lookupObject := lookup.
+ ObjectMemory flushCaches.
].
"Created: / 11-07-2010 / 19:31:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -2336,9 +2340,9 @@
sourceChunkFromStream:aStream
PositionError handle:[:ex |
- ^ nil
+ ^ nil
] do:[
- aStream position:(sourcePosition ? 1) abs - 1.
+ aStream position:(sourcePosition ? 1) abs - 1.
].
^ aStream nextChunk.
!
@@ -2353,7 +2357,7 @@
rawStream := self rawSourceStreamUsingCache:usingCacheBoolean.
rawStream isNil ifTrue:[
- ^ nil.
+ ^ nil.
].
rawStream position:0.
@@ -2374,7 +2378,7 @@
OBJ nr = 0;
if (f & F_PRIMITIVE) {
- nr = __INST(code_);
+ nr = __INST(code_);
}
RETURN (nr);
#endif
@@ -2428,15 +2432,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
@@ -2471,7 +2475,7 @@
containingClass
"return the class I am defined in.
Notice, that the containingClass query returns nil, if a method is wrapped or no longer valid
- due to an accept in a browser or debugger.
+ due to an accept in a browser or debugger.
However, the mclass slot still contains a reference to the once valid class and can be fetched
via getMclass.
See comment in who."
@@ -2481,17 +2485,17 @@
|who|
mclass notNil ifTrue:[
- "/ check if this (cached) info is still valid...
- (mclass containsMethod:self) ifTrue:[
- ^ mclass
- ].
- ^ nil.
+ "/ check if this (cached) info is still valid...
+ (mclass containsMethod:self) ifTrue:[
+ ^ mclass
+ ].
+ ^ nil.
].
who := self who.
who notNil ifTrue:[
- mclass := who methodClass.
- ^ mclass
+ mclass := who methodClass.
+ ^ mclass
].
"
none found - sorry
@@ -2512,38 +2516,38 @@
|newMethod function|
(self
- literalsDetect:[:lit |
- #(
- #'invoke'
- #'invokeWith:'
- #'invokeWith:with:'
- #'invokeWith:with:with:'
- #'invokeWith:with:with:with:'
- #'invokeWithArguments:'
- #'invokeCPPVirtualOn:'
- #'invokeCPPVirtualOn:with:'
- #'invokeCPPVirtualOn:with:with:'
- #'invokeCPPVirtualOn:with:with:with:'
- #'invokeCPPVirtualOn:with:with:with:with:'
- #'invokeCPPVirtualOn:withArguments:'
- ) includes:lit
- ]
- ifNone:nil) notNil
+ literalsDetect:[:lit |
+ #(
+ #'invoke'
+ #'invokeWith:'
+ #'invokeWith:with:'
+ #'invokeWith:with:with:'
+ #'invokeWith:with:with:with:'
+ #'invokeWithArguments:'
+ #'invokeCPPVirtualOn:'
+ #'invokeCPPVirtualOn:with:'
+ #'invokeCPPVirtualOn:with:with:'
+ #'invokeCPPVirtualOn:with:with:with:'
+ #'invokeCPPVirtualOn:with:with:with:with:'
+ #'invokeCPPVirtualOn:withArguments:'
+ ) includes:lit
+ ]
+ ifNone:nil) notNil
ifTrue:[
- "/ sigh - for stc-compiled code, this does not work:
- function := self literalsDetect:[:lit | lit isExternalLibraryFunction] ifNone:nil.
- function isNil ifTrue:[
- "/ parse it and ask the parser
- newMethod := Compiler compile:self source forClass:self mclass install:false.
- function := newMethod literalsDetect:[:lit | lit isExternalLibraryFunction] ifNone:nil.
- ].
- ^ function
+ "/ sigh - for stc-compiled code, this does not work:
+ function := self literalsDetect:[:lit | lit isExternalLibraryFunction] ifNone:nil.
+ function isNil ifTrue:[
+ "/ parse it and ask the parser
+ newMethod := Compiler compile:self source forClass:self mclass install:false.
+ function := newMethod literalsDetect:[:lit | lit isExternalLibraryFunction] ifNone:nil.
+ ].
+ ^ function
].
^ nil
"
(IDispatchPointer compiledMethodAt:#'invokeGetTypeInfo:_:_:')
- externalLibraryFunction
+ externalLibraryFunction
"
!
@@ -2573,7 +2577,7 @@
"
Method allInstancesDo:[:m |
- (m hasAnyResource:#(image canvas)) ifTrue:[self halt]
+ (m hasAnyResource:#(image canvas)) ifTrue:[self halt]
].
"
!
@@ -2589,10 +2593,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 ...
@@ -2687,20 +2691,20 @@
m := self trapMethodForNumArgs:(self argumentCount).
(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
@@ -2781,7 +2785,7 @@
mclass
"return the class in which the receiver is currently contained in.
Notice, that the mclass query returns nil, if a method is wrapped or no longer valid
- due to an accept in a browser or debugger.
+ due to an accept in a browser or debugger.
However, the mclass slot still contains a reference to the once valid class and can be fetched
via getMclass.
Same as #containingClass, for ST80 compatibility."
@@ -2815,11 +2819,11 @@
(Method compiledMethodAt:#printOn:) messagesSent
(Point compiledMethodAt:#x:) messagesSent
- (WindowEvent class compiledMethodAt:#focusInView:) messagesSent
- (WindowEvent class compiledMethodAt:#focusInView:) messagesPossiblySent
-
- (Method compiledMethodAt:#messagesPossiblySent) messagesSent
- (Method compiledMethodAt:#messagesPossiblySent) messagesPossiblySent
+ (WindowEvent class compiledMethodAt:#focusInView:) messagesSent
+ (WindowEvent class compiledMethodAt:#focusInView:) messagesPossiblySent
+
+ (Method compiledMethodAt:#messagesPossiblySent) messagesSent
+ (Method compiledMethodAt:#messagesPossiblySent) messagesPossiblySent
"
!
@@ -2856,7 +2860,7 @@
"return a collection with the methods argument and variable names.
Uses Parser to parse methods source and extract the names.
Returns an empty collection if the source is not available, or some other
- syntax/parse error occurred.
+ syntax/parse error occurred.
For methods with no args and no vars, an empty collection is returned."
|parserClass parser sourceString argNames varNames|
@@ -2864,13 +2868,13 @@
parserClass := self parserClass.
sourceString := self source.
(parserClass notNil and:[sourceString notNil]) ifTrue:[
- parser := parserClass parseMethodArgAndVarSpecificationSilent:sourceString.
- (parser isNil or:[parser == #Error]) ifTrue:[^ #()].
- argNames := parser methodArgs.
- varNames := parser methodVars.
- argNames isNil ifTrue:[^ varNames ? #()].
- varNames isNil ifTrue:[^ argNames ? #()].
- ^ (argNames , varNames)
+ parser := parserClass parseMethodArgAndVarSpecificationSilent:sourceString.
+ (parser isNil or:[parser == #Error]) ifTrue:[^ #()].
+ argNames := parser methodArgs.
+ varNames := parser methodVars.
+ argNames isNil ifTrue:[^ varNames ? #()].
+ varNames isNil ifTrue:[^ argNames ? #()].
+ ^ (argNames , varNames)
].
^ #()
@@ -2885,9 +2889,9 @@
Returns nil if the source is not available, or some other
syntax/parse error occurred. For methods with no args and no vars,
an empty collection is returned."
-
+
^self methodArgAndVarNames
-
+
"Created: / 18-12-2012 / 18:17:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -2916,30 +2920,30 @@
line := (text at:2).
nQuote := line occurrencesOf:(Character doubleQuote).
(nQuote == 2) ifTrue:[
- qIndex := line indexOf:(Character doubleQuote).
- qIndex2 := line indexOf:(Character doubleQuote) startingAt:(qIndex + 1).
- ^ line copyFrom:(qIndex + 1) to:(qIndex2 - 1)
+ qIndex := line indexOf:(Character doubleQuote).
+ qIndex2 := line indexOf:(Character doubleQuote) startingAt:(qIndex + 1).
+ ^ line copyFrom:(qIndex + 1) to:(qIndex2 - 1)
].
(nQuote == 1) ifTrue:[
- qIndex := line indexOf:(Character doubleQuote).
- comment := line copyFrom:(qIndex + 1).
- (line indexOf:$/ startingAt:qIndex) == (qIndex+1) ifTrue:[
- "/ an EOL comment
- ^ (comment copyFrom:2) withoutSeparators
- ].
-
- "/ not an EOL comment
- index := 3.
- line := text at:index.
- nQuote := line occurrencesOf:(Character doubleQuote).
- [nQuote ~~ 1] whileTrue:[
- comment := comment , Character cr asString , line withoutSpaces.
- index := index + 1.
- line := text at:index.
- nQuote := line occurrencesOf:(Character doubleQuote)
- ].
- qIndex := line indexOf:(Character doubleQuote).
- ^ comment , Character cr asString , (line copyTo:(qIndex - 1)) withoutSpaces
+ qIndex := line indexOf:(Character doubleQuote).
+ comment := line copyFrom:(qIndex + 1).
+ (line indexOf:$/ startingAt:qIndex) == (qIndex+1) ifTrue:[
+ "/ an EOL comment
+ ^ (comment copyFrom:2) withoutSeparators
+ ].
+
+ "/ not an EOL comment
+ index := 3.
+ line := text at:index.
+ nQuote := line occurrencesOf:(Character doubleQuote).
+ [nQuote ~~ 1] whileTrue:[
+ comment := comment , Character cr asString , line withoutSpaces.
+ index := index + 1.
+ line := text at:index.
+ nQuote := line occurrencesOf:(Character doubleQuote)
+ ].
+ qIndex := line indexOf:(Character doubleQuote).
+ ^ comment , Character cr asString , (line copyTo:(qIndex - 1)) withoutSpaces
].
^ nil
@@ -2952,8 +2956,8 @@
"return the string that defines the method and the arguments"
^ self class
- methodDefinitionTemplateForSelector:self selector
- andArgumentNames:self methodArgNames
+ methodDefinitionTemplateForSelector:self selector
+ andArgumentNames:self methodArgNames
"
(self compiledMethodAt:#printOn:) methodDefinitionTemplate
@@ -2996,8 +3000,8 @@
list isEmptyOrNil ifTrue:[^ nil].
histLine := list last.
^ Timestamp
- fromDate:histLine date
- andTime:histLine time
+ fromDate:histLine date
+ andTime:histLine time
"
(Method compiledMethodAt:#modificationTime) modificationTime
@@ -3038,8 +3042,8 @@
| mth |
mth := self overwrittenMethod.
[ mth notNil ] whileTrue:
- [mth == aMethod ifTrue:[^true].
- mth := mth overwrittenMethod].
+ [mth == aMethod ifTrue:[^true].
+ mth := mth overwrittenMethod].
^false
"Created: / 05-07-2012 / 10:52:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -3054,7 +3058,7 @@
"
(Method compiledMethodAt:#parse:return:or:)
- parse:#'parseMethodSilent:' return:#sentMessages or:#()
+ parse:#'parseMethodSilent:' return:#sentMessages or:#()
"
!
@@ -3071,35 +3075,35 @@
"/ is very common with the new browser's info displays, we cache a few
"/ of them. If the same is parsed soon after, we do not have to parse again.
LastParseTreeCache notNil ifTrue:[
- "/ to flush: LastParseTreeCache removeAll.
- cachedInfo := LastParseTreeCache at:self ifAbsent:nil.
- cachedInfo notNil ifTrue:[
- cachedInfo method == self ifTrue:[
- cachedInfo parserClass == parserClass ifTrue:[
- "/ Transcript show:'hit '; showCR:self.
- ^ cachedInfo parser perform:accessSelector
- ]
- ].
- LastParseTreeCache removeKey:self
- ]
+ "/ to flush: LastParseTreeCache removeAll.
+ cachedInfo := LastParseTreeCache at:self ifAbsent:nil.
+ cachedInfo notNil ifTrue:[
+ cachedInfo method == self ifTrue:[
+ cachedInfo parserClass == parserClass ifTrue:[
+ "/ Transcript show:'hit '; showCR:self.
+ ^ cachedInfo parser perform:accessSelector
+ ]
+ ].
+ LastParseTreeCache removeKey:self
+ ]
].
sourceString := self source.
(parserClass notNil and:[sourceString notNil]) ifTrue:[
- parseSelector argumentCount == 2 ifTrue:[
- parser := parserClass perform:parseSelector with:sourceString with:arg2.
- ] ifFalse:[
- parser := parserClass perform:parseSelector with:sourceString.
- ].
- (parser isNil or:[parser == #Error]) ifTrue:[^ valueIfNoSource].
- "do not cache the parser, if it was parsing for code - a lot of information is missing then"
- (self mclass notNil and:[parser wasParsedForCode not]) ifTrue:[
- LastParseTreeCache isNil ifTrue:[
- LastParseTreeCache := CacheDictionary new:500.
- ].
- LastParseTreeCache at:self put:(ParserCacheEntry new parserClass:parserClass method:self parser:parser).
- ].
- ^ parser perform:accessSelector
+ parseSelector argumentCount == 2 ifTrue:[
+ parser := parserClass perform:parseSelector with:sourceString with:arg2.
+ ] ifFalse:[
+ parser := parserClass perform:parseSelector with:sourceString.
+ ].
+ (parser isNil or:[parser == #Error]) ifTrue:[^ valueIfNoSource].
+ "do not cache the parser, if it was parsing for code - a lot of information is missing then"
+ (self mclass notNil and:[parser wasParsedForCode not]) ifTrue:[
+ LastParseTreeCache isNil ifTrue:[
+ LastParseTreeCache := CacheDictionary new:500.
+ ].
+ LastParseTreeCache at:self put:(ParserCacheEntry new parserClass:parserClass method:self parser:parser).
+ ].
+ ^ parser perform:accessSelector
].
^ valueIfNoSource
@@ -3107,7 +3111,7 @@
LastParseTreeCache removeAll.
(Method compiledMethodAt:#parse:return:or:)
- parse:#'parseMethodSilent:' return:#sentMessages or:#()
+ parse:#'parseMethodSilent:' return:#sentMessages or:#()
"
"Modified: / 01-03-2012 / 14:30:50 / cg"
@@ -3121,15 +3125,15 @@
src := self source.
src isNil ifTrue:[
- ^ nil "/ actually: dont know
+ ^ nil "/ actually: dont know
].
self parserClass isNil ifTrue:[
- ^ nil
+ ^ nil
].
parser := self parserClass parseMethod: src.
(parser isNil or: [parser == #Error]) ifTrue:[
- ^ nil "/ actually error
+ ^ nil "/ actually error
].
^ annotations := parser annotations.
@@ -3139,26 +3143,26 @@
parseResources
"return the method's resource spec; either nil or a collection of symbols.
Resources are a special kind of annotation, of the form:
- <resource: #symbol...>
+ <resource: #symbol...>
and flags methods which depend on keyboard bindings or provide menus, specs or bitmap images"
|src parser|
src := self source.
src isNil ifTrue:[
- ^ nil "/ actually: dont know
+ ^ nil "/ actually: dont know
].
(src findString:'resource:') == 0 ifTrue:[
- ^ nil "/ actually: error
+ ^ nil "/ actually: error
].
"/ no need to parse all - only interested in resource-info
self parserClass isNil ifTrue:[
- ^ nil
+ ^ nil
].
parser := self parserClass parseMethodArgAndVarSpecificationSilent:src in:nil.
parser isNil ifTrue:[
- ^ nil "/ actually error
+ ^ nil "/ actually error
].
^ parser primitiveResources.
!
@@ -3168,7 +3172,7 @@
(such as perform) with aSelectorSymbol as selector."
(self referencesLiteral:aSelectorSymbol) ifTrue:[
- ^ self messagesPossiblySent includesIdentical:aSelectorSymbol
+ ^ self messagesPossiblySent includesIdentical:aSelectorSymbol
].
^ false
!
@@ -3258,31 +3262,31 @@
versions := OrderedCollection new.
ChangeSet current reverseDo:[:change |
- (change isMethodChange
- and:[ (change selector == sel)
- and:[ change changeClass == cls ]])
- ifTrue:[
- versions addFirst:change.
- lastChange := change.
- (count notNil and:[versions size == count]) ifTrue:[
- ^ versions
- ]
- ]
+ (change isMethodChange
+ and:[ (change selector == sel)
+ and:[ change changeClass == cls ]])
+ ifTrue:[
+ versions addFirst:change.
+ lastChange := change.
+ (count notNil and:[versions size == count]) ifTrue:[
+ ^ versions
+ ]
+ ]
].
lastChange notNil ifTrue:[
- last := lastChange previousVersion.
- last notNil ifTrue:[
- firstSrc := last source.
- (firstSrc notEmptyOrNil
- and:[ firstSrc ~= lastChange source]) ifTrue:[
- versions addFirst:(MethodDefinitionChange
- className:lastChange className
- selector:lastChange selector
- source:firstSrc
- category:lastChange category).
- ]
- ]
+ last := lastChange previousVersion.
+ last notNil ifTrue:[
+ firstSrc := last source.
+ (firstSrc notEmptyOrNil
+ and:[ firstSrc ~= lastChange source]) ifTrue:[
+ versions addFirst:(MethodDefinitionChange
+ className:lastChange className
+ selector:lastChange selector
+ source:firstSrc
+ category:lastChange category).
+ ]
+ ]
].
^ versions
@@ -3324,10 +3328,10 @@
(super refersToLiteral: anObject) ifTrue:[^ true].
self annotationsDo:[:annot |
- (annot refersToLiteral: anObject) ifTrue:[
- "/ self halt.
- ^ true
- ].
+ (annot refersToLiteral: anObject) ifTrue:[
+ "/ self halt.
+ ^ true
+ ].
].
^ false
@@ -3338,10 +3342,10 @@
(super refersToLiteralMatching: aMatchString) ifTrue:[^ true].
self annotationsDo:[:annot |
- (annot refersToLiteralMatching: aMatchString) ifTrue:[
- "/ self halt.
- ^ true
- ].
+ (annot refersToLiteralMatching: aMatchString) ifTrue:[
+ "/ self halt.
+ ^ true
+ ].
].
^ false
@@ -3356,9 +3360,9 @@
|resources|
(resources := self resources) notNil ifTrue:[
- resources keysAndValuesDo:[:key :val|
- ^ key
- ].
+ resources keysAndValuesDo:[:key :val|
+ ^ key
+ ].
].
^ nil
!
@@ -3373,7 +3377,7 @@
resources := IdentityDictionary new.
self annotationsAt: #resource: orAt: #resource:value: do:[:annot|
- resources at: annot type put: annot value ? true
+ resources at: annot type put: annot value ? true
].
^ resources
@@ -3411,12 +3415,12 @@
with aSelectorSymbol as selector."
(self referencesLiteral:aSelectorSymbol) ifTrue:[
- "/ cg: was temporarily disabled to speed up some searches.
- "/ I think, we have to change the caller's to call referencesLiteral: instead,
- "/ if there is any speed problem there. Not here.
- "/ ^ true.
-
- ^ self messagesSent includesIdentical:aSelectorSymbol
+ "/ cg: was temporarily disabled to speed up some searches.
+ "/ I think, we have to change the caller's to call referencesLiteral: instead,
+ "/ if there is any speed problem there. Not here.
+ "/ ^ true.
+
+ ^ self messagesSent includesIdentical:aSelectorSymbol
].
^ false
!
@@ -3438,13 +3442,13 @@
|msgs|
(aCollectionOfSelectorSymbols contains:[:sym | self referencesLiteral:sym]) ifTrue:[
- "/ cg: was temporarily disabled to speed up some searches.
- "/ I think, we have to change the caller's to call referencesLiteral: instead,
- "/ if there is any speed problem there. Not here.
- "/ ^ true.
-
- msgs := self messagesSent.
- ^ aCollectionOfSelectorSymbols contains:[:sym | msgs includesIdentical:sym]
+ "/ cg: was temporarily disabled to speed up some searches.
+ "/ I think, we have to change the caller's to call referencesLiteral: instead,
+ "/ if there is any speed problem there. Not here.
+ "/ ^ true.
+
+ msgs := self messagesSent.
+ ^ aCollectionOfSelectorSymbols contains:[:sym | msgs includesIdentical:sym]
].
^ false
@@ -3463,16 +3467,16 @@
nonMetaClass := myClass theNonMetaclass.
(package ~= nonMetaClass package
- and:[ package ~= PackageId noProjectID
- and:[ (myProjectDefinition := nonMetaClass projectDefinitionClass) notNil ]])
- ifTrue:[
- originalMethod := myProjectDefinition savedOverwrittenMethodForClass:myClass selector:self selector.
-
- "/ mhm - what if it does no make a difference?
- "/ (originalMethod notNil and:[originalMethod source = self source]) ifTrue:[
- "/ "/ self halt. ^ nil
- "/ ].
- ^ originalMethod
+ and:[ package ~= PackageId noProjectID
+ and:[ (myProjectDefinition := nonMetaClass projectDefinitionClass) notNil ]])
+ ifTrue:[
+ originalMethod := myProjectDefinition savedOverwrittenMethodForClass:myClass selector:self selector.
+
+ "/ mhm - what if it does no make a difference?
+ "/ (originalMethod notNil and:[originalMethod source = self source]) ifTrue:[
+ "/ "/ self halt. ^ nil
+ "/ ].
+ ^ originalMethod
].
^ nil
@@ -3525,41 +3529,41 @@
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:
- To avoid an expensive search, the once valid containing class is kept and remembered
- in the mclass slot. However, if a method gets recompiled or wrapped, the mclass field is
- no longer valid and who on the old method returns nil (because the method is actually no longer
- contained in that class). However, to allow easier unwrapping (and gathering of the corresponding
- wrapper), the mclass field is never nilled. I.e. it still refers to the original class.
- Therefore, a validation of the mclass slot is done here."
+ To avoid an expensive search, the once valid containing class is kept and remembered
+ in the mclass slot. However, if a method gets recompiled or wrapped, the mclass field is
+ no longer valid and who on the old method returns nil (because the method is actually no longer
+ contained in that class). However, to allow easier unwrapping (and gathering of the corresponding
+ wrapper), the mclass field is never nilled. I.e. it still refers to the original class.
+ Therefore, a validation of the mclass slot is done here."
|cls sel fn clsName checkBlock|
mclass notNil ifTrue:[
- "/ check if this (cached) info is still valid...
- sel := mclass selectorAtMethod:self.
- sel notNil ifTrue:[
- ^ MethodWhoInfo class:mclass selector:sel
- ].
- ^ nil.
+ "/ check if this (cached) info is still valid...
+ sel := mclass selectorAtMethod:self.
+ sel notNil ifTrue:[
+ ^ MethodWhoInfo class:mclass selector:sel
+ ].
+ ^ nil.
].
- checkBlock :=
- [:cls |
- |sel|
-
- sel := cls selectorAtMethod:self.
- sel notNil ifTrue:[
- LastWhoClass := cls theNonMetaclass name.
- mclass := cls.
- ^ MethodWhoInfo class:cls selector:sel
- ].
- ].
+ checkBlock :=
+ [:cls |
+ |sel|
+
+ sel := cls selectorAtMethod:self.
+ sel notNil ifTrue:[
+ LastWhoClass := cls theNonMetaclass name.
+ mclass := cls.
+ ^ MethodWhoInfo class:cls selector:sel
+ ].
+ ].
"
first, look in the class we found something the last time
@@ -3568,11 +3572,11 @@
being garbage collected)
"
LastWhoClass notNil ifTrue:[
- cls := Smalltalk at:LastWhoClass ifAbsent:nil.
- cls notNil ifTrue:[
- checkBlock value:cls theNonMetaclass.
- checkBlock value:cls theMetaclass.
- ]
+ cls := Smalltalk at:LastWhoClass ifAbsent:nil.
+ cls notNil ifTrue:[
+ checkBlock value:cls theNonMetaclass.
+ checkBlock value:cls theMetaclass.
+ ]
].
"
@@ -3580,15 +3584,15 @@
extract the className from it and try that class first.
"
(fn := self sourceFilename) notNil ifTrue:[
- clsName := fn asFilename nameWithoutSuffix.
- clsName := clsName asSymbolIfInterned.
- clsName notNil ifTrue:[
- cls := Smalltalk at:clsName ifAbsent:nil.
- cls notNil ifTrue:[
- checkBlock value:cls theNonMetaclass.
- checkBlock value:cls theMetaclass.
- ]
- ].
+ clsName := fn asFilename nameWithoutSuffix.
+ clsName := clsName asSymbolIfInterned.
+ clsName notNil ifTrue:[
+ cls := Smalltalk at:clsName ifAbsent:nil.
+ cls notNil ifTrue:[
+ checkBlock value:cls theNonMetaclass.
+ checkBlock value:cls theMetaclass.
+ ]
+ ].
].
"
@@ -3596,8 +3600,8 @@
since probability is high, that the receiver is found in there ...
"
Smalltalk allClassesDo:[:cls |
- checkBlock value:cls theNonMetaclass.
- checkBlock value:cls theMetaclass.
+ checkBlock value:cls theNonMetaclass.
+ checkBlock value:cls theMetaclass.
].
LastWhoClass := nil.
@@ -3627,11 +3631,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.
@@ -3650,9 +3654,9 @@
That's the WrapperMethod which contains myself."
WrappedMethod notNil ifTrue:[
- WrappedMethod allInstancesDo:[:m |
- m originalMethod == self ifTrue:[^ m].
- ].
+ WrappedMethod allInstancesDo:[:m |
+ m originalMethod == self ifTrue:[^ m].
+ ].
].
^ nil
@@ -3760,17 +3764,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.
@@ -3779,10 +3783,10 @@
classes.
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- Method
+ Method
"
! !
@@ -3831,10 +3835,10 @@
"simulate the old behavior (when Method>>who returned an array)"
index == 1 ifTrue:[
- ^ myClass
+ ^ myClass
].
index == 2 ifTrue:[
- ^ mySelector
+ ^ mySelector
].
"/ sigh - full compatibility ?
@@ -3931,11 +3935,11 @@
!Method class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.465 2015-06-08 15:50:12 stefan Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.465 2015-06-08 15:50:12 stefan Exp $'
+ ^ '$Header$'
!
version_SVN
--- a/Object.st Thu Jul 23 12:40:48 2015 +0200
+++ b/Object.st Thu Jul 23 13:10:17 2015 +0200
@@ -3453,7 +3453,7 @@
deps class == WeakArray ifTrue:[
dep := deps at:1.
dep ~~ anObject ifTrue:[
- (dep isNil or:[dep == 0]) ifTrue:[
+ (dep isNil or:[dep class == SmallInteger]) ifTrue:[
deps at:1 put:anObject
] ifFalse:[
self dependents:(WeakIdentitySet with:dep with:anObject)
@@ -3556,7 +3556,7 @@
deps := self dependents.
deps size ~~ 0 ifTrue:[
deps do:[:d |
- (d notNil and:[d ~~ 0]) ifTrue:[
+ (d notNil and:[d class ~~ SmallInteger]) ifTrue:[
aBlock value:d
]
]
@@ -3609,7 +3609,7 @@
((deps class == WeakArray) or:[deps class == Array]) ifTrue:[
((d := deps at:1) == anObject
or:[d isNil
- or:[d == 0]]) ifTrue:[
+ or:[d class == SmallInteger]]) ifTrue:[
self dependents:nil
]
] ifFalse:[
@@ -5266,6 +5266,7 @@
"/ ] do:[
"/ Processor activeProcess terminate.
"/ ].
+ MiniDebugger enter.
Processor activeProcess terminateNoSignal.
].
@@ -6560,7 +6561,7 @@
If the message expects an argument, pass arg."
aSelector argumentCount == 1 ifTrue:[
- ^ self perform:aSelector with:arg
+ ^ self perform:aSelector with:arg
].
^ self perform:aSelector
@@ -6585,10 +6586,10 @@
numArgs := aSelector argumentCount.
numArgs == 0 ifTrue:[
- ^ self perform:aSelector
+ ^ self perform:aSelector
].
numArgs == 1 ifTrue:[
- ^ self perform:aSelector with:optionalArg1
+ ^ self perform:aSelector with:optionalArg1
].
^ self perform:aSelector with:optionalArg1 with:optionalArg2.
@@ -6613,13 +6614,13 @@
numArgs := aSelector argumentCount.
numArgs == 0 ifTrue:[
- ^ self perform:aSelector
+ ^ self perform:aSelector
].
numArgs == 1 ifTrue:[
- ^ self perform:aSelector with:optionalArg1
+ ^ self perform:aSelector with:optionalArg1
].
numArgs == 2 ifTrue:[
- ^ self perform:aSelector with:optionalArg1 with:optionalArg2
+ ^ self perform:aSelector with:optionalArg1 with:optionalArg2
].
^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3.
@@ -6644,16 +6645,16 @@
numArgs := aSelector argumentCount.
numArgs == 0 ifTrue:[
- ^ self perform:aSelector
+ ^ self perform:aSelector
].
numArgs == 1 ifTrue:[
- ^ self perform:aSelector with:optionalArg1
+ ^ self perform:aSelector with:optionalArg1
].
numArgs == 2 ifTrue:[
- ^ self perform:aSelector with:optionalArg1 with:optionalArg2
+ ^ self perform:aSelector with:optionalArg1 with:optionalArg2
].
numArgs == 3 ifTrue:[
- ^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3
+ ^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3
].
^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3 with:optionalArg4.
@@ -9038,11 +9039,11 @@
"return the value of the first arg, if I am nil,
the result from evaluating the 2nd argument, if I am not nil.
Notice:
- This method is open coded (inlined) by the compiler(s)
- - redefining it may not work as expected."
+ This method is open coded (inlined) by the compiler(s)
+ - redefining it may not work as expected."
(notNilBlockOrValue isBlock and:[notNilBlockOrValue argumentCount == 1]) ifTrue:[
- ^ notNilBlockOrValue value:self.
+ ^ notNilBlockOrValue value:self.
].
^ notNilBlockOrValue value
!
@@ -9051,11 +9052,11 @@
"return myself if nil, or the result from evaluating the argument,
if I am not nil.
Notice:
- This method is open coded (inlined) by the compiler(s)
- - redefining it may not work as expected."
+ This method is open coded (inlined) by the compiler(s)
+ - redefining it may not work as expected."
(aBlockOrValue isBlock and:[aBlockOrValue argumentCount == 1]) ifTrue:[
- ^ aBlockOrValue value:self.
+ ^ aBlockOrValue value:self.
].
^ aBlockOrValue value
!
@@ -9064,11 +9065,11 @@
"return the value of the 2nd arg, if I am nil,
the result from evaluating the 1st argument, if I am not nil.
Notice:
- This method is open coded (inlined) by the compiler(s)
- - redefining it may not work as expected."
+ This method is open coded (inlined) by the compiler(s)
+ - redefining it may not work as expected."
(notNilBlockOrValue isBlock and:[notNilBlockOrValue argumentCount == 1]) ifTrue:[
- ^ notNilBlockOrValue value:self.
+ ^ notNilBlockOrValue value:self.
].
^ notNilBlockOrValue value
!
@@ -10295,11 +10296,11 @@
!Object class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.809 2015-06-05 16:11:10 stefan Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.809 2015-06-05 16:11:10 stefan Exp $'
+ ^ '$Header$'
!
version_SVN
--- a/ProcessorScheduler.st Thu Jul 23 12:40:48 2015 +0200
+++ b/ProcessorScheduler.st Thu Jul 23 13:10:17 2015 +0200
@@ -337,7 +337,7 @@
sz := KnownProcessIds size.
1 to:sz do:[:index |
"/ (KnownProcesses at:index) isNil ifTrue:[
- (KnownProcesses at:index) == 0 ifTrue:[
+ (KnownProcesses at:index) class == SmallInteger ifTrue:[
id := KnownProcessIds at:index.
id notNil ifTrue:[
'Processor [warning]: terminating thread ' errorPrint.
@@ -455,14 +455,14 @@
knownProcesses
"return a collection of all (living) processes in the system"
- ^ KnownProcesses select:[:p | p notNil and:[p ~~ 0]]
+ ^ KnownProcesses select:[:p | p notNil and:[p class ~~ SmallInteger]]
!
knownProcessesDo:aBlock
"evaluate aBlock for each (living) processes in the system"
KnownProcesses do:[:p |
- (p notNil and:[p ~~ 0]) ifTrue:[aBlock value:p]
+ (p notNil and:[p class ~~ SmallInteger]) ifTrue:[aBlock value:p]
]
"Created: / 26-10-2012 / 13:02:33 / cg"
@@ -1008,7 +1008,7 @@
"
processesToRestart := OrderedCollection new.
KnownProcesses do:[:p |
- (p notNil and:[p ~~ 0]) ifTrue:[
+ (p notNil and:[p class ~~ SmallInteger]) ifTrue:[
"how, exactly should this be done ?"
p isRestartable == true ifTrue:[
@@ -3564,11 +3564,11 @@
!ProcessorScheduler class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.303 2015-04-27 17:04:46 cg Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.303 2015-04-27 17:04:46 cg Exp $'
+ ^ '$Header$'
! !
--- a/Registry.st Thu Jul 23 12:40:48 2015 +0200
+++ b/Registry.st Thu Jul 23 13:10:17 2015 +0200
@@ -36,15 +36,15 @@
documentation
"
- Registries provide an easy interface to using WeakArrays.
+ Registries provide an easy interface to using WeakArrays.
A class, which wants to be informed of instance-death, can put a created object
- into a registry. The registry will create an executor, which is a (shallow-)copy
- of the object, and watch out for death of the original object. When it dies,
+ into a registry. The registry will create an executor, which is a (shallow-)copy
+ of the object, and watch out for death of the original object. When it dies,
the executor will be sent a #finalize message.
The trick with the shallow copy is especially nice, you can think of it as
being the original object which died.
- All objects, which keep external resources (such as fileDescriptors, fonts,
+ All objects, which keep external resources (such as fileDescriptors, fonts,
colormap-entries etc.) should be registered, so that the underlying resource
can be freed when the object goes away.
@@ -52,8 +52,8 @@
death of an object.
Registries use #executor to aquire the copy of the original,
- this can be redefined in individual classes for faster copying
- (typically, not all internal state, but only some device handles are needed for
+ this can be redefined in individual classes for faster copying
+ (typically, not all internal state, but only some device handles are needed for
finalization). If the to-be-registered object is large, this method may also
return a stub (placeHolder) object. (i.e. there is no need for the copy to be
of the same class as the original, as long as it implements #finalize and frees
@@ -62,12 +62,12 @@
Example uses are found in Form, Color, ExternalStream and Font
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- WeakArray WeakIdentityDictionary WeakIdentitySet
- Font Form Color Cursor ExternalStream
-
+ WeakArray WeakIdentityDictionary WeakIdentitySet
+ Font Form Color Cursor ExternalStream
+
"
! !
@@ -102,60 +102,60 @@
o myHandleArray wasBlocked|
something == #ElementExpired ifTrue:[
- wasBlocked := OperatingSystem blockInterrupts.
- [
- myHandleArray := handleArray.
- sz := myHandleArray size.
+ wasBlocked := OperatingSystem blockInterrupts.
+ [
+ myHandleArray := handleArray.
+ sz := myHandleArray size.
- index := 1.
- [index <= sz] whileTrue:[
- o := registeredObjects at:index.
- o == 0 ifTrue:[
- executor := myHandleArray at:index.
- "remove the executor from the handle array before informing the executor.
- This is critical in case of errors while executing the executor.
- See ObjectMemory>>finalize"
- registeredObjects at:index put:nil.
- tally := tally - 1.
- executor notNil ifTrue:[
- myHandleArray at:index put:nil.
+ index := 1.
+ [index <= sz] whileTrue:[
+ o := registeredObjects at:index.
+ o class == SmallInteger ifTrue:[
+ executor := myHandleArray at:index.
+ "remove the executor from the handle array before informing the executor.
+ This is critical in case of errors while executing the executor.
+ See ObjectMemory>>finalize"
+ registeredObjects at:index put:nil.
+ tally := tally - 1.
+ executor notNil ifTrue:[
+ myHandleArray at:index put:nil.
- "/
- "/ allow interrupts for a while ...
- "/
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- self informDispose:executor.
- OperatingSystem blockInterrupts.
+ "/
+ "/ allow interrupts for a while ...
+ "/
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ self informDispose:executor.
+ OperatingSystem blockInterrupts.
- "/
- "/ any change in an interrupt or dispose handling ?
- "/
- handleArray ~~ myHandleArray ifTrue:[
- myHandleArray := handleArray.
- sz := myHandleArray size.
- "/ start again
- index := 0.
- ]
- ]
- ].
- index := index + 1.
- ]
- ] ensure:[
- wasBlocked ifFalse:[
- OperatingSystem unblockInterrupts
- ]
- ].
+ "/
+ "/ any change in an interrupt or dispose handling ?
+ "/
+ handleArray ~~ myHandleArray ifTrue:[
+ myHandleArray := handleArray.
+ sz := myHandleArray size.
+ "/ start again
+ index := 0.
+ ]
+ ]
+ ].
+ index := index + 1.
+ ]
+ ] ensure:[
+ wasBlocked ifFalse:[
+ OperatingSystem unblockInterrupts
+ ]
+ ].
- (sz > 50 and:[tally < (sz // 2)]) ifTrue:[
- "/ shrink
- self resize
- ]
+ (sz > 50 and:[tally < (sz // 2)]) ifTrue:[
+ "/ shrink
+ self resize
+ ]
] ifFalse:[
- something == #earlyRestart ifTrue:[
- handleArray notNil ifTrue:[
- handleArray atAllPut:nil.
- ]
- ]
+ something == #earlyRestart ifTrue:[
+ handleArray notNil ifTrue:[
+ handleArray atAllPut:nil.
+ ]
+ ]
].
"Created: 15.6.1996 / 15:24:41 / cg"
@@ -167,9 +167,9 @@
detect:aBlock ifNone:exceptionValue
registeredObjects notNil ifTrue:[
- registeredObjects validElementsDo:[:obj |
- (aBlock value:obj) ifTrue:[^ obj].
- ].
+ registeredObjects validElementsDo:[:obj |
+ (aBlock value:obj) ifTrue:[^ obj].
+ ].
].
^ exceptionValue value
!
@@ -197,14 +197,14 @@
cnt := 0.
1 to:sz do:[:index |
- ((executor := registeredObjects at:index) notNil
- and:[executor ~~ 0]) ifTrue:[
- indexTable at:executor put:index.
- cnt := cnt + 1.
- ] ifFalse:[
- handleArray at:index put:nil.
- registeredObjects at:index put:nil.
- ]
+ ((executor := registeredObjects at:index) notNil
+ and:[executor class ~~ SmallInteger]) ifTrue:[
+ indexTable at:executor put:index.
+ cnt := cnt + 1.
+ ] ifFalse:[
+ handleArray at:index put:nil.
+ registeredObjects at:index put:nil.
+ ]
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -216,45 +216,45 @@
|sz "{ Class: SmallInteger }"
dstIndex "{ Class: SmallInteger }"
realNewSize "{ Class: SmallInteger }"
- newObjects newHandles wasBlocked
+ newObjects newHandles wasBlocked
executor|
sz := registeredObjects size.
(sz > 50 and:[tally < (sz // 2)]) ifTrue:[
- "/ shrink
+ "/ shrink
- wasBlocked := OperatingSystem blockInterrupts.
+ wasBlocked := OperatingSystem blockInterrupts.
- sz := registeredObjects size.
- realNewSize := tally * 3 // 2.
- newObjects := WeakArray new:realNewSize.
- newHandles := Array new:realNewSize.
- indexTable := WeakIdentityDictionary new.
+ sz := registeredObjects size.
+ realNewSize := tally * 3 // 2.
+ newObjects := WeakArray new:realNewSize.
+ newHandles := Array new:realNewSize.
+ indexTable := WeakIdentityDictionary new.
- dstIndex := 1.
- 1 to:sz do:[:index |
- (executor := registeredObjects at:index) notNil ifTrue:[
- dstIndex > realNewSize ifTrue:[
- 'Registry [error]: size given is too small in resize' errorPrintCR.
- self repairTally.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
- ].
- newObjects at:dstIndex put:executor.
- newHandles at:dstIndex put:(handleArray at:index).
- indexTable at:executor put:dstIndex.
+ dstIndex := 1.
+ 1 to:sz do:[:index |
+ (executor := registeredObjects at:index) notNil ifTrue:[
+ dstIndex > realNewSize ifTrue:[
+ 'Registry [error]: size given is too small in resize' errorPrintCR.
+ self repairTally.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
+ ].
+ newObjects at:dstIndex put:executor.
+ newHandles at:dstIndex put:(handleArray at:index).
+ indexTable at:executor put:dstIndex.
- dstIndex := dstIndex + 1
- ]
- ].
+ dstIndex := dstIndex + 1
+ ]
+ ].
- registeredObjects removeDependent:self.
- newObjects addDependent:self.
- registeredObjects := newObjects.
- handleArray := newHandles.
+ registeredObjects removeDependent:self.
+ newObjects addDependent:self.
+ registeredObjects := newObjects.
+ handleArray := newHandles.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
]
"Created: 16.1.1997 / 18:08:00 / cg"
@@ -266,8 +266,8 @@
handleArray at:index put:nil.
registeredObjects at:index put:nil.
- (anObject notNil and:[anObject ~~ 0]) ifTrue:[
- indexTable removeKey:anObject ifAbsent:[]
+ (anObject notNil and:[anObject ~~ 0]) ifTrue:[
+ indexTable removeKey:anObject ifAbsent:[]
].
tally := tally - 1.
! !
@@ -288,7 +288,7 @@
executor := anObject executor.
executor notNil ifTrue:[
- self register:anObject as:executor.
+ self register:anObject as:executor.
].
!
@@ -304,19 +304,19 @@
wasBlocked := OperatingSystem blockInterrupts.
registeredObjects size == 0 "isNil" ifTrue:[
- registeredObjects := WeakArray new:10.
- registeredObjects addDependent:self.
- handleArray := Array basicNew:10.
- indexTable := WeakIdentityDictionary new.
+ registeredObjects := WeakArray new:10.
+ registeredObjects addDependent:self.
+ handleArray := Array basicNew:10.
+ indexTable := WeakIdentityDictionary new.
- registeredObjects at:1 put:anObject.
- handleArray at:1 put:aHandle.
- indexTable at:anObject put:1.
+ registeredObjects at:1 put:anObject.
+ handleArray at:1 put:aHandle.
+ indexTable at:anObject put:1.
- tally := 1.
- ObjectMemory addDependent:self.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
+ tally := 1.
+ ObjectMemory addDependent:self.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
].
"/
@@ -324,24 +324,24 @@
"/ (but continue with interrupts disabled)
"/
wasBlocked ifFalse:[
- OperatingSystem unblockInterrupts.
- OperatingSystem blockInterrupts.
+ OperatingSystem unblockInterrupts.
+ OperatingSystem blockInterrupts.
].
"/ index := registeredObjects identityIndexOf:anObject ifAbsent:0.
index := indexTable at:anObject ifAbsent:0.
index ~~ 0 ifTrue:[
- "/ double check ...
- (registeredObjects at:index) ~~ anObject ifTrue:[
- ('Registry [warning]: index table clobbered') errorPrintCR.
- ].
+ "/ double check ...
+ (registeredObjects at:index) ~~ anObject ifTrue:[
+ ('Registry [warning]: index table clobbered') errorPrintCR.
+ ].
- "already registered"
-
- handleArray at:index put:aHandle.
+ "already registered"
+
+ handleArray at:index put:aHandle.
"/ ('Registry [info]: object (' , (registeredObjects at:index) printString , ') is already registered') infoPrintCR.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
].
"/
@@ -349,8 +349,8 @@
"/ (but continue with interrupts disabled)
"/
wasBlocked ifFalse:[
- OperatingSystem unblockInterrupts.
- OperatingSystem blockInterrupts.
+ OperatingSystem unblockInterrupts.
+ OperatingSystem blockInterrupts.
].
"/
@@ -360,26 +360,26 @@
idx0 := 1.
index := registeredObjects identityIndexOf:nil startingAt:idx0.
[index ~~ 0] whileTrue:[
- "is there a leftover ?"
- p := handleArray at:index.
- p isNil ifTrue:[
- registeredObjects at:index put:anObject.
- handleArray at:index put:aHandle.
- indexTable at:anObject put:index.
+ "is there a leftover ?"
+ p := handleArray at:index.
+ p isNil ifTrue:[
+ registeredObjects at:index put:anObject.
+ handleArray at:index put:aHandle.
+ indexTable at:anObject put:index.
- tally := tally + 1.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ self
- ].
+ tally := tally + 1.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^ self
+ ].
- "/ mhmh - a registeredObject vanished, but its
- "/ executor is still there ...
+ "/ mhmh - a registeredObject vanished, but its
+ "/ executor is still there ...
- "/
- "/ this may happen, if the registries dispose handling is
- "/ currently being executed by a lower priority process,
- "/ and the registeredObject has already been nilled,
- "/ but the executor is being notified (in the other process).
+ "/
+ "/ this may happen, if the registries dispose handling is
+ "/ currently being executed by a lower priority process,
+ "/ and the registeredObject has already been nilled,
+ "/ but the executor is being notified (in the other process).
"/ 'Registry [info]: leftOver executor: ' infoPrint. p infoPrintCR.
@@ -389,8 +389,8 @@
"/ self informDispose:p.
"/ p := nil.
- idx0 := index + 1.
- index := registeredObjects identityIndexOf:nil startingAt:idx0.
+ idx0 := index + 1.
+ index := registeredObjects identityIndexOf:nil startingAt:idx0.
].
"no free slot, add at the end"
@@ -425,21 +425,21 @@
executor := anObject executor.
executor isNil ifTrue:[
- self unregister:anObject.
- ^ self.
+ self unregister:anObject.
+ ^ self.
].
wasBlocked := OperatingSystem blockInterrupts.
registeredObjects isNil ifTrue:[
- index := 0
+ index := 0
] ifFalse:[
- "/ index := registeredObjects identityIndexOf:anObject ifAbsent:0.
- index := indexTable at:anObject ifAbsent:0.
+ "/ index := registeredObjects identityIndexOf:anObject ifAbsent:0.
+ index := indexTable at:anObject ifAbsent:0.
].
index ~~ 0 ifTrue:[
- handleArray at:index put:executor.
+ handleArray at:index put:executor.
] ifFalse:[
- self register:anObject as:executor
+ self register:anObject as:executor
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -454,15 +454,15 @@
|index wasBlocked|
registeredObjects notNil ifTrue:[
- wasBlocked := OperatingSystem blockInterrupts.
- "/ index := registeredObjects identityIndexOf:anObject ifAbsent:0.
- index := indexTable at:anObject ifAbsent:0.
- index ~~ 0 ifTrue:[
- self unregister:anObject atIndex:index.
- ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ wasBlocked := OperatingSystem blockInterrupts.
+ "/ index := registeredObjects identityIndexOf:anObject ifAbsent:0.
+ index := indexTable at:anObject ifAbsent:0.
+ index ~~ 0 ifTrue:[
+ self unregister:anObject atIndex:index.
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- self resize
+ self resize
]
"Modified: 16.1.1997 / 18:08:42 / cg"
@@ -484,7 +484,7 @@
1 to:n do:[:index |
obj := registeredObjects at:index.
- (obj notNil and:[obj ~~ 0]) ifTrue:[
+ (obj notNil and:[obj class ~~ SmallInteger]) ifTrue:[
(aBlock value:obj) ifTrue:[
self unregister:obj atIndex:index.
any := true.
@@ -526,10 +526,10 @@
!Registry class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.64 2013-06-03 18:02:40 cg Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.64 2013-06-03 18:02:40 cg Exp $'
+ ^ '$Header$'
! !
--- a/UnixOperatingSystem.st Thu Jul 23 12:40:48 2015 +0200
+++ b/UnixOperatingSystem.st Thu Jul 23 13:10:17 2015 +0200
@@ -4152,9 +4152,9 @@
# if defined(LINUX)
# if __GLIBC_PREREQ(2, 14)
if (__isSmallInteger(handle)) {
- if (syncfs(__intVal(handle)) == 0) {
- RETURN(self);
- }
+ if (syncfs(__intVal(handle)) == 0) {
+ RETURN(self);
+ }
}
# endif
# endif
@@ -11530,7 +11530,7 @@
aspect == #ElementExpired ifTrue:[
OpenFiles keysAndValuesDo:[:fd :handle |
- handle == 0 ifTrue:[
+ handle class == SmallInteger ifTrue:[
"Have to close the file descriptor"
OperatingSystem closeFd:fd.
@@ -11607,7 +11607,7 @@
oldHandle := OpenFiles at:aFileDescriptor ifAbsent: [nil].
"/ the 0 is possible, if an fd was open when saving a snapshot image,
"/ and we come up in the new image with no one referring to it.
- (oldHandle notNil and:[oldHandle ~~ 0 and:[ oldHandle ~~ self]]) ifTrue:[
+ (oldHandle notNil and:[oldHandle class ~~ SmallInteger and:[ oldHandle ~~ self]]) ifTrue:[
oldHandle invalidate.
].
self register.
--- a/WeakDependencyDictionary.st Thu Jul 23 12:40:48 2015 +0200
+++ b/WeakDependencyDictionary.st Thu Jul 23 13:10:17 2015 +0200
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1997 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -23,7 +23,7 @@
copyright
"
COPYRIGHT (c) 1997 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -42,10 +42,10 @@
dependency mechanism.
[author:]
- Claus Gittinger
+ Claus Gittinger
[See also:]
- WeakArray WeakIdentityDictionary WeakValueDictionary WeakIdentitySet
+ WeakArray WeakIdentityDictionary WeakValueDictionary WeakIdentitySet
"
! !
@@ -79,48 +79,48 @@
index := 1.
[index <= keyArray size] whileTrue:[
- "/ get the size again - it could have changed
+ "/ get the size again - it could have changed
- wasBlocked := OperatingSystem blockInterrupts.
+ wasBlocked := OperatingSystem blockInterrupts.
- keyArray ~~ originalKeyArray ifTrue:[
- index := 1. "/ start over
- "/ 'restart removeEmpty' infoPrintCR.
- originalKeyArray := keyArray.
- ].
+ keyArray ~~ originalKeyArray ifTrue:[
+ index := 1. "/ start over
+ "/ 'restart removeEmpty' infoPrintCR.
+ originalKeyArray := keyArray.
+ ].
- index <= keyArray size ifTrue:[
- key := keyArray basicAt:index.
- key == 0 ifTrue:[
- "/ that one is gone
- key := DeletedEntry.
- keyArray basicAt:index put:key.
- valueArray basicAt:index put:nil.
- tally := tally - 1.
- ].
+ index <= keyArray size ifTrue:[
+ key := keyArray basicAt:index.
+ key class == SmallInteger ifTrue:[
+ "/ that one is gone
+ key := DeletedEntry.
+ keyArray basicAt:index put:key.
+ valueArray basicAt:index put:nil.
+ tally := tally - 1.
+ ].
- (key notNil and:[key ~~ DeletedEntry]) ifTrue:[
- deps := valueArray basicAt:index.
- deps notNil ifTrue:[
- "/ is it an empty WeakArray ?
+ (key notNil and:[key ~~ DeletedEntry]) ifTrue:[
+ deps := valueArray basicAt:index.
+ deps notNil ifTrue:[
+ "/ is it an empty WeakArray ?
- (deps isMemberOf:WeakArray) ifTrue:[
- t := deps findFirst:[:el | el notNil and:[el ~~ 0]].
- t == 0 ifTrue:[
- "/ yes - nil it
- valueArray basicAt:index put:nil.
- keyArray basicAt:index put:DeletedEntry.
- tally := tally - 1.
- ]
- ] ifFalse:[
- "/ is it an empty WeakIdSet ?
+ (deps isMemberOf:WeakArray) ifTrue:[
+ t := deps findFirst:[:el | el notNil and:[el ~~ 0]].
+ t == 0 ifTrue:[
+ "/ yes - nil it
+ valueArray basicAt:index put:nil.
+ keyArray basicAt:index put:DeletedEntry.
+ tally := tally - 1.
+ ]
+ ] ifFalse:[
+ "/ is it an empty WeakIdSet ?
- (deps isMemberOf:WeakIdentitySet) ifTrue:[
- (t := deps size) == 0 ifTrue:[
- "/ yes - nil it
- valueArray basicAt:index put:nil.
- keyArray basicAt:index put:DeletedEntry.
- tally := tally - 1.
+ (deps isMemberOf:WeakIdentitySet) ifTrue:[
+ (t := deps size) == 0 ifTrue:[
+ "/ yes - nil it
+ valueArray basicAt:index put:nil.
+ keyArray basicAt:index put:DeletedEntry.
+ tally := tally - 1.
"/ ] ifFalse:[
"/ t == 1 ifTrue:[
"/ "/ careful - it could actually be empty
@@ -136,19 +136,19 @@
"/ ]
"/ ]
"/ ]
- ]
- ]
- ]
- ] ifFalse:[
- "/ 'oops: nil value for key' infoPrint. key infoPrintCR.
- keyArray basicAt:index put:DeletedEntry.
- tally := tally - 1.
- ]
- ]
- ].
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ "/ 'oops: nil value for key' infoPrint. key infoPrintCR.
+ keyArray basicAt:index put:DeletedEntry.
+ tally := tally - 1.
+ ]
+ ]
+ ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- index := index + 1.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ index := index + 1.
].
"/ 'done' printCR.
@@ -163,5 +163,5 @@
!WeakDependencyDictionary class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/WeakDependencyDictionary.st,v 1.14 2012-08-06 12:38:10 cg Exp $'
+ ^ '$Header$'
! !
--- a/WeakIdentityDictionary.st Thu Jul 23 12:40:48 2015 +0200
+++ b/WeakIdentityDictionary.st Thu Jul 23 13:10:17 2015 +0200
@@ -40,8 +40,8 @@
documentation
"
- WeakIdentityDictionaries behave like IdentityDictionaries,
- as long as the keys are still referenced by some
+ WeakIdentityDictionaries behave like IdentityDictionaries,
+ as long as the keys are still referenced by some
other (non-weak) object.
However, once the last non-weak reference ceases to exist,
the object will be automatically removed from the Weakcollection
@@ -72,20 +72,20 @@
!WeakIdentityDictionary methodsFor:'adding & removing'!
at:key ifAbsent:exceptionBlock
- "redefined to block interrupts
+ "redefined to block interrupts
(avoid change of the dictionary while accessing)"
|val|
(OperatingSystem blockInterrupts) ifTrue:[
- "/ already blocked
- ^ super at:key ifAbsent:exceptionBlock.
+ "/ already blocked
+ ^ super at:key ifAbsent:exceptionBlock.
].
[
- val := super at:key ifAbsent:exceptionBlock.
+ val := super at:key ifAbsent:exceptionBlock.
] ensure:[
- OperatingSystem unblockInterrupts.
+ OperatingSystem unblockInterrupts.
].
^ val
@@ -102,14 +102,14 @@
|val|
(OperatingSystem blockInterrupts) ifTrue:[
- "/ already blocked
- ^ super at:key put:anObject.
+ "/ already blocked
+ ^ super at:key put:anObject.
].
[
- val := super at:key put:anObject.
+ val := super at:key put:anObject.
] ensure:[
- OperatingSystem unblockInterrupts.
+ OperatingSystem unblockInterrupts.
].
^ val
@@ -120,24 +120,24 @@
removeKey:aKey ifAbsent:aBlock
"remove the association under aKey from the collection,
return the value previously stored there.
- If it was not in the collection return the result
+ If it was not in the collection return the result
from evaluating aBlock.
Redefined to avoid synchronization problems, in case
- of interrupts (otherwise, there could be some other operation
+ of interrupts (otherwise, there could be some other operation
on the receiver done by another process, which garbles my contents)."
|ret|
(OperatingSystem blockInterrupts) ifTrue:[
- "/ already blocked
- ^ super removeKey:aKey ifAbsent:aBlock.
+ "/ already blocked
+ ^ super removeKey:aKey ifAbsent:aBlock.
].
[
- ret := super removeKey:aKey ifAbsent:aBlock
+ ret := super removeKey:aKey ifAbsent:aBlock
] ensure:[
- OperatingSystem unblockInterrupts
+ OperatingSystem unblockInterrupts
].
^ ret
@@ -146,20 +146,20 @@
!
safeRemoveKey:key
- "redefined to block interrupts
+ "redefined to block interrupts
(avoid change of the dictionary while accessing)"
|val|
(OperatingSystem blockInterrupts) ifTrue:[
- "/ already blocked
- ^ super safeRemoveKey:key.
+ "/ already blocked
+ ^ super safeRemoveKey:key.
].
[
- val := super safeRemoveKey:key.
+ val := super safeRemoveKey:key.
] ensure:[
- OperatingSystem unblockInterrupts.
+ OperatingSystem unblockInterrupts.
].
^ val
@@ -175,19 +175,19 @@
"
have to block here - dispose may be done at a low priority
- from the background finalizer. If new items are added by a
+ from the background finalizer. If new items are added by a
higher prio process, the dictionary might get corrupted otherwise
"
wasBlocked := OperatingSystem blockInterrupts.
[
- keyArray
- forAllDeadIndicesDo:[:idx |
- valueArray basicAt:idx put:nil.
- tally := tally - 1.
- ]
- replacingCorpsesWith:DeletedEntry.
+ keyArray
+ forAllDeadIndicesDo:[:idx |
+ valueArray basicAt:idx put:nil.
+ tally := tally - 1.
+ ]
+ replacingCorpsesWith:DeletedEntry.
] ensure:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
].
"Modified: / 13.12.2001 / 14:18:17 / martin"
@@ -198,7 +198,7 @@
disposed keys."
something == #ElementExpired ifTrue:[
- self clearDeadSlots.
+ self clearDeadSlots.
]
"Created: / 7.1.1997 / 16:59:30 / stefan"
@@ -208,25 +208,25 @@
!WeakIdentityDictionary methodsFor:'private'!
findKeyOrNil:key
- "Look for the key in the receiver.
+ "Look for the key in the receiver.
If it is found, return the index,
- otherwise the index of the first unused slot.
+ otherwise the index of the first unused slot.
Grow the receiver, if key was not found, and no unused slots were present.
Warning: an empty slot MUST be filled by the sender - it is only to be sent
- by at:put: / add: - like methods."
+ by at:put: / add: - like methods."
|index "{ Class:SmallInteger }"
length "{ Class:SmallInteger }"
- startIndex probe
+ startIndex probe
delIndex "{ Class:SmallInteger }"|
(OperatingSystem blockInterrupts) ifFalse:[
- "/
- "/ may never be entered with interrupts enabled
- "/
- OperatingSystem unblockInterrupts.
- self error:'unblocked call of findKeyOrNil'.
+ "/
+ "/ may never be entered with interrupts enabled
+ "/
+ OperatingSystem unblockInterrupts.
+ self error:'unblocked call of findKeyOrNil'.
].
delIndex := 0.
@@ -235,39 +235,39 @@
startIndex := index := self initialIndexForKey:key.
[
- probe := keyArray basicAt:index.
- key == probe ifTrue:[^ index].
- probe isNil ifTrue:[
- delIndex == 0 ifTrue:[^ index].
- keyArray basicAt:delIndex put:nil.
- ^ delIndex
- ].
+ probe := keyArray basicAt:index.
+ key == probe ifTrue:[^ index].
+ probe isNil ifTrue:[
+ delIndex == 0 ifTrue:[^ index].
+ keyArray basicAt:delIndex put:nil.
+ ^ delIndex
+ ].
- probe == 0 ifTrue:[
- probe := DeletedEntry.
- keyArray basicAt:index put:probe.
- valueArray basicAt:index put:nil.
- tally := tally - 1.
- ].
+ probe class == SmallInteger ifTrue:[
+ probe := DeletedEntry.
+ keyArray basicAt:index put:probe.
+ valueArray basicAt:index put:nil.
+ tally := tally - 1.
+ ].
- delIndex == 0 ifTrue:[
- probe == DeletedEntry ifTrue:[
- delIndex := index
- ]
- ].
+ delIndex == 0 ifTrue:[
+ probe == DeletedEntry ifTrue:[
+ delIndex := index
+ ]
+ ].
- index == length ifTrue:[
- index := 1
- ] ifFalse:[
- index := index + 1
- ].
- index == startIndex ifTrue:[
- delIndex ~~ 0 ifTrue:[
- keyArray basicAt:delIndex put:nil.
- ^ delIndex
- ].
- ^ self grow findKeyOrNil:key
- ].
+ index == length ifTrue:[
+ index := 1
+ ] ifFalse:[
+ index := index + 1
+ ].
+ index == startIndex ifTrue:[
+ delIndex ~~ 0 ifTrue:[
+ keyArray basicAt:delIndex put:nil.
+ ^ delIndex
+ ].
+ ^ self grow findKeyOrNil:key
+ ].
] loop.
"Modified: 30.1.1997 / 15:04:34 / cg"
@@ -282,14 +282,14 @@
"/ 'grow:' printCR.
(OperatingSystem blockInterrupts) ifTrue:[
- "/ already blocked
- ^ super grow:newSize.
+ "/ already blocked
+ ^ super grow:newSize.
].
[
- super grow:newSize
+ super grow:newSize
] ensure:[
- OperatingSystem unblockInterrupts
+ OperatingSystem unblockInterrupts
].
"Created: 28.1.1997 / 23:41:39 / cg"
@@ -304,15 +304,15 @@
"/ 'setTally:' printCR.
(OperatingSystem blockInterrupts) ifTrue:[
- "/ already blocked
- super initializeForCapacity:minSize.
- ^ self.
+ "/ already blocked
+ super initializeForCapacity:minSize.
+ ^ self.
].
[
- super initializeForCapacity:minSize
+ super initializeForCapacity:minSize
] ensure:[
- OperatingSystem unblockInterrupts
+ OperatingSystem unblockInterrupts
].
"Created: 29.1.1997 / 11:40:12 / cg"
@@ -341,15 +341,15 @@
"/ 'rehash' printCR.
(OperatingSystem blockInterrupts) ifTrue:[
- "/ already blocked
- super rehash.
- ^ self.
+ "/ already blocked
+ super rehash.
+ ^ self.
].
[
- super rehash
+ super rehash
] ensure:[
- OperatingSystem unblockInterrupts
+ OperatingSystem unblockInterrupts
].
"Created: 29.1.1997 / 11:39:42 / cg"
@@ -359,20 +359,20 @@
!WeakIdentityDictionary methodsFor:'testing'!
includes:anObject
- "redefined to block interrupts
+ "redefined to block interrupts
(avoid change of the dictionary while accessing)"
|val|
(OperatingSystem blockInterrupts) ifTrue:[
- "/ already blocked
- ^ super includes:anObject.
+ "/ already blocked
+ ^ super includes:anObject.
].
[
- val := super includes:anObject.
+ val := super includes:anObject.
] ensure:[
- OperatingSystem unblockInterrupts.
+ OperatingSystem unblockInterrupts.
].
^ val
@@ -382,20 +382,20 @@
!
includesKey:key
- "redefined to block interrupts
+ "redefined to block interrupts
(avoid change of the dictionary while accessing)"
|val|
(OperatingSystem blockInterrupts) ifTrue:[
- "/ already blocked
- ^ super includesKey:key.
+ "/ already blocked
+ ^ super includesKey:key.
].
[
- val := super includesKey:key.
+ val := super includesKey:key.
] ensure:[
- OperatingSystem unblockInterrupts.
+ OperatingSystem unblockInterrupts.
].
^ val
@@ -413,6 +413,6 @@
!WeakIdentityDictionary class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/WeakIdentityDictionary.st,v 1.46 2015-05-09 11:58:44 cg Exp $'
+ ^ '$Header$'
! !
--- a/WeakIdentitySet.st Thu Jul 23 12:40:48 2015 +0200
+++ b/WeakIdentitySet.st Thu Jul 23 13:10:17 2015 +0200
@@ -47,17 +47,17 @@
if you forget to #release it).
[Warning:]
- If you use this, be very careful since the collections size changes
- 'magically' - for example, testing for being nonEmpty and then
- removing the first element may fail, since the element may vanish inbetween.
- In general, never trust the value as returned by the size/isEmpty messages.
- WeakIdentitySet is not meant as a 'public' class.
+ If you use this, be very careful since the collections size changes
+ 'magically' - for example, testing for being nonEmpty and then
+ removing the first element may fail, since the element may vanish inbetween.
+ In general, never trust the value as returned by the size/isEmpty messages.
+ WeakIdentitySet is not meant as a 'public' class.
[author:]
- Claus Gittinger
+ Claus Gittinger
[See also:]
- WeakArray WeakIdentityDictionary
+ WeakArray WeakIdentityDictionary
"
! !
@@ -76,13 +76,13 @@
goodSizeFrom:arg
"return a good array size for the given argument.
Since WeakIdentitySets are mostly used for dependency management, we typically
- have only a small number of elements in the set.
+ have only a small number of elements in the set.
Therefore use exact size for small sets
(instead of rounding up to the next prime 11)."
arg <= 10 ifTrue:[
- arg < 1 ifTrue:[^ 1].
- ^ arg.
+ arg < 1 ifTrue:[^ 1].
+ ^ arg.
].
^ super goodSizeFrom:arg
! !
@@ -99,20 +99,20 @@
element|
index := 1.
- "/ allow for the size to change during enumeration
+ "/ allow for the size to change during enumeration
[index <= keyArray size] whileTrue:[
- element := keyArray basicAt:index.
- element notNil ifTrue:[
- element ~~ 0 ifTrue:[
- element ~~ DeletedEntry ifTrue:[
- element == NilEntry ifTrue:[
- element := nil.
- ].
- ^ element
- ]
- ]
- ].
- index := index + 1
+ element := keyArray basicAt:index.
+ element notNil ifTrue:[
+ element class ~~ SmallInteger ifTrue:[
+ element ~~ DeletedEntry ifTrue:[
+ element == NilEntry ifTrue:[
+ element := nil.
+ ].
+ ^ element
+ ]
+ ]
+ ].
+ index := index + 1
].
^ exceptionValue value.
@@ -120,25 +120,25 @@
!WeakIdentitySet methodsFor:'adding & removing'!
-add:newElement
- "add the argument, newElement to the receiver.
+add:newElement
+ "add the argument, newElement to the receiver.
Returns the argument, newElement (sigh).
- Redefined to avoid synchronization problems, in case of interrupts
+ Redefined to avoid synchronization problems, in case of interrupts
(otherwise, there could be some other operation on the receiver
done by another process, which garbles my contents)"
|ret|
(OperatingSystem blockInterrupts) ifTrue:[
- "/ already blocked
- ^ super add:newElement.
+ "/ already blocked
+ ^ super add:newElement.
].
[
- ret := super add:newElement.
+ ret := super add:newElement.
] ensure:[
- OperatingSystem unblockInterrupts
+ OperatingSystem unblockInterrupts
].
^ ret
@@ -146,21 +146,21 @@
!
remove:anObject ifAbsent:exceptionBlock
- "redefined to avoid synchronization problems, in case of interrupts
+ "redefined to avoid synchronization problems, in case of interrupts
(otherwise, there could be some other operation on the receiver
done by another process, which garbles my contents)"
|ret|
(OperatingSystem blockInterrupts) ifTrue:[
- "/ already blocked
- ^ super remove:anObject ifAbsent:exceptionBlock.
+ "/ already blocked
+ ^ super remove:anObject ifAbsent:exceptionBlock.
].
[
- ret := super remove:anObject ifAbsent:exceptionBlock
+ ret := super remove:anObject ifAbsent:exceptionBlock
] ensure:[
- OperatingSystem unblockInterrupts
+ OperatingSystem unblockInterrupts
].
^ ret
@@ -175,15 +175,15 @@
|wasBlocked|
something == #ElementExpired ifTrue:[
- "
- must block interrupts here - finalization
- may be done at low prio in the background
- finalizer, we do not want to be interrupted
- while rehashing
- "
- wasBlocked := OperatingSystem blockInterrupts.
- keyArray forAllDeadIndicesDo:[:idx | tally := tally - 1] replacingCorpsesWith:DeletedEntry.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ "
+ must block interrupts here - finalization
+ may be done at low prio in the background
+ finalizer, we do not want to be interrupted
+ while rehashing
+ "
+ wasBlocked := OperatingSystem blockInterrupts.
+ keyArray forAllDeadIndicesDo:[:idx | tally := tally - 1] replacingCorpsesWith:DeletedEntry.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
].
"Created: 7.1.1997 / 17:00:33 / stefan"
@@ -202,42 +202,42 @@
element|
index := 1.
- "/ allow for the size to change during enumeration
+ "/ allow for the size to change during enumeration
[index <= keyArray size] whileTrue:[
- element := keyArray basicAt:index.
- element notNil ifTrue:[
- element ~~ 0 ifTrue:[
- element ~~ DeletedEntry ifTrue:[
- aBlock value:element
- ]
- ]
- ].
- index := index + 1
+ element := keyArray basicAt:index.
+ element notNil ifTrue:[
+ element class ~~ SmallInteger ifTrue:[
+ element ~~ DeletedEntry ifTrue:[
+ aBlock value:element
+ ]
+ ]
+ ].
+ index := index + 1
]
! !
!WeakIdentitySet methodsFor:'private'!
findKeyOrNil:key
- "Look for the key in the receiver.
+ "Look for the key in the receiver.
If it is found, return return the index, otherwise
- the index of the first unused slot.
+ the index of the first unused slot.
Grow the receiver, if key was not found, and no unused slots were present.
Warning: an empty slot MUST be filled by the sender - it is only to be sent
- by at:put: / add: - like methods."
+ by at:put: / add: - like methods."
|index "{ Class:SmallInteger }"
length "{ Class:SmallInteger }"
- startIndex probe
+ startIndex probe
delIndex "{ Class:SmallInteger }"|
(OperatingSystem blockInterrupts) ifFalse:[
- "/
- "/ may never be entered with interrupts enabled
- "/
- OperatingSystem unblockInterrupts.
- self error:'unblocked call of findKeyOrNil'.
+ "/
+ "/ may never be entered with interrupts enabled
+ "/
+ OperatingSystem unblockInterrupts.
+ self error:'unblocked call of findKeyOrNil'.
].
delIndex := 0.
@@ -246,37 +246,37 @@
startIndex := index := self initialIndexForKey:key.
[
- probe := keyArray basicAt:index.
- key == probe ifTrue:[^ index].
- probe isNil ifTrue:[
- delIndex == 0 ifTrue:[^ index].
- keyArray basicAt:delIndex put:nil.
- ^ delIndex
- ].
+ probe := keyArray basicAt:index.
+ key == probe ifTrue:[^ index].
+ probe isNil ifTrue:[
+ delIndex == 0 ifTrue:[^ index].
+ keyArray basicAt:delIndex put:nil.
+ ^ delIndex
+ ].
- probe == 0 ifTrue:[
- probe := DeletedEntry.
- keyArray basicAt:index put:probe.
- tally := tally - 1.
- ].
- delIndex == 0 ifTrue:[
- probe == DeletedEntry ifTrue:[
- delIndex := index
- ]
- ].
+ probe class == SmallInteger ifTrue:[
+ probe := DeletedEntry.
+ keyArray basicAt:index put:probe.
+ tally := tally - 1.
+ ].
+ delIndex == 0 ifTrue:[
+ probe == DeletedEntry ifTrue:[
+ delIndex := index
+ ]
+ ].
- index == length ifTrue:[
- index := 1
- ] ifFalse:[
- index := index + 1
- ].
- index == startIndex ifTrue:[
- delIndex ~~ 0 ifTrue:[
- keyArray basicAt:delIndex put:nil.
- ^ delIndex
- ].
- ^ self grow findKeyOrNil:key
- ].
+ index == length ifTrue:[
+ index := 1
+ ] ifFalse:[
+ index := index + 1
+ ].
+ index == startIndex ifTrue:[
+ delIndex ~~ 0 ifTrue:[
+ keyArray basicAt:delIndex put:nil.
+ ^ delIndex
+ ].
+ ^ self grow findKeyOrNil:key
+ ].
] loop.
"Modified: 30.1.1997 / 15:04:38 / cg"
@@ -304,6 +304,6 @@
!WeakIdentitySet class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/WeakIdentitySet.st,v 1.42 2014-06-23 09:00:21 cg Exp $'
+ ^ '$Header$'
! !
--- a/WeakValueDictionary.st Thu Jul 23 12:40:48 2015 +0200
+++ b/WeakValueDictionary.st Thu Jul 23 13:10:17 2015 +0200
@@ -38,8 +38,8 @@
documentation
"
- WeakValueDictionaries behave like Dictionaries,
- as long as the values are still referenced by some
+ WeakValueDictionaries behave like Dictionaries,
+ as long as the values are still referenced by some
other (non-weak) object.
However, once the last non-weak reference ceases to exist,
the Dictionary will return nil for the value at position key.
@@ -52,10 +52,10 @@
In general, never trust the value as returned by the size/isEmpty messages.
[author:]
- Stefan Vogel
+ Stefan Vogel
[See also:]
- WeakArray WeakIdentityDictionary WeakIdentitySet
+ WeakArray WeakIdentityDictionary WeakIdentitySet
"
! !
@@ -70,10 +70,10 @@
|ret|
[
- ret := super at:key ifAbsent:[^ somethingRespondingToValue value].
- ret = 0 ifTrue:[
- ret := somethingRespondingToValue value
- ].
+ ret := super at:key ifAbsent:[^ somethingRespondingToValue value].
+ ret class == SmallInteger ifTrue:[
+ ret := somethingRespondingToValue value
+ ].
] valueUninterruptably.
^ ret
!
@@ -86,12 +86,12 @@
Redefined to block interrupts, to avoid trouble when dependencies
are added within interrupting high prio processes.
WARNING: do not add elements while iterating over the receiver.
- Iterate over a copy to do this."
+ Iterate over a copy to do this."
|ret|
[
- ret := super at:key ifAbsentPut:anObject.
+ ret := super at:key ifAbsentPut:anObject.
] valueUninterruptably.
^ ret
!
@@ -105,7 +105,7 @@
|ret|
[
- ret := super at:key put:anObject.
+ ret := super at:key put:anObject.
] valueUninterruptably.
^ ret
@@ -117,17 +117,17 @@
removeKey:aKey ifAbsent:aBlock
"remove the association under aKey from the collection,
return the value previously stored there.
- If it was not in the collection return the result
+ If it was not in the collection return the result
from evaluating aBlock.
Redefined to avoid synchronization problems, in case
- of interrupts (otherwise, there could be some other operation
+ of interrupts (otherwise, there could be some other operation
on the receiver done by another process, which garbles my contents)."
|ret|
[
- ret := super removeKey:aKey ifAbsent:aBlock
+ ret := super removeKey:aKey ifAbsent:aBlock
] valueUninterruptably.
^ ret
@@ -138,17 +138,17 @@
removeValue:aKey ifAbsent:aBlock
"remove the association under aValue from the collection,
return the key previously stored there.
- If it was not in the collection return the result
+ If it was not in the collection return the result
from evaluating aBlock.
Redefined to avoid synchronization problems, in case
- of interrupts (otherwise, there could be some other operation
+ of interrupts (otherwise, there could be some other operation
on the receiver done by another process, which garbles my contents)."
|ret|
[
- ret := super removeValue:aKey ifAbsent:aBlock
+ ret := super removeValue:aKey ifAbsent:aBlock
] valueUninterruptably.
^ ret.
@@ -165,7 +165,7 @@
|wasBlocked|
something == #ElementExpired ifTrue:[
- self clearDeadSlots.
+ self clearDeadSlots.
]
"Created: 7.1.1997 / 16:59:30 / stefan"
@@ -178,19 +178,19 @@
"
have to block here - dispose may be done at a low priority
- from the background finalizer. If new items are added by a
+ from the background finalizer. If new items are added by a
higher prio process, the dictionary might get corrupted otherwise
"
wasBlocked := OperatingSystem blockInterrupts.
- valueArray
- forAllDeadIndicesDo:[:idx | keyArray at:idx put:DeletedEntry.
- tally := tally - 1.
- ]
- replacingCorpsesWith:nil.
+ valueArray
+ forAllDeadIndicesDo:[:idx | keyArray at:idx put:DeletedEntry.
+ tally := tally - 1.
+ ]
+ replacingCorpsesWith:nil.
wasBlocked ifFalse:[
- OperatingSystem unblockInterrupts.
+ OperatingSystem unblockInterrupts.
].
"Modified: / 13.12.2001 / 14:18:56 / martin"
@@ -225,13 +225,13 @@
!WeakValueDictionary methodsFor:'testing'!
includes:anObject
- "redefined to block interrupts
+ "redefined to block interrupts
(avoid change of the dictionary while accessing)"
|val|
[
- val := super includes:anObject.
+ val := super includes:anObject.
] valueUninterruptably.
^ val
@@ -241,13 +241,13 @@
!
includesKey:key
- "redefined to block interrupts
+ "redefined to block interrupts
(avoid change of the dictionary while accessing)"
|val|
[
- val := super includesKey:key.
+ val := super includesKey:key.
] valueUninterruptably.
^ val
@@ -265,6 +265,6 @@
!WeakValueDictionary class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/WeakValueDictionary.st,v 1.20 2014-12-30 12:35:34 cg Exp $'
+ ^ '$Header$'
! !