--- a/Behavior.st Mon Feb 17 02:34:28 2014 +0100
+++ b/Behavior.st Mon Feb 17 11:28:38 2014 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1988 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
@@ -12,10 +12,10 @@
"{ Package: 'stx:libbasic' }"
Object subclass:#Behavior
- instanceVariableNames:'superclass flags methodDictionary lookupObject instSize'
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Classes'
+ instanceVariableNames:'superclass flags methodDictionary lookupObject instSize'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Classes'
!
!Behavior class methodsFor:'documentation'!
@@ -27,7 +27,7 @@
copyright
"
COPYRIGHT (c) 1988 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
@@ -72,25 +72,25 @@
[Instance variables:]
- superclass <Class> the receivers superclass
-
- methodDictionary <MethodDictionary> inst-selectors and methods
-
- instSize <SmallInteger> the number of instance variables
-
- flags <SmallInteger> special flag bits coded in a number
- not for application use
+ superclass <Class> the receivers superclass
+
+ methodDictionary <MethodDictionary> inst-selectors and methods
+
+ instSize <SmallInteger> the number of instance variables
+
+ flags <SmallInteger> special flag bits coded in a number
+ not for application use
flag bits (see stc.h):
NOTICE: layout known by compiler and runtime system; be careful when changing
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- Class ClassDescription Metaclass
- Method MethodDictionary
+ Class ClassDescription Metaclass
+ Method MethodDictionary
"
!
@@ -99,14 +99,14 @@
Expert info follows:
--------------------
NOTICE:
- the stuff described below may not be available on other
- Smalltalk implementations; be aware that these error mechanisms
- are ST/X specials and applications using these (tricks) may
- not be portable to other systems.
+ the stuff described below may not be available on other
+ Smalltalk implementations; be aware that these error mechanisms
+ are ST/X specials and applications using these (tricks) may
+ not be portable to other systems.
WARNING:
- do not try the examples below on (some) other smalltalk systems;
- it has been reported, that some crash badly when doing this .... ;-)
+ do not try the examples below on (some) other smalltalk systems;
+ it has been reported, that some crash badly when doing this .... ;-)
Instances of Behavior and subclasses (i.e. in sloppy words: classes)
play a special role w.r.t. the VM. Only objects whose class-slot is marked
@@ -136,9 +136,9 @@
object, the VM EXPECTS the object selector and methodDictionaries to be found
at the instance positions as defined here.
(i.e. instanceVariables with contents and semantic corresponding to
- superclass
- flags
- methodDictionary
+ superclass
+ flags
+ methodDictionary
must be present and have the same instVar-index as here).
The VM (and the system) may crash badly, if this is not the case.
@@ -172,111 +172,111 @@
Examples (only of theoretical interest):
----------------------------------------
- take away the behaviorLike-flag from a class.
- -> The instances will not understand any messages, since the VM will
- not recognize its class as being a class ...
-
- |newMeta notRecognizedAsClass someInstance|
-
- newMeta := Metaclass new.
- newMeta flags:0.
-
- notRecognizedAsClass := newMeta new.
-
- someInstance := notRecognizedAsClass new.
- someInstance perform:#isNil
+ take away the behaviorLike-flag from a class.
+ -> The instances will not understand any messages, since the VM will
+ not recognize its class as being a class ...
+
+ |newMeta notRecognizedAsClass someInstance|
+
+ newMeta := Metaclass new.
+ newMeta flags:0.
+
+ notRecognizedAsClass := newMeta new.
+
+ someInstance := notRecognizedAsClass new.
+ someInstance perform:#isNil
Of course, this is an exception which can be handled ...:
Example:
- |newMeta notRecognizedAsClass someInstance|
-
- newMeta := Metaclass new.
- newMeta flags:0.
-
- notRecognizedAsClass := newMeta new.
-
- someInstance := notRecognizedAsClass new.
- Object errorSignal handle:[:ex |
- ex return
- ] do:[
- someInstance perform:#isNil
- ]
+ |newMeta notRecognizedAsClass someInstance|
+
+ newMeta := Metaclass new.
+ newMeta flags:0.
+
+ notRecognizedAsClass := newMeta new.
+
+ someInstance := notRecognizedAsClass new.
+ Object errorSignal handle:[:ex |
+ ex return
+ ] do:[
+ someInstance perform:#isNil
+ ]
likewise, a doesNotUnderstand-notUnderstood can be handled:
Example:
- |newMeta funnyClass someInstance|
-
- newMeta := Metaclass new.
-
- funnyClass := newMeta new.
- funnyClass setSuperclass:nil.
-
- someInstance := funnyClass new.
- Object errorSignal handle:[:ex |
- ex return
- ] do:[
- someInstance perform:#isNil
- ]
+ |newMeta funnyClass someInstance|
+
+ newMeta := Metaclass new.
+
+ funnyClass := newMeta new.
+ funnyClass setSuperclass:nil.
+
+ someInstance := funnyClass new.
+ Object errorSignal handle:[:ex |
+ ex return
+ ] do:[
+ someInstance perform:#isNil
+ ]
more examples, which try to trick the VM ;-):
- badly playing around with a classes internals ...
-
- |newClass someInstance|
-
- newClass := Class new.
- newClass setSuperclass:nil.
- someInstance := newClass new.
- someInstance inspect
-
-
- |newClass someInstance|
-
- newClass := Class new.
- newClass setSuperclass:newClass.
- someInstance := newClass new.
- someInstance inspect
-
-
- |newClass someInstance|
-
- newClass := Class new.
- newClass setSuperclass:1.
- someInstance := newClass new.
- someInstance inspect
+ badly playing around with a classes internals ...
+
+ |newClass someInstance|
+
+ newClass := Class new.
+ newClass setSuperclass:nil.
+ someInstance := newClass new.
+ someInstance inspect
+
+
+ |newClass someInstance|
+
+ newClass := Class new.
+ newClass setSuperclass:newClass.
+ someInstance := newClass new.
+ someInstance inspect
+
+
+ |newClass someInstance|
+
+ newClass := Class new.
+ newClass setSuperclass:1.
+ someInstance := newClass new.
+ someInstance inspect
Example:
- creating totally anonymous classes:
-
- |newClass someInstance|
-
- newClass := Class new.
- someInstance := newClass new.
- someInstance inspect
+ creating totally anonymous classes:
+
+ |newClass someInstance|
+
+ newClass := Class new.
+ someInstance := newClass new.
+ someInstance inspect
Example:
- creating totally anonymous metaclasses:
-
- |newMeta newClass someInstance|
-
- newMeta := Metaclass new.
- newClass := newMeta new.
- someInstance := newClass new.
- someInstance inspect
+ creating totally anonymous metaclasses:
+
+ |newMeta newClass someInstance|
+
+ newMeta := Metaclass new.
+ newClass := newMeta new.
+ someInstance := newClass new.
+ someInstance inspect
PS: if you experiment with new behaviorLike objects, you may want
- to turn off the VM's debugPrintouts
- with:
- 'Smalltalk debugPrinting:false'
- and:
- 'Smalltalk infoPrinting:false'
+ to turn off the VM's debugPrintouts
+ with:
+ 'Smalltalk debugPrinting:false'
+ and:
+ 'Smalltalk infoPrinting:false'
Meta-Object-Protocol support:
-----------------------------
@@ -285,11 +285,11 @@
instead of the hardwired VM lookup algorithm, and provide a method as return value.
This method (if non-nil) will be put into the inline-and polymorph caches for speedy
call the next time. If non-nil, the lookup object is sent the:
- lookupMethodForSelector:aSelector
- directedTo:searchClass
- for:aReceiver
- withArguments:argArrayOrNil
- from:sendingContext
+ lookupMethodForSelector:aSelector
+ directedTo:searchClass
+ for:aReceiver
+ withArguments:argArrayOrNil
+ from:sendingContext
message.
'searchClass' is the object class or any of its superclasses (for directed/super sends).
You can return any arbitrary method there - for example to implement multiple inheritance,
@@ -316,10 +316,10 @@
newClass := self basicNew.
newClass
- setSuperclass:Object
- methodDictionary:(MethodDictionary new)
- instSize:0
- flags:(self flagBehavior).
+ setSuperclass:Object
+ methodDictionary:(MethodDictionary new)
+ instSize:0
+ flags:(self flagBehavior).
^ newClass
"
@@ -371,20 +371,20 @@
ObjectMemory allObjectsDo:[:o|
o isBehavior ifTrue:[
- (o class flags bitTest:bit) ifFalse:[
- self halt
- ].
+ (o class flags bitTest:bit) ifFalse:[
+ self halt
+ ].
] ifFalse:[
- (o class flags bitTest:bit) ifTrue:[
- self halt
- ].
+ (o class flags bitTest:bit) ifTrue:[
+ self halt
+ ].
].
o class isBehavior ifFalse:[
- self halt
+ self halt
] ifTrue:[
- (o class class flags bitTest:bit) ifFalse:[
- self halt
- ]
+ (o class class flags bitTest:bit) ifFalse:[
+ self halt
+ ]
]
]
"
@@ -520,49 +520,49 @@
flagForSymbolic:aSymbol
"return the flag code for indexed instances with aSymbolic type.
The argument may be one of
- #float, #double,
- #word, #signedWord,
- #long, #signedLong
- #longLong, #signedLongLong,
- #byte
- #weakObjects
+ #float, #double,
+ #word, #signedWord,
+ #long, #signedLong
+ #longLong, #signedLongLong,
+ #byte
+ #weakObjects
For VW compatibility, also accept:
- #objects, #bytes, #weak.
+ #objects, #bytes, #weak.
"
%{ /* NOCONTEXT */
if (aSymbol == @symbol(float)) {
- RETURN ( __mkSmallInteger(FLOATARRAY) );
+ RETURN ( __mkSmallInteger(FLOATARRAY) );
}
if (aSymbol == @symbol(double)) {
- RETURN ( __mkSmallInteger(DOUBLEARRAY) );
+ RETURN ( __mkSmallInteger(DOUBLEARRAY) );
}
if (aSymbol == @symbol(long)) {
- RETURN ( __mkSmallInteger(LONGARRAY) );
+ RETURN ( __mkSmallInteger(LONGARRAY) );
}
if (aSymbol == @symbol(longLong)) {
- RETURN ( __mkSmallInteger(LONGLONGARRAY) );
+ RETURN ( __mkSmallInteger(LONGLONGARRAY) );
}
if (aSymbol == @symbol(word)) {
- RETURN ( __mkSmallInteger(WORDARRAY) );
+ RETURN ( __mkSmallInteger(WORDARRAY) );
}
if (aSymbol == @symbol(signedWord)) {
- RETURN ( __mkSmallInteger(SWORDARRAY) );
+ RETURN ( __mkSmallInteger(SWORDARRAY) );
}
if (aSymbol == @symbol(signedLong)) {
- RETURN ( __mkSmallInteger(SLONGARRAY) );
+ RETURN ( __mkSmallInteger(SLONGARRAY) );
}
if (aSymbol == @symbol(signedLongLong)) {
- RETURN ( __mkSmallInteger(SLONGLONGARRAY) );
+ RETURN ( __mkSmallInteger(SLONGLONGARRAY) );
}
if ((aSymbol == @symbol(byte)) || (aSymbol == @symbol(bytes))) {
- RETURN ( __mkSmallInteger(BYTEARRAY) );
+ RETURN ( __mkSmallInteger(BYTEARRAY) );
}
if (aSymbol == @symbol(objects)) {
- RETURN ( __mkSmallInteger(POINTERARRAY) );
+ RETURN ( __mkSmallInteger(POINTERARRAY) );
}
if ((aSymbol == @symbol(weakObjects)) || (aSymbol == @symbol(weak))) {
- RETURN ( __mkSmallInteger(WKPOINTERARRAY) );
+ RETURN ( __mkSmallInteger(WKPOINTERARRAY) );
}
%}.
^ 0 "/ not indexed
@@ -835,24 +835,24 @@
orderedTuples := OrderedCollection new:aCollectionOfClasses size.
aCollectionOfClasses do:[:eachClass|
- |sharedPools|
- orderedTuples add:(Array with:eachClass with:eachClass superclass).
- sharedPools := eachClass sharedPools.
- sharedPools notEmptyOrNil ifTrue:[
- orderedTuples add:((OrderedCollection with:eachClass) addAll:sharedPools).
- ].
- eachClass allPrivateClasses do:[:eachPrivateClass| |superClassOwner|
- superClassOwner := eachPrivateClass superclass.
- "take care of classes inheriting from nil or ProtoObject"
- superClassOwner isBehavior ifTrue:[
- superClassOwner := superClassOwner owningClassOrYourself.
- ].
- orderedTuples add:(Array with:eachPrivateClass with:superClassOwner).
- sharedPools := eachPrivateClass sharedPools.
- sharedPools notEmptyOrNil ifTrue:[
- orderedTuples add:((OrderedCollection with:eachPrivateClass) addAll:sharedPools).
- ].
- ].
+ |sharedPools|
+ orderedTuples add:(Array with:eachClass with:eachClass superclass).
+ sharedPools := eachClass sharedPools.
+ sharedPools notEmptyOrNil ifTrue:[
+ orderedTuples add:((OrderedCollection with:eachClass) addAll:sharedPools).
+ ].
+ eachClass allPrivateClasses do:[:eachPrivateClass| |superClassOwner|
+ superClassOwner := eachPrivateClass superclass.
+ "take care of classes inheriting from nil or ProtoObject"
+ superClassOwner isBehavior ifTrue:[
+ superClassOwner := superClassOwner owningClassOrYourself.
+ ].
+ orderedTuples add:(Array with:eachPrivateClass with:superClassOwner).
+ sharedPools := eachPrivateClass sharedPools.
+ sharedPools notEmptyOrNil ifTrue:[
+ orderedTuples add:((OrderedCollection with:eachPrivateClass) addAll:sharedPools).
+ ].
+ ].
].
"I am only interested in my classes"
@@ -883,59 +883,59 @@
classesInLoadOrder := OrderedCollection new:(remaining size).
[remaining notEmpty] whileTrue:[
- |thoseWithOtherSuperclasses thoseWhichCanBeLoadedNow|
-
- "find the next class(es) to be loaded.
- Consider first:
- all those, which do not have a superclass in the remaining set.
- and which do not use a shared pool defined in the remaining set"
-
- thoseWithOtherSuperclasses :=
- remaining
- reject:[:eachClass |
- (remaining includes:eachClass superclass)
- or:[eachClass sharedPoolNames contains:[:eachPoolSymbol|
- remaining contains:[:eachRemainingClass| eachPoolSymbol = eachRemainingClass name]
- ]
- ].
- ].
-
- "second: the subset with all those having no private classes,
- or having private classes, whose superclasses are NOT in the remaining set,
- or having private classes which do not use a shared pool in the remaining set"
-
- thoseWhichCanBeLoadedNow :=
- thoseWithOtherSuperclasses
- reject:[:eachClass |
- eachClass allPrivateClasses contains:[:eachPrivateClass|
- |superClassesOwner sharedPools|
- superClassesOwner := eachPrivateClass superclass.
- "take care of classes inheriting from nil or ProtoObject"
- superClassesOwner isBehavior ifTrue:[
- superClassesOwner := superClassesOwner owningClassOrYourself.
- ].
- sharedPools := eachPrivateClass sharedPools.
- (superClassesOwner ~~ eachClass
- and:[remaining includes:superClassesOwner])
- or:[remaining includesAny:sharedPools]
- ].
- ].
-
- thoseWhichCanBeLoadedNow isEmpty ifTrue:[
- thoseWithOtherSuperclasses isEmpty ifTrue:[
- "this does not normally happen"
- self error:'superclass order is cyclic'.
- ] ifFalse:[
- "no class found, that may be loaded - maybe there is a cyclic
- dependency involving private classes.
- If you proceed here, private class dependencies are ignored
- for this pass"
- self error:'load order is cyclic (care for private classes)' mayProceed:true.
- thoseWhichCanBeLoadedNow := thoseWithOtherSuperclasses.
- ].
- ].
- remaining removeAllFoundIn:thoseWhichCanBeLoadedNow.
- classesInLoadOrder addAll:(thoseWhichCanBeLoadedNow sort:[:a :b | a name < b name]).
+ |thoseWithOtherSuperclasses thoseWhichCanBeLoadedNow|
+
+ "find the next class(es) to be loaded.
+ Consider first:
+ all those, which do not have a superclass in the remaining set.
+ and which do not use a shared pool defined in the remaining set"
+
+ thoseWithOtherSuperclasses :=
+ remaining
+ reject:[:eachClass |
+ (remaining includes:eachClass superclass)
+ or:[eachClass sharedPoolNames contains:[:eachPoolSymbol|
+ remaining contains:[:eachRemainingClass| eachPoolSymbol = eachRemainingClass name]
+ ]
+ ].
+ ].
+
+ "second: the subset with all those having no private classes,
+ or having private classes, whose superclasses are NOT in the remaining set,
+ or having private classes which do not use a shared pool in the remaining set"
+
+ thoseWhichCanBeLoadedNow :=
+ thoseWithOtherSuperclasses
+ reject:[:eachClass |
+ eachClass allPrivateClasses contains:[:eachPrivateClass|
+ |superClassesOwner sharedPools|
+ superClassesOwner := eachPrivateClass superclass.
+ "take care of classes inheriting from nil or ProtoObject"
+ superClassesOwner isBehavior ifTrue:[
+ superClassesOwner := superClassesOwner owningClassOrYourself.
+ ].
+ sharedPools := eachPrivateClass sharedPools.
+ (superClassesOwner ~~ eachClass
+ and:[remaining includes:superClassesOwner])
+ or:[remaining includesAny:sharedPools]
+ ].
+ ].
+
+ thoseWhichCanBeLoadedNow isEmpty ifTrue:[
+ thoseWithOtherSuperclasses isEmpty ifTrue:[
+ "this does not normally happen"
+ self error:'superclass order is cyclic'.
+ ] ifFalse:[
+ "no class found, that may be loaded - maybe there is a cyclic
+ dependency involving private classes.
+ If you proceed here, private class dependencies are ignored
+ for this pass"
+ self error:'load order is cyclic (care for private classes)' mayProceed:true.
+ thoseWhichCanBeLoadedNow := thoseWithOtherSuperclasses.
+ ].
+ ].
+ remaining removeAllFoundIn:thoseWhichCanBeLoadedNow.
+ classesInLoadOrder addAll:(thoseWhichCanBeLoadedNow sort:[:a :b | a name < b name]).
].
^ classesInLoadOrder
@@ -958,22 +958,22 @@
|common|
listOfClassesOrClassNames do:[:classOrClassName |
- |class|
-
- class := classOrClassName isBehavior
- ifTrue:[classOrClassName]
- ifFalse:[Smalltalk classNamed:classOrClassName].
-
- common isNil ifTrue:[
- common := class
- ] ifFalse:[
- (class isSubclassOf:common) ifTrue:[
- "keep common"
- ] ifFalse:[
- (common isSubclassOf:class) ifTrue:[
- common := class
- ] ifFalse:[
- common := common commonSuperclass:class.
+ |class|
+
+ class := classOrClassName isBehavior
+ ifTrue:[classOrClassName]
+ ifFalse:[Smalltalk classNamed:classOrClassName].
+
+ common isNil ifTrue:[
+ common := class
+ ] ifFalse:[
+ (class isSubclassOf:common) ifTrue:[
+ "keep common"
+ ] ifFalse:[
+ (common isSubclassOf:class) ifTrue:[
+ common := class
+ ] ifFalse:[
+ common := common commonSuperclass:class.
"/ "walk up, checking"
"/ found := false.
@@ -992,10 +992,10 @@
"/ ]
"/ ].
"/ ].
- ]
- ].
- ].
- (common isNil or:[common == Object]) ifTrue:[^ common].
+ ]
+ ].
+ ].
+ (common isNil or:[common == Object]) ifTrue:[^ common].
].
^ common
@@ -1023,16 +1023,16 @@
"return a collection of partial class-definition selectors"
^ #( #'subclass:'
- #'variableSubclass:'
- #'variableByteSubclass:'
- #'variableWordSubclass:'
- #'variableLongSubclass:'
- #'variableSignedWordSubclass:'
- #'variableSignedLongSubclass:'
- #'variableLongLongSubclass:'
- #'variableSignedLongLongSubclass:'
- #'variableFloatSubclass:'
- #'variableDoubleSubclass:'
+ #'variableSubclass:'
+ #'variableByteSubclass:'
+ #'variableWordSubclass:'
+ #'variableLongSubclass:'
+ #'variableSignedWordSubclass:'
+ #'variableSignedLongSubclass:'
+ #'variableLongLongSubclass:'
+ #'variableSignedLongLongSubclass:'
+ #'variableFloatSubclass:'
+ #'variableDoubleSubclass:'
)
!
@@ -1040,40 +1040,40 @@
"return a collection class-definition selectors"
^ #(
- #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
- #'variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
- #'variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
- #'variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
- #'variableLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
- #'variableSignedWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
- #'variableSignedLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
- #'variableLongLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
- #'variableSignedLongLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
- #'variableFloatSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
- #'variableDoubleSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
-
- "/ ST/X private subclasses
-
- #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- #'variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- #'variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- #'variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- #'variableLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- #'variableSignedWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- #'variableSignedLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- #'variableLongLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- #'variableSignedLongLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- #'variableFloatSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
- #'variableDoubleSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
-
- "/ ST/V subclass messages
-
- #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:'
- #'variableByteSubclass:classVariableNames:poolDictionaries:'
- #'variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:'
-
- "/ Dolphin
- #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:classInstanceVariableNames:'
+ #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ #'variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ #'variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ #'variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ #'variableLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ #'variableSignedWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ #'variableSignedLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ #'variableLongLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ #'variableSignedLongLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ #'variableFloatSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ #'variableDoubleSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+
+ "/ ST/X private subclasses
+
+ #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
+ #'variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
+ #'variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
+ #'variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
+ #'variableLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
+ #'variableSignedWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
+ #'variableSignedLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
+ #'variableLongLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
+ #'variableSignedLongLongSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
+ #'variableFloatSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
+ #'variableDoubleSubclass:instanceVariableNames:classVariableNames:poolDictionaries:privateIn:'
+
+ "/ ST/V subclass messages
+
+ #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:'
+ #'variableByteSubclass:classVariableNames:poolDictionaries:'
+ #'variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:'
+
+ "/ Dolphin
+ #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:classInstanceVariableNames:'
)
!
@@ -1097,8 +1097,6 @@
! !
-
-
!Behavior methodsFor:'Compatibility-Dolphin'!
allSubinstances
@@ -1173,7 +1171,7 @@
"Return all selectors defined in this class that take this number of arguments."
^ self selectors
- select:[:sel | sel numArgs == numberOfArgs]
+ select:[:sel | sel numArgs == numberOfArgs]
"
SmallInteger selectorsWithArgs:0
@@ -1263,30 +1261,30 @@
|oldMethod ns nsName selector newLookupObject|
(newSelector isMemberOf:Symbol) ifFalse:[
- self error:'invalid selector'.
+ self error:'invalid selector'.
].
ns := newMethod nameSpace.
(ns notNil and:[(nsName := ns name) ~= self programmingLanguage defaultSelectorNameSpacePrefix]) ifTrue:[
- selector := (':' , nsName , '::' , newSelector) asSymbol.
- newLookupObject := Smalltalk at: #NamespaceAwareLookup. "/ so it can be nilled to disable that feature
+ selector := (':' , nsName , '::' , newSelector) asSymbol.
+ newLookupObject := Smalltalk at: #NamespaceAwareLookup. "/ so it can be nilled to disable that feature
] ifFalse:[
- selector := newSelector
+ selector := newSelector
].
"/ Q (cg): isn't that something that the caller should decide?
oldMethod := self compiledMethodAt:selector.
oldMethod notNil ifTrue:[
- newMethod restricted:(oldMethod isRestricted).
- newMethod setPrivacy:(oldMethod privacy) flushCaches:false.
+ newMethod restricted:(oldMethod isRestricted).
+ newMethod setPrivacy:(oldMethod privacy) flushCaches:false.
].
(self primAddSelector:selector withMethod:newMethod) ifFalse:[^ false].
newLookupObject notNil ifTrue:[
- lookupObject ~= newLookupObject ifTrue:[
- self lookupObject: newLookupObject
- ]
+ lookupObject ~= newLookupObject ifTrue:[
+ self lookupObject: newLookupObject
+ ]
].
"
@@ -1296,12 +1294,12 @@
"
"
problem: this is slower; since looking for all subclasses is (currently)
- a bit slow :-(
- We need the hasSubclasses-info bit in Behavior; now
+ a bit slow :-(
+ We need the hasSubclasses-info bit in Behavior; now
self withAllSubclassesDo:[:aClass |
- ObjectMemory flushInlineCachesFor:aClass withArgs:nargs.
- ObjectMemory flushMethodCacheFor:aClass
+ ObjectMemory flushInlineCachesFor:aClass withArgs:nargs.
+ ObjectMemory flushMethodCacheFor:aClass
].
"
@@ -1350,10 +1348,10 @@
|dict newDict|
(Smalltalk
- changeRequest:#methodInClassRemoved
- with:(Array with:self with:aSelector)
+ changeRequest:#methodInClassRemoved
+ with:(Array with:self with:aSelector)
) ifFalse:[
- ^ false
+ ^ false
].
dict := self methodDictionary.
@@ -1408,9 +1406,9 @@
behavior := self.
[ behavior notNil ] whileTrue:[
- lookup := behavior getLookupObject.
- lookup notNil ifTrue: [^ lookup].
- behavior := behavior superclass
+ lookup := behavior getLookupObject.
+ lookup notNil ifTrue: [^ lookup].
+ behavior := behavior superclass
].
^ Lookup builtin.
@@ -1424,11 +1422,11 @@
(anObject respondsTo: #lookupMethodForSelector:directedTo:for:withArguments:from:ilc:)
ifFalse:[
- self error:'Lookup object does not respond to #lookupMethodForSelector:directedTo:for:withArguments:from:ilc'
+ self error:'Lookup object does not respond to #lookupMethodForSelector:directedTo:for:withArguments:from:ilc'
].
(anObject respondsTo:#superLookupObject:)
ifTrue:[
- anObject superLookupObject: self lookupObject
+ anObject superLookupObject: self lookupObject
].
self setLookupObject: anObject.
@@ -1449,8 +1447,8 @@
"set the receivers method dictionary and flush inline caches."
dict isNil ifTrue:[
- self error:'attempt to set methodDictionary to nil.' mayProceed:true.
- ^ self
+ self error:'attempt to set methodDictionary to nil.' mayProceed:true.
+ ^ self
].
self setMethodDictionary:dict.
ObjectMemory flushCaches.
@@ -1480,8 +1478,8 @@
|md|
(md := self methodDictionary) isNil ifTrue:[
- 'oops - nil methodDictionary' errorPrintCR.
- ^ #()
+ 'oops - nil methodDictionary' errorPrintCR.
+ ^ #()
].
^ md keys
@@ -1622,8 +1620,8 @@
Returns the new method or nil (on failure)."
^ self compilerClass
- compile:code
- forClass:self
+ compile:code
+ forClass:self
"Modified: 13.12.1995 / 10:56:00 / cg"
"Created: 1.4.1997 / 23:43:51 / stefan"
@@ -1659,9 +1657,9 @@
Returns the new method or nil (on failure)."
^ self compilerClass
- compile:code
- forClass:self
- notifying:requestor
+ compile:code
+ forClass:self
+ notifying:requestor
"Modified: 13.12.1995 / 11:02:40 / cg"
"Created: 1.4.1997 / 23:43:43 / stefan"
@@ -1690,15 +1688,15 @@
indexed := false.
aPrototype class isVariable ifTrue:[
- self isVariable ifTrue:[
- indexed := true.
- ].
- "otherwise, these are lost ..."
+ self isVariable ifTrue:[
+ indexed := true.
+ ].
+ "otherwise, these are lost ..."
].
indexed ifTrue:[
- newInst := self basicNew:aPrototype basicSize
+ newInst := self basicNew:aPrototype basicSize
] ifFalse:[
- newInst := self basicNew
+ newInst := self basicNew
].
newInst cloneInstanceVariablesFrom:aPrototype.
@@ -1707,23 +1705,23 @@
"
Class withoutUpdatingChangesDo:[
- Point subclass:#Point3D
- instanceVariableNames:'z'
- classVariableNames:''
- poolDictionaries:''
- category:'testing'.
- (Point3D cloneFrom:1@2) inspect.
+ Point subclass:#Point3D
+ instanceVariableNames:'z'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'testing'.
+ (Point3D cloneFrom:1@2) inspect.
]
"
"
Class withoutUpdatingChangesDo:[
- Point variableSubclass:#Point3D
- instanceVariableNames:'z'
- classVariableNames:''
- poolDictionaries:''
- category:'testing'.
- (Point3D cloneFrom:#(1 2 3)) inspect.
+ Point variableSubclass:#Point3D
+ instanceVariableNames:'z'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'testing'.
+ (Point3D cloneFrom:#(1 2 3)) inspect.
]
"
@@ -1731,19 +1729,19 @@
|someObject|
Class withoutUpdatingChangesDo:[
- Object subclass:#TestClass1
- instanceVariableNames:'foo bar'
- classVariableNames:''
- poolDictionaries:''
- category:'testing'.
- someObject := TestClass1 new.
- someObject instVarAt:1 put:'foo'; instVarAt:2 put:'bar'.
- Object subclass:#TestClass2
- instanceVariableNames:'bar foo'
- classVariableNames:''
- poolDictionaries:''
- category:'testing'.
- (TestClass2 cloneFrom:someObject) inspect.
+ Object subclass:#TestClass1
+ instanceVariableNames:'foo bar'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'testing'.
+ someObject := TestClass1 new.
+ someObject instVarAt:1 put:'foo'; instVarAt:2 put:'bar'.
+ Object subclass:#TestClass2
+ instanceVariableNames:'bar foo'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'testing'.
+ (TestClass2 cloneFrom:someObject) inspect.
]
"
!
@@ -1809,7 +1807,7 @@
"evaluate aBlock for all of my instances"
ObjectMemory allInstancesOf:self do:[:anObject |
- aBlock value:anObject
+ aBlock value:anObject
]
"
@@ -1824,8 +1822,8 @@
owner := self owningClass.
[owner notNil] whileTrue:[
- aBlock value:owner.
- owner := owner owningClass.
+ aBlock value:owner.
+ owner := owner owningClass.
].
"
@@ -1848,9 +1846,9 @@
"evaluate aBlock for all of my instances and all instances of subclasses"
ObjectMemory allObjectsDo:[:anObject |
- (anObject isKindOf:self) ifTrue:[
- aBlock value:anObject
- ]
+ (anObject isKindOf:self) ifTrue:[
+ aBlock value:anObject
+ ]
]
"
@@ -1862,8 +1860,8 @@
"evaluate aBlock for all of my subclasses.
There is no specific order, in which the entries are enumerated.
Warning:
- This will only enumerate globally known classes - for anonymous
- behaviors, you have to walk over all instances of Behavior."
+ This will only enumerate globally known classes - for anonymous
+ behaviors, you have to walk over all instances of Behavior."
self allSubclassesInOrderDo:aBlock
@@ -1941,12 +1939,16 @@
allSuperclassesDo:aBlock
"evaluate aBlock for all of my superclasses"
- |theClass|
-
+ |theClass
+ n "{ Class: SmallInteger }"|
+
+ n := 1.
theClass := self superclass.
[theClass notNil] whileTrue:[
- aBlock value:theClass.
- theClass := theClass superclass
+ aBlock value:theClass.
+ theClass := theClass superclass.
+ n := n + 1.
+ n > 100000 ifTrue:[ VMInternalError raiseErrorString:'deep inheritance' ].
]
"
@@ -2003,9 +2005,9 @@
"Do it the hard way. Subclasses redefine this"
Smalltalk allClassesDo:[:aClass |
- (aClass superclass == self) ifTrue:[
- aBlock value:aClass
- ]
+ (aClass superclass == self) ifTrue:[
+ aBlock value:aClass
+ ]
]
!
@@ -2017,8 +2019,8 @@
cls := self.
[cls notNil] whileTrue:[
- (aBlock value: cls) ifTrue: [^ cls].
- cls := cls superclass.
+ (aBlock value: cls) ifTrue: [^ cls].
+ cls := cls superclass.
].
^ nil
@@ -2031,8 +2033,8 @@
"evaluate aBlock for mySelf and all of my subclasses.
There is no specific order, in which the entries are enumerated.
Warning:
- This will only enumerate globally known classes - for anonymous
- behaviors, you have to walk over all instances of Behavior."
+ This will only enumerate globally known classes - for anonymous
+ behaviors, you have to walk over all instances of Behavior."
aBlock value:self.
self allSubclassesDo:aBlock
@@ -2046,14 +2048,8 @@
withAllSuperclassesDo:aBlock
"evaluate aBlock for the class and all of its superclasses"
- |theSuperClass|
-
aBlock value:self.
- theSuperClass := self superclass.
- [theSuperClass notNil] whileTrue:[
- aBlock value:theSuperClass.
- theSuperClass := theSuperClass superclass
- ].
+ self allSuperclassesDo:aBlock
"
String withAllSuperclassesDo:[:each| Transcript showCR:each]
@@ -2099,10 +2095,10 @@
Statically compiled classes are initialized by the VM"
(self class includesSelector:#initialize) ifTrue:[
- self initialize.
+ self initialize.
].
self privateClassesSorted do:[:aPrivateClass |
- aPrivateClass initializeWithAllPrivateClasses.
+ aPrivateClass initializeWithAllPrivateClasses.
].
"Created: / 13.5.1998 / 23:33:16 / cg"
@@ -2165,114 +2161,114 @@
* (i.e. if no GC is needed, we fall through without a branch)
*/
if (nextPtr < (char *)__newEndPtr) {
- __objPtr(newobj)->o_size = instsize;
- /* o_allFlags(newobj) = 0; */
- /* __objPtr(newobj)->o_space = __newSpace; */
- o_setAllFlags(newobj, __newSpace);
+ __objPtr(newobj)->o_size = instsize;
+ /* o_allFlags(newobj) = 0; */
+ /* __objPtr(newobj)->o_space = __newSpace; */
+ o_setAllFlags(newobj, __newSpace);
#ifdef __HAS_ALIGN4__
- /*
- * if the alignment is 4, we are already sat,
- * since a non-indexed object always has a word-aligned size.
- */
- __newNextPtr = nextPtr;
+ /*
+ * if the alignment is 4, we are already sat,
+ * since a non-indexed object always has a word-aligned size.
+ */
+ __newNextPtr = nextPtr;
#else
- if (instsize & (__ALIGN__-1)) {
- __newNextPtr = (char *)newobj + (instsize & ~(__ALIGN__-1)) + __ALIGN__;
- } else {
- __newNextPtr = nextPtr;
- }
+ if (instsize & (__ALIGN__-1)) {
+ __newNextPtr = (char *)newobj + (instsize & ~(__ALIGN__-1)) + __ALIGN__;
+ } else {
+ __newNextPtr = nextPtr;
+ }
#endif
ok:
- __InstPtr(newobj)->o_class = self;
- __qSTORE(newobj, self);
-
- if (nInstVars) {
+ __InstPtr(newobj)->o_class = self;
+ __qSTORE(newobj, self);
+
+ if (nInstVars) {
#if defined(memset4) && defined(FAST_OBJECT_MEMSET4) || defined(FAST_MEMSET4)
- memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
+ memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
#else
- REGISTER OBJ *op = __InstPtr(newobj)->i_instvars;
-
- /*
- * knowing that nil is 0
- */
+ REGISTER OBJ *op = __InstPtr(newobj)->i_instvars;
+
+ /*
+ * knowing that nil is 0
+ */
# if defined(FAST_OBJECT_MEMSET_DOUBLES_UNROLLED)
- if (nInstVars > 8) {
- *op++ = nil; /* for alignment */
- nInstVars--;
- while (nInstVars >= 8) {
- *(double *)op = 0.0;
- ((double *)op)[1] = 0.0;
- ((double *)op)[2] = 0.0;
- ((double *)op)[3] = 0.0;
- op += 8;
- nInstVars -= 8;
- }
- }
- while (nInstVars != 0) {
- *op++ = 0;
- nInstVars--;
- }
+ if (nInstVars > 8) {
+ *op++ = nil; /* for alignment */
+ nInstVars--;
+ while (nInstVars >= 8) {
+ *(double *)op = 0.0;
+ ((double *)op)[1] = 0.0;
+ ((double *)op)[2] = 0.0;
+ ((double *)op)[3] = 0.0;
+ op += 8;
+ nInstVars -= 8;
+ }
+ }
+ while (nInstVars != 0) {
+ *op++ = 0;
+ nInstVars--;
+ }
# else
# if defined(FAST_OBJECT_MEMSET_LONGLONG_UNROLLED)
- if (nInstVars > 8) {
- *op++ = nil; /* for alignment */
- nInstVars--;
- while (nInstVars >= 8) {
- *(long long *)op = 0;
- ((long long *)op)[1] = 0;
- ((long long *)op)[2] = 0;
- ((long long *)op)[3] = 0;
- op += 8;
- nInstVars -= 8;
- }
- }
- while (nInstVars != 0) {
- *op++ = 0;
- nInstVars--;
- }
+ if (nInstVars > 8) {
+ *op++ = nil; /* for alignment */
+ nInstVars--;
+ while (nInstVars >= 8) {
+ *(long long *)op = 0;
+ ((long long *)op)[1] = 0;
+ ((long long *)op)[2] = 0;
+ ((long long *)op)[3] = 0;
+ op += 8;
+ nInstVars -= 8;
+ }
+ }
+ while (nInstVars != 0) {
+ *op++ = 0;
+ nInstVars--;
+ }
# else
# if defined(FAST_OBJECT_MEMSET_WORDS_UNROLLED)
- while (nInstVars >= 8) {
- *op = nil;
- *(op+1) = nil;
- *(op+2) = nil;
- *(op+3) = nil;
- *(op+4) = nil;
- *(op+5) = nil;
- *(op+6) = nil;
- *(op+7) = nil;
- op += 8;
- nInstVars -= 8;
- }
- while (nInstVars != 0) {
- *op++ = nil;
- nInstVars--;
- }
+ while (nInstVars >= 8) {
+ *op = nil;
+ *(op+1) = nil;
+ *(op+2) = nil;
+ *(op+3) = nil;
+ *(op+4) = nil;
+ *(op+5) = nil;
+ *(op+6) = nil;
+ *(op+7) = nil;
+ op += 8;
+ nInstVars -= 8;
+ }
+ while (nInstVars != 0) {
+ *op++ = nil;
+ nInstVars--;
+ }
# else
# if defined(FAST_MEMSET)
- memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
# else
- while (nInstVars >= 8) {
- nInstVars -= 8;
- op[0] = nil; op[1] = nil;
- op[2] = nil; op[3] = nil;
- op[4] = nil; op[5] = nil;
- op[6] = nil; op[7] = nil;
- op += 8;
- }
- while (nInstVars != 0) {
- *op++ = nil;
- nInstVars--;
- }
+ while (nInstVars >= 8) {
+ nInstVars -= 8;
+ op[0] = nil; op[1] = nil;
+ op[2] = nil; op[3] = nil;
+ op[4] = nil; op[5] = nil;
+ op[6] = nil; op[7] = nil;
+ op += 8;
+ }
+ while (nInstVars != 0) {
+ *op++ = nil;
+ nInstVars--;
+ }
# endif
# endif
# endif
# endif
#endif
- }
- RETURN ( newobj );
+ }
+ RETURN ( newobj );
}
/*
@@ -2318,383 +2314,383 @@
double *dp;
if (__isSmallInteger(anInteger)) {
- nindexedinstvars = __intVal(anInteger);
- if (nindexedinstvars >= 0) {
- nInstVars = __intVal(__INST(instSize));
- flags = __intVal(__INST(flags)) & ARRAYMASK;
- switch (flags) {
- case BYTEARRAY:
- instsize = OHDR_SIZE + nindexedinstvars;
- if (nInstVars == 0) {
- if (__CanDoQuickNew(instsize)) { /* OBJECT ALLOCATION */
- /*
- * the most common case
- */
- __qCheckedNew(newobj, instsize);
- __InstPtr(newobj)->o_class = self;
- __qSTORE(newobj, self);
+ nindexedinstvars = __intVal(anInteger);
+ if (nindexedinstvars >= 0) {
+ nInstVars = __intVal(__INST(instSize));
+ flags = __intVal(__INST(flags)) & ARRAYMASK;
+ switch (flags) {
+ case BYTEARRAY:
+ instsize = OHDR_SIZE + nindexedinstvars;
+ if (nInstVars == 0) {
+ if (__CanDoQuickNew(instsize)) { /* OBJECT ALLOCATION */
+ /*
+ * the most common case
+ */
+ __qCheckedNew(newobj, instsize);
+ __InstPtr(newobj)->o_class = self;
+ __qSTORE(newobj, self);
#if defined(memset4) && defined(FAST_ARRAY_MEMSET4) || defined(FAST_MEMSET4)
- nInstVars = nindexedinstvars >> 2;
- if (nindexedinstvars & 3) nInstVars++;
- memset4(__InstPtr(newobj)->i_instvars, 0, nInstVars);
+ nInstVars = nindexedinstvars >> 2;
+ if (nindexedinstvars & 3) nInstVars++;
+ memset4(__InstPtr(newobj)->i_instvars, 0, nInstVars);
#else
# if defined(FAST_ARRAY_MEMSET)
- memset(__InstPtr(newobj)->i_instvars, 0, nindexedinstvars);
+ memset(__InstPtr(newobj)->i_instvars, 0, nindexedinstvars);
# else
- cp = (char *)__InstPtr(newobj)->i_instvars;
- while (nindexedinstvars >= sizeof(INT)) {
- *(INT *)cp = (INT)0;
- cp += sizeof(INT);
- nindexedinstvars -= sizeof(INT);
- }
- while (nindexedinstvars--)
- *cp++ = '\0';
+ cp = (char *)__InstPtr(newobj)->i_instvars;
+ while (nindexedinstvars >= sizeof(INT)) {
+ *(INT *)cp = (INT)0;
+ cp += sizeof(INT);
+ nindexedinstvars -= sizeof(INT);
+ }
+ while (nindexedinstvars--)
+ *cp++ = '\0';
# endif
#endif
- RETURN ( newobj );
- }
- } else {
- instsize += __OBJS2BYTES__(nInstVars);
- }
- __PROTECT_CONTEXT__
- __qNew(newobj, instsize); /* OBJECT ALLOCATION */
- __UNPROTECT_CONTEXT__
- if (newobj == nil) {
- break;
- }
- __InstPtr(newobj)->o_class = self;
- __qSTORE(newobj, self);
+ RETURN ( newobj );
+ }
+ } else {
+ instsize += __OBJS2BYTES__(nInstVars);
+ }
+ __PROTECT_CONTEXT__
+ __qNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __UNPROTECT_CONTEXT__
+ if (newobj == nil) {
+ break;
+ }
+ __InstPtr(newobj)->o_class = self;
+ __qSTORE(newobj, self);
#if defined(memset4) && defined(FAST_ARRAY_MEMSET4) || defined(FAST_MEMSET4)
- nInstVars = (instsize-OHDR_SIZE) >> 2;
- if (instsize & 3) nInstVars++;
- memset4(__InstPtr(newobj)->i_instvars, 0, nInstVars);
+ nInstVars = (instsize-OHDR_SIZE) >> 2;
+ if (instsize & 3) nInstVars++;
+ memset4(__InstPtr(newobj)->i_instvars, 0, nInstVars);
#else
# if defined(FAST_ARRAY_MEMSET)
- /*
- * knowing that nil is 0
- */
- memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
+ /*
+ * knowing that nil is 0
+ */
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
# else
- op = __InstPtr(newobj)->i_instvars;
- while (nInstVars--)
- *op++ = nil;
- cp = (char *)op;
- while (nindexedinstvars >= sizeof(INT)) {
- *(INT *)cp = 0;
- cp += sizeof(INT);
- nindexedinstvars -= sizeof(INT);
- }
- while (nindexedinstvars--)
- *cp++ = '\0';
+ op = __InstPtr(newobj)->i_instvars;
+ while (nInstVars--)
+ *op++ = nil;
+ cp = (char *)op;
+ while (nindexedinstvars >= sizeof(INT)) {
+ *(INT *)cp = 0;
+ cp += sizeof(INT);
+ nindexedinstvars -= sizeof(INT);
+ }
+ while (nindexedinstvars--)
+ *cp++ = '\0';
# endif
#endif
- RETURN ( newobj );
- break;
-
- case WORDARRAY:
- case SWORDARRAY:
- instsize = OHDR_SIZE +
- __OBJS2BYTES__(nInstVars) +
- nindexedinstvars * 2;
- __PROTECT_CONTEXT__
- __qNew(newobj, instsize); /* OBJECT ALLOCATION */
- __UNPROTECT_CONTEXT__
- if (newobj == nil) {
- break;
- }
- __InstPtr(newobj)->o_class = self;
- __qSTORE(newobj, self);
+ RETURN ( newobj );
+ break;
+
+ case WORDARRAY:
+ case SWORDARRAY:
+ instsize = OHDR_SIZE +
+ __OBJS2BYTES__(nInstVars) +
+ nindexedinstvars * 2;
+ __PROTECT_CONTEXT__
+ __qNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __UNPROTECT_CONTEXT__
+ if (newobj == nil) {
+ break;
+ }
+ __InstPtr(newobj)->o_class = self;
+ __qSTORE(newobj, self);
#if defined(FAST_ARRAY_MEMSET)
- /*
- * knowing that nil is 0
- */
- memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+ /*
+ * knowing that nil is 0
+ */
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
#else
- op = __InstPtr(newobj)->i_instvars;
- while (nInstVars--)
- *op++ = nil;
- sp = (short *)op;
- while (nindexedinstvars--)
- *sp++ = 0;
+ op = __InstPtr(newobj)->i_instvars;
+ while (nInstVars--)
+ *op++ = nil;
+ sp = (short *)op;
+ while (nindexedinstvars--)
+ *sp++ = 0;
#endif
- RETURN ( newobj );
- break;
-
- case LONGARRAY:
- case SLONGARRAY:
- instsize = OHDR_SIZE +
- __OBJS2BYTES__(nInstVars) +
- nindexedinstvars * 4;
- __PROTECT_CONTEXT__
- __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
- __UNPROTECT_CONTEXT__
- if (newobj == nil) {
- break;
- }
- __InstPtr(newobj)->o_class = self;
- __qSTORE(newobj, self);
+ RETURN ( newobj );
+ break;
+
+ case LONGARRAY:
+ case SLONGARRAY:
+ instsize = OHDR_SIZE +
+ __OBJS2BYTES__(nInstVars) +
+ nindexedinstvars * 4;
+ __PROTECT_CONTEXT__
+ __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __UNPROTECT_CONTEXT__
+ if (newobj == nil) {
+ break;
+ }
+ __InstPtr(newobj)->o_class = self;
+ __qSTORE(newobj, self);
#if defined(memset4)
- /*
- * knowing that nil is 0
- */
- {
- int n4 = nInstVars + nindexedinstvars;
-
- memset4(__InstPtr(newobj)->i_instvars, 0, n4);
- }
+ /*
+ * knowing that nil is 0
+ */
+ {
+ int n4 = nInstVars + nindexedinstvars;
+
+ memset4(__InstPtr(newobj)->i_instvars, 0, n4);
+ }
#else
# if defined(FAST_ARRAY_MEMSET)
- /*
- * knowing that nil is 0
- */
- memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+ /*
+ * knowing that nil is 0
+ */
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
# else
- op = __InstPtr(newobj)->i_instvars;
- while (nInstVars--)
- *op++ = nil;
- lp = (long *)op;
- while (nindexedinstvars--)
- *lp++ = 0;
+ op = __InstPtr(newobj)->i_instvars;
+ while (nInstVars--)
+ *op++ = nil;
+ lp = (long *)op;
+ while (nindexedinstvars--)
+ *lp++ = 0;
# endif
#endif
- RETURN ( newobj );
- break;
-
- case LONGLONGARRAY:
- case SLONGLONGARRAY:
- instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
+ RETURN ( newobj );
+ break;
+
+ case LONGLONGARRAY:
+ case SLONGLONGARRAY:
+ instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
#ifdef __NEED_LONGLONG_ALIGN
- instsize = ((instsize-1) + __LONGLONG_ALIGN) & ~(__LONGLONG_ALIGN-1);
+ instsize = ((instsize-1) + __LONGLONG_ALIGN) & ~(__LONGLONG_ALIGN-1);
#endif
- instsize += nindexedinstvars * 8;
-
- __PROTECT_CONTEXT__
- __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
- __UNPROTECT_CONTEXT__
- if (newobj == nil) {
- break;
- }
- __InstPtr(newobj)->o_class = self;
- __qSTORE(newobj, self);
+ instsize += nindexedinstvars * 8;
+
+ __PROTECT_CONTEXT__
+ __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __UNPROTECT_CONTEXT__
+ if (newobj == nil) {
+ break;
+ }
+ __InstPtr(newobj)->o_class = self;
+ __qSTORE(newobj, self);
#if defined(memset4)
- {
- int n4 = (instsize-OHDR_SIZE) / 4;
-
- memset4(__InstPtr(newobj)->i_instvars, 0, n4);
- }
+ {
+ int n4 = (instsize-OHDR_SIZE) / 4;
+
+ memset4(__InstPtr(newobj)->i_instvars, 0, n4);
+ }
#else
- memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
#endif
- RETURN ( newobj );
- break;
-
- case FLOATARRAY:
- instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
- instsize += nindexedinstvars * sizeof(float);
-
- __PROTECT_CONTEXT__
- __qNew(newobj, instsize); /* OBJECT ALLOCATION */
- __UNPROTECT_CONTEXT__
- if (newobj == nil) {
- break;
- }
- __InstPtr(newobj)->o_class = self;
- __qSTORE(newobj, self);
-
- op = __InstPtr(newobj)->i_instvars;
+ RETURN ( newobj );
+ break;
+
+ case FLOATARRAY:
+ instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
+ instsize += nindexedinstvars * sizeof(float);
+
+ __PROTECT_CONTEXT__
+ __qNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __UNPROTECT_CONTEXT__
+ if (newobj == nil) {
+ break;
+ }
+ __InstPtr(newobj)->o_class = self;
+ __qSTORE(newobj, self);
+
+ op = __InstPtr(newobj)->i_instvars;
#if defined(__FLOAT0_IS_INT0) /* knowin that float 0.0 is all-zeros */
# if defined(memset4)
- {
- int n4 = (instsize-OHDR_SIZE) / 4;
-
- memset4(__InstPtr(newobj)->i_instvars, 0, n4);
- }
+ {
+ int n4 = (instsize-OHDR_SIZE) / 4;
+
+ memset4(__InstPtr(newobj)->i_instvars, 0, n4);
+ }
# else
- memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
# endif
#else
- while (nInstVars--)
- *op++ = nil;
- fp = (float *)op;
- while (nindexedinstvars--)
- *fp++ = 0.0;
+ while (nInstVars--)
+ *op++ = nil;
+ fp = (float *)op;
+ while (nindexedinstvars--)
+ *fp++ = 0.0;
#endif
- RETURN ( newobj );
- break;
-
- case DOUBLEARRAY:
- instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
+ RETURN ( newobj );
+ break;
+
+ case DOUBLEARRAY:
+ instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
#ifdef __NEED_DOUBLE_ALIGN
- instsize = ((instsize-1) + __DOUBLE_ALIGN) & ~(__DOUBLE_ALIGN-1);
+ instsize = ((instsize-1) + __DOUBLE_ALIGN) & ~(__DOUBLE_ALIGN-1);
#endif
- instsize += nindexedinstvars * sizeof(double);
-
- __PROTECT_CONTEXT__
- __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
- __UNPROTECT_CONTEXT__
- if (newobj == nil) {
- break;
- }
- __InstPtr(newobj)->o_class = self;
- __qSTORE(newobj, self);
+ instsize += nindexedinstvars * sizeof(double);
+
+ __PROTECT_CONTEXT__
+ __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __UNPROTECT_CONTEXT__
+ if (newobj == nil) {
+ break;
+ }
+ __InstPtr(newobj)->o_class = self;
+ __qSTORE(newobj, self);
#if defined(__DOUBLE0_IS_INT0) /* knowin that double 0.0 is all-zeros */
# ifdef memset4
- {
- int n4 = (instsize-OHDR_SIZE) / 4;
-
- memset4(__InstPtr(newobj)->i_instvars, 0, n4);
- }
+ {
+ int n4 = (instsize-OHDR_SIZE) / 4;
+
+ memset4(__InstPtr(newobj)->i_instvars, 0, n4);
+ }
# else
- memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
# endif
#else
- op = __InstPtr(newobj)->i_instvars;
- while (nInstVars--)
- *op++ = nil;
+ op = __InstPtr(newobj)->i_instvars;
+ while (nInstVars--)
+ *op++ = nil;
# ifdef __NEED_DOUBLE_ALIGN
- /*
- * care for double alignment
- * add filler.
- */
- if ((INT)op & (__DOUBLE_ALIGN-1)) {
- *op++ = nil;
- }
+ /*
+ * care for double alignment
+ * add filler.
+ */
+ if ((INT)op & (__DOUBLE_ALIGN-1)) {
+ *op++ = nil;
+ }
# endif
- dp = (double *)op;
- while (nindexedinstvars--)
- *dp++ = 0.0;
+ dp = (double *)op;
+ while (nindexedinstvars--)
+ *dp++ = 0.0;
#endif
- RETURN ( newobj );
- break;
-
- case WKPOINTERARRAY:
- case POINTERARRAY:
- nInstVars += nindexedinstvars;
- instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
- __PROTECT_CONTEXT__
- __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
- __UNPROTECT_CONTEXT__
- if (newobj == nil) {
- break;
- }
- __InstPtr(newobj)->o_class = self;
- __qSTORE(newobj, self);
+ RETURN ( newobj );
+ break;
+
+ case WKPOINTERARRAY:
+ case POINTERARRAY:
+ nInstVars += nindexedinstvars;
+ instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
+ __PROTECT_CONTEXT__
+ __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __UNPROTECT_CONTEXT__
+ if (newobj == nil) {
+ break;
+ }
+ __InstPtr(newobj)->o_class = self;
+ __qSTORE(newobj, self);
#if defined(memset4) && defined(FAST_ARRAY_MEMSET4) || defined(FAST_MEMSET4)
- memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
+ memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
#else
- /*
- * knowing that nil is 0
- */
+ /*
+ * knowing that nil is 0
+ */
# ifdef sparc
# define FAST_ARRAY_MEMSET_DOUBLES_UNROLLED
# endif
# if defined(FAST_ARRAY_MEMSET_DOUBLES_UNROLLED)
- op = __InstPtr(newobj)->i_instvars;
- if (nInstVars > 8) {
- *op++ = nil; /* for alignment */
- nInstVars--;
- while (nInstVars >= 8) {
- *(double *)op = 0.0;
- ((double *)op)[1] = 0.0;
- ((double *)op)[2] = 0.0;
- ((double *)op)[3] = 0.0;
- op += 8;
- nInstVars -= 8;
- }
- }
- while (nInstVars) {
- *op++ = 0;
- nInstVars--;
- }
+ op = __InstPtr(newobj)->i_instvars;
+ if (nInstVars > 8) {
+ *op++ = nil; /* for alignment */
+ nInstVars--;
+ while (nInstVars >= 8) {
+ *(double *)op = 0.0;
+ ((double *)op)[1] = 0.0;
+ ((double *)op)[2] = 0.0;
+ ((double *)op)[3] = 0.0;
+ op += 8;
+ nInstVars -= 8;
+ }
+ }
+ while (nInstVars) {
+ *op++ = 0;
+ nInstVars--;
+ }
# else
# if defined(FAST_ARRAY_MEMSET_LONGLONG_UNROLLED)
- op = __InstPtr(newobj)->i_instvars;
- if (nInstVars > 8) {
- *op++ = nil; /* for alignment */
- nInstVars--;
- while (nInstVars >= 8) {
- *(long long *)op = 0;
- ((long long *)op)[1] = 0;
- ((long long *)op)[2] = 0;
- ((long long *)op)[3] = 0;
- op += 8;
- nInstVars -= 8;
- }
- }
- while (nInstVars) {
- *op++ = 0;
- nInstVars--;
- }
+ op = __InstPtr(newobj)->i_instvars;
+ if (nInstVars > 8) {
+ *op++ = nil; /* for alignment */
+ nInstVars--;
+ while (nInstVars >= 8) {
+ *(long long *)op = 0;
+ ((long long *)op)[1] = 0;
+ ((long long *)op)[2] = 0;
+ ((long long *)op)[3] = 0;
+ op += 8;
+ nInstVars -= 8;
+ }
+ }
+ while (nInstVars) {
+ *op++ = 0;
+ nInstVars--;
+ }
# else
# if defined(FAST_ARRAY_MEMSET)
- memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
# else
- op = __InstPtr(newobj)->i_instvars;
- while (nInstVars >= 8) {
- nInstVars -= 8;
- op[0] = nil; op[1] = nil;
- op[2] = nil; op[3] = nil;
- op[4] = nil; op[5] = nil;
- op[6] = nil; op[7] = nil;
- op += 8;
- }
- while (nInstVars--)
- *op++ = nil;
+ op = __InstPtr(newobj)->i_instvars;
+ while (nInstVars >= 8) {
+ nInstVars -= 8;
+ op[0] = nil; op[1] = nil;
+ op[2] = nil; op[3] = nil;
+ op[4] = nil; op[5] = nil;
+ op[6] = nil; op[7] = nil;
+ op += 8;
+ }
+ while (nInstVars--)
+ *op++ = nil;
# endif
# endif
# endif
#endif
- RETURN ( newobj );
- break;
-
- default:
- /*
- * new:n for non-variable classes only allowed if
- * n == 0
- */
- if (nindexedinstvars == 0) {
- instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
- __PROTECT_CONTEXT__
- __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
- __UNPROTECT_CONTEXT__
- if (newobj == nil) {
- break;
- }
- __InstPtr(newobj)->o_class = self;
- __qSTORE(newobj, self);
-
- if (nInstVars) {
+ RETURN ( newobj );
+ break;
+
+ default:
+ /*
+ * new:n for non-variable classes only allowed if
+ * n == 0
+ */
+ if (nindexedinstvars == 0) {
+ instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
+ __PROTECT_CONTEXT__
+ __qAlignedNew(newobj, instsize); /* OBJECT ALLOCATION */
+ __UNPROTECT_CONTEXT__
+ if (newobj == nil) {
+ break;
+ }
+ __InstPtr(newobj)->o_class = self;
+ __qSTORE(newobj, self);
+
+ if (nInstVars) {
#if defined(memset4) && defined(FAST_OBJECT_MEMSET4) || defined(FAST_MEMSET4)
- memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
+ memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
#else
# if defined(FAST_MEMSET)
- /*
- * knowing that nil is 0
- */
- memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+ /*
+ * knowing that nil is 0
+ */
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
# else
- op = __InstPtr(newobj)->i_instvars;
- do {
- *op++ = nil;
- } while (--nInstVars);
+ op = __InstPtr(newobj)->i_instvars;
+ do {
+ *op++ = nil;
+ } while (--nInstVars);
# endif
#endif
- }
- RETURN ( newobj );
- }
- break;
- }
- }
+ }
+ RETURN ( newobj );
+ }
+ break;
+ }
+ }
}
%}.
"
@@ -2703,26 +2699,26 @@
"
(anInteger isMemberOf:SmallInteger) ifFalse:[
- "
- the argument is either not an integer,
- or a LargeInteger (which means that its definitely too big)
- "
- self error:'argument to new: must be Integer' mayProceed:true.
- ^ nil
+ "
+ the argument is either not an integer,
+ or a LargeInteger (which means that its definitely too big)
+ "
+ self error:'argument to new: must be Integer' mayProceed:true.
+ ^ nil
].
(anInteger < 0) ifTrue:[
- "
- the argument is negative,
- "
- self error:'bad (negative) argument to new:'.
- ^ nil
+ "
+ the argument is negative,
+ "
+ self error:'bad (negative) argument to new:'.
+ ^ nil
].
self isVariable ifFalse:[
- "
- this class does not have any indexed instance variables
- "
- self error:'class has no indexed instvars - cannot create with new:'.
- ^ nil
+ "
+ this class does not have any indexed instance variables
+ "
+ self error:'class has no indexed instvars - cannot create with new:'.
+ ^ nil
].
"
memory allocation failed.
@@ -2742,7 +2738,7 @@
"
Rectangle
- decodeFromLiteralArray:#(Rectangle 10 10 100 100)
+ decodeFromLiteralArray:#(Rectangle 10 10 100 100)
"
"Modified: / 28.1.1998 / 17:40:30 / cg"
@@ -2779,10 +2775,10 @@
size := self sizeOfInst:anInteger.
(ObjectMemory checkForFastNew:size) ifFalse:[
- "
- incrementally collect garbage
- "
- ObjectMemory incrementalGC.
+ "
+ incrementally collect garbage
+ "
+ ObjectMemory incrementalGC.
].
^ self basicNew:anInteger
!
@@ -2794,13 +2790,13 @@
This is the reverse operation to 'storeOn:'.
WARNING: storeOn: does not handle circular references and multiple
- references to the same object.
- Use #storeBinary:/readBinaryFrom: for this."
+ references to the same object.
+ Use #storeBinary:/readBinaryFrom: for this."
^ self
- readFrom:aStream
- onError:[ self conversionErrorSignal
- raiseWith:aStream errorString:'conversion error for: ' , self name ]
+ readFrom:aStream
+ onError:[ self conversionErrorSignal
+ raiseWith:aStream errorString:'conversion error for: ' , self name ]
"
|s|
@@ -2861,9 +2857,9 @@
Behavior>>readFrom: and Behavior>>readFrom:onError:"
^ self
- readFromString:aString
- onError:[ self conversionErrorSignal
- raiseErrorString:'expected: ' , self name ]
+ readFromString:aString
+ onError:[ self conversionErrorSignal
+ raiseErrorString:'expected: ' , self name ]
"
Integer readFromString:'12345678901234567890'
@@ -2884,10 +2880,10 @@
str := ReadStream on:aString.
val := self readFrom:str onError:[^ exceptionBlock value].
str atEnd ifFalse:[
- str skipSeparators.
- str atEnd ifFalse:[
- ^ exceptionBlock value
- ]
+ str skipSeparators.
+ str atEnd ifFalse:[
+ ^ exceptionBlock value
+ ]
].
^ val
@@ -2948,13 +2944,13 @@
<resource: #programImage>
self isLoaded ifFalse:[
- ^ #autoloadedClassBrowserIcon
+ ^ #autoloadedClassBrowserIcon
].
(self isBrowserStartable) ifTrue:[
- self isVisualStartable ifTrue:[
- ^ #visualStartableClassBrowserIcon
- ].
- ^ #startableClassBrowserIcon
+ self isVisualStartable ifTrue:[
+ ^ #visualStartableClassBrowserIcon
+ ].
+ ^ #startableClassBrowserIcon
].
"/ give ruby and other special metaclasses a chance to provide their own icon...
@@ -2994,7 +2990,7 @@
"/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
"/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
(aGCOrStream isStream) ifFalse:[
- ^ super displayOn:aGCOrStream
+ ^ super displayOn:aGCOrStream
].
aGCOrStream nextPutAll:self name
@@ -3027,12 +3023,12 @@
This method is for special uses only - there will be no recompilation
and no change record written here;
Warning:
- the instSize slot specifies the size of my instances and affects
- both the VM's and the class library's behavior.
- It is required to be consistent and correct.
- Setting it to a wrong value may severely affect the system's operation,
- and even crash the system (in the garbage collector).
- Do NOT use it, unless you really know what you are doing."
+ the instSize slot specifies the size of my instances and affects
+ both the VM's and the class library's behavior.
+ It is required to be consistent and correct.
+ Setting it to a wrong value may severely affect the system's operation,
+ and even crash the system (in the garbage collector).
+ Do NOT use it, unless you really know what you are doing."
instSize := aNumber
!
@@ -3050,16 +3046,16 @@
|dict oldMethod|
newMethod isNil ifTrue:[
- self error:'invalid method'.
+ self error:'invalid method'.
].
dict := self methodDictionary.
oldMethod := dict at:aSelector ifAbsent:nil.
(Smalltalk
- changeRequest:#methodInClass
- with:(Array with:self with:aSelector with:oldMethod)) ifFalse:[
- ^ false
+ changeRequest:#methodInClass
+ with:(Array with:self with:aSelector with:oldMethod)) ifFalse:[
+ ^ false
].
self setMethodDictionary:(dict at:aSelector putOrAppend:newMethod).
@@ -3084,19 +3080,19 @@
"/ No other classes instances are allowed.
dict class ~~ MethodDictionary ifTrue:[
- methodDictionary := MethodDictionary withAll:dict.
- methodDictionary isNil ifTrue:[
-
- "/ refuse to do this
- "/ (can only happen in case of memory allocation trouble,
- "/ where the allocation failed and some exception handler returned
- "/ nil ...)
-
- self error:'cannot set methodDictionary to nil' mayProceed:true.
- ^ self.
- ]
+ methodDictionary := MethodDictionary withAll:dict.
+ methodDictionary isNil ifTrue:[
+
+ "/ refuse to do this
+ "/ (can only happen in case of memory allocation trouble,
+ "/ where the allocation failed and some exception handler returned
+ "/ nil ...)
+
+ self error:'cannot set methodDictionary to nil' mayProceed:true.
+ ^ self.
+ ]
] ifFalse:[
- methodDictionary := dict.
+ methodDictionary := dict.
].
^ self.
@@ -3157,10 +3153,10 @@
superclass := self superclass.
(superclass notNil) ifTrue:[
- superclass addAllClassVarNamesTo:aCollection
+ superclass addAllClassVarNamesTo:aCollection
].
(classvars := self classVariableString) notNil ifTrue:[
- aCollection addAll:(classvars asCollectionOfWords).
+ aCollection addAll:(classvars asCollectionOfWords).
].
^ aCollection
@@ -3176,7 +3172,7 @@
superclass := self superclass.
(superclass notNil) ifTrue:[
- superclass addAllInstVarNamesTo:aCollection
+ superclass addAllInstVarNamesTo:aCollection
].
aCollection addAll:self instVarNames.
^ aCollection
@@ -3191,8 +3187,8 @@
"add all of my private classes to aCollection"
self privateClassesDo:[:aPrivateClass |
- aCollection add:aPrivateClass.
- aPrivateClass addAllPrivateClassesTo:aCollection
+ aCollection add:aPrivateClass.
+ aPrivateClass addAllPrivateClassesTo:aCollection
].
!
@@ -3212,9 +3208,9 @@
has to provide a method object for message sends."
lookupObject ~~ aMethodLookupObject ifTrue:[
- lookupObject := aMethodLookupObject.
- ObjectMemory flushCachesFor: self.
- self allSubclassesDo:[:cls|ObjectMemory flushCachesFor: cls]
+ lookupObject := aMethodLookupObject.
+ ObjectMemory flushCachesFor: self.
+ self allSubclassesDo:[:cls|ObjectMemory flushCachesFor: cls]
]
"Modified: / 22-07-2010 / 18:10:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -3291,34 +3287,34 @@
"return the first part of the selector with which I was (can be) defined in my superclass"
self isVariable ifFalse:[
- ^ #'subclass:'
+ ^ #'subclass:'
].
self isBytes ifTrue:[
- ^ #'variableByteSubclass:'
+ ^ #'variableByteSubclass:'
].
self isLongs ifTrue:[
- ^ #'variableLongSubclass:'
+ ^ #'variableLongSubclass:'
].
self isFloats ifTrue:[
- ^ #'variableFloatSubclass:'
+ ^ #'variableFloatSubclass:'
].
self isDoubles ifTrue:[
- ^ #'variableDoubleSubclass:'
+ ^ #'variableDoubleSubclass:'
].
self isWords ifTrue:[
- ^ #'variableWordSubclass:'
+ ^ #'variableWordSubclass:'
].
self isSignedWords ifTrue:[
- ^ #'variableSignedWordSubclass:'
+ ^ #'variableSignedWordSubclass:'
].
self isSignedLongs ifTrue:[
- ^ #'variableSignedLongSubclass:'
+ ^ #'variableSignedLongSubclass:'
].
self isSignedLongLongs ifTrue:[
- ^ #'variableSignedLongLongSubclass:'
+ ^ #'variableSignedLongLongSubclass:'
].
self isLongLongs ifTrue:[
- ^ #'variableLongLongSubclass:'
+ ^ #'variableLongLongSubclass:'
].
^ #'variableSubclass:'
!
@@ -3578,9 +3574,9 @@
newColl := OrderedCollection new.
self allSubclassesDo:[:aClass |
- (aClass isRealNameSpace) ifFalse:[
- newColl add:aClass
- ]
+ (aClass isRealNameSpace) ifFalse:[
+ newColl add:aClass
+ ]
].
^ newColl
@@ -3600,9 +3596,9 @@
newColl := OrderedCollection new.
self allSubclassesInOrderDo:[:aClass |
- (aClass isRealNameSpace) ifFalse:[
- newColl add:aClass
- ]
+ (aClass isRealNameSpace) ifFalse:[
+ newColl add:aClass
+ ]
].
^ newColl
@@ -3620,12 +3616,12 @@
theSuperClass := self superclass.
theSuperClass isNil ifTrue:[
- ^ #()
+ ^ #()
].
aCollection := OrderedCollection new.
[theSuperClass notNil] whileTrue:[
- aCollection add:theSuperClass.
- theSuperClass := theSuperClass superclass
+ aCollection add:theSuperClass.
+ theSuperClass := theSuperClass superclass
].
^ aCollection
@@ -3711,19 +3707,23 @@
%{ /* NOCONTEXT */
OBJ __theClass = __INST(superclass);
+ int n = 0;
while (__theClass != nil) {
- if (__theClass == aClass) {
- RETURN(true);
- }
- if (__isBehaviorLike(__theClass)) {
- __theClass = __ClassInstPtr(__theClass)->c_superclass;
- } else {
- __theClass = nil;
- }
+ if (__theClass == aClass) {
+ RETURN(true);
+ }
+ if (__isBehaviorLike(__theClass)) {
+ __theClass = __ClassInstPtr(__theClass)->c_superclass;
+ } else {
+ __theClass = nil;
+ }
+ if (++n > 100000) goto vmError;
}
RETURN (false);
+vmError: ;
%}.
+ VMInternalError raiseErrorString:'deep inheritance'.
"/ |theClass|
"/
@@ -3756,7 +3756,7 @@
newColl := OrderedCollection new.
self subclassesDo:[:aClass |
- newColl add:aClass
+ newColl add:aClass
].
^ newColl.
!
@@ -3801,7 +3801,7 @@
coll := OrderedCollection new.
self withAllSuperclassesDo:[:cls |
- coll add:cls
+ coll add:cls
].
^ coll
@@ -3836,7 +3836,7 @@
coll := OrderedCollection new:100.
self allInstancesDo:[:anObject |
- coll add:anObject
+ coll add:anObject
].
^ coll
@@ -3856,7 +3856,7 @@
coll := self allInstances.
doWeakly ifTrue:[
- coll := WeakArray withAll:coll
+ coll := WeakArray withAll:coll
].
^ coll
@@ -3871,9 +3871,9 @@
coll := OrderedCollection new:100.
self allSubInstancesDo:[:anObject |
- (anObject isKindOf:self) ifTrue:[
- coll add:anObject
- ]
+ (anObject isKindOf:self) ifTrue:[
+ coll add:anObject
+ ]
].
^ coll
@@ -3920,9 +3920,9 @@
count := 0.
ObjectMemory allObjectsDo:[:anObject |
- (anObject isKindOf:self) ifTrue:[
- count := count + 1
- ]
+ (anObject isKindOf:self) ifTrue:[
+ count := count + 1
+ ]
].
^ count
@@ -3940,9 +3940,9 @@
instances of SmallInteger and UndefinedObject"
ObjectMemory allObjectsDo:[:anObject |
- (anObject isKindOf:self) ifTrue:[
- ^ true
- ]
+ (anObject isKindOf:self) ifTrue:[
+ ^ true
+ ]
].
^ false
@@ -3976,7 +3976,7 @@
"/ ].
ObjectMemory allInstancesOf:self do:[:anObject |
- ^ true
+ ^ true
].
^ false
@@ -4013,7 +4013,7 @@
"/ ].
ObjectMemory allInstancesOf:self do:[:anObject |
- count := count + 1
+ count := count + 1
].
^ count
@@ -4033,13 +4033,13 @@
element. For pointer indexed classes, 0 is returned"
self isBitsExtended ifTrue:[
- self isBytes ifTrue:[^ 1].
- self isWords ifTrue:[^ 2].
- self isSignedWords ifTrue:[^ 2].
- self isLongs ifTrue:[^ 4].
- self isSignedLongs ifTrue:[^ 4].
- self isLongLongs ifTrue:[^ 8].
- self isSignedLongLongs ifTrue:[^ 8].
+ self isBytes ifTrue:[^ 1].
+ self isWords ifTrue:[^ 2].
+ self isSignedWords ifTrue:[^ 2].
+ self isLongs ifTrue:[^ 4].
+ self isSignedLongs ifTrue:[^ 4].
+ self isLongLongs ifTrue:[^ 8].
+ self isSignedLongLongs ifTrue:[^ 8].
].
self isFloats ifTrue:[^ 4].
self isDoubles ifTrue:[^ 8].
@@ -4067,7 +4067,7 @@
what = (INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK);
RETURN (( (what == __MASKSMALLINT(BYTEARRAY))
- || (what == __MASKSMALLINT(WORDARRAY))) ? true : false );
+ || (what == __MASKSMALLINT(WORDARRAY))) ? true : false );
%}.
^ self isBytes or:[self isWords]
!
@@ -4086,12 +4086,12 @@
what = (INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK);
RETURN (( (what == __MASKSMALLINT(BYTEARRAY))
- || (what == __MASKSMALLINT(WORDARRAY))
- || (what == __MASKSMALLINT(SWORDARRAY))
- || (what == __MASKSMALLINT(LONGARRAY))
- || (what == __MASKSMALLINT(SLONGARRAY))
- || (what == __MASKSMALLINT(LONGLONGARRAY))
- || (what == __MASKSMALLINT(SLONGLONGARRAY))) ? true : false );
+ || (what == __MASKSMALLINT(WORDARRAY))
+ || (what == __MASKSMALLINT(SWORDARRAY))
+ || (what == __MASKSMALLINT(LONGARRAY))
+ || (what == __MASKSMALLINT(SLONGARRAY))
+ || (what == __MASKSMALLINT(LONGLONGARRAY))
+ || (what == __MASKSMALLINT(SLONGLONGARRAY))) ? true : false );
%}
!
@@ -4099,7 +4099,7 @@
"return true, if instances have indexed byte instance variables"
"this could also be defined as:
- ^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagBytes
+ ^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagBytes
"
%{ /* NOCONTEXT */
@@ -4111,7 +4111,7 @@
"return true, if instances have indexed double instance variables"
"this could also be defined as:
- ^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagDoubles
+ ^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagDoubles
"
%{ /* NOCONTEXT */
@@ -4123,7 +4123,7 @@
"return true, if instances do not have indexed instance variables"
"this could also be defined as:
- ^ self isVariable not
+ ^ self isVariable not
"
%{ /* NOCONTEXT */
@@ -4137,7 +4137,7 @@
"return true, if instances have indexed float instance variables"
"this could also be defined as:
- ^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagFloats
+ ^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagFloats
"
%{ /* NOCONTEXT */
@@ -4154,7 +4154,7 @@
what = (INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK);
RETURN (( (what == __MASKSMALLINT(FLOATARRAY))
- || (what == __MASKSMALLINT(DOUBLEARRAY))) ? true : false );
+ || (what == __MASKSMALLINT(DOUBLEARRAY))) ? true : false );
%}.
^ self isFloats or:[self isDoubles]
@@ -4198,24 +4198,24 @@
flags = __intVal(__INST(flags)) & ARRAYMASK;
switch (flags) {
- default:
- /* normal objects */
- RETURN ( true );
-
- case BYTEARRAY:
- case WORDARRAY:
- case LONGARRAY:
- case SWORDARRAY:
- case SLONGARRAY:
- case SLONGLONGARRAY:
- case LONGLONGARRAY:
- case FLOATARRAY:
- case DOUBLEARRAY:
- RETURN (false );
-
- case WKPOINTERARRAY:
- /* what about those ? */
- RETURN (true );
+ default:
+ /* normal objects */
+ RETURN ( true );
+
+ case BYTEARRAY:
+ case WORDARRAY:
+ case LONGARRAY:
+ case SWORDARRAY:
+ case SLONGARRAY:
+ case SLONGLONGARRAY:
+ case LONGLONGARRAY:
+ case FLOATARRAY:
+ case DOUBLEARRAY:
+ RETURN (false );
+
+ case WKPOINTERARRAY:
+ /* what about those ? */
+ RETURN (true );
}
%}
!
@@ -4251,7 +4251,7 @@
"return true, if instances have indexed instance variables"
"this could also be defined as:
- ^ (flags bitAnd:(Behavior maskIndexType)) ~~ 0
+ ^ (flags bitAnd:(Behavior maskIndexType)) ~~ 0
"
%{ /* NOCONTEXT */
@@ -4269,7 +4269,7 @@
flags = __intVal(__INST(flags)) & ARRAYMASK;
if (flags == WKPOINTERARRAY) {
- RETURN ( true );
+ RETURN ( true );
}
%}.
^ false
@@ -4279,7 +4279,7 @@
"return true, if instances have indexed short instance variables"
"this could also be defined as:
- ^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagWords
+ ^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagWords
"
%{ /* NOCONTEXT */
@@ -4367,7 +4367,7 @@
superclass := self superclass.
superclass notNil ifTrue:[
- ^ superclass allSelectors addAll:(self selectors); yourself.
+ ^ superclass allSelectors addAll:(self selectors); yourself.
].
^ self selectors asNewIdentitySet
@@ -4438,8 +4438,8 @@
dict := self methodDictionary.
dict isNil ifTrue:[
- ('Behavior [warning]: nil methodDictionary in ' , self name printString) errorPrintCR.
- ^ exceptionValue value
+ ('Behavior [warning]: nil methodDictionary in ' , self name printString) errorPrintCR.
+ ^ exceptionValue value
].
^ dict at:aSelector ifAbsent:exceptionValue
@@ -4491,8 +4491,8 @@
dict := self methodDictionary.
dict isNil ifTrue:[
- ('Behavior [warning]: nil methodDictionary in ' , self name printString) errorPrintCR.
- ^ exceptionValue value
+ ('Behavior [warning]: nil methodDictionary in ' , self name printString) errorPrintCR.
+ ^ exceptionValue value
].
"Quick check: look into method dictionary"
mth := dict at: name asSymbol ifAbsent:nil.
@@ -4500,8 +4500,8 @@
"Slow search..."
dict do: [:each|
- (each isSynthetic not and:[each name = name])
- ifTrue:[^each]
+ (each isSynthetic not and:[each name = name])
+ ifTrue:[^each]
].
^exceptionValue value
@@ -4547,14 +4547,14 @@
This is semantically equivalent to includesSelector: (which is ST/80/Squeak compatibility).
Caveat:
- This simply checks for the selector being present in the classes
- selector table - therefore, it does not care for ignoredMethods.
- (but: you should not use this method for protocol-testing, anyway).
+ This simply checks for the selector being present in the classes
+ selector table - therefore, it does not care for ignoredMethods.
+ (but: you should not use this method for protocol-testing, anyway).
Hint:
- Dont use this method to check if someone responds to a message -
- use #canUnderstand: on the class or #respondsTo: on the instance
- to do this."
+ Dont use this method to check if someone responds to a message -
+ use #canUnderstand: on the class or #respondsTo: on the instance
+ to do this."
^ self includesSelector:aSelector
@@ -4587,14 +4587,14 @@
This is semantically equivalent to implements: (ST/80/Squeak compatibility).
Hint:
- Don't use this method to check if someone responds to a message -
- use #canUnderstand: on the class or #respondsTo: on the instance
- to do this.
+ Don't use this method to check if someone responds to a message -
+ use #canUnderstand: on the class or #respondsTo: on the instance
+ to do this.
Caveat:
- This simply checks for the selector being present in the classes
- selector table - therefore, it does not care for ignoredMethods.
- (but: you should not use this method for protocol-testing, anyway)."
+ This simply checks for the selector being present in the classes
+ selector table - therefore, it does not care for ignoredMethods.
+ (but: you should not use this method for protocol-testing, anyway)."
^ self methodDictionary includesIdenticalKey:aSelector
@@ -4626,28 +4626,28 @@
"JV @ 2010-08-22: Rewritten to respect lookup object."
(l := self lookupObject) notNil ifTrue:[
- ^ (l
- lookupMethodForSelector:aSelector
- directedTo:self
- for: nil "Fake receiver"
- withArguments: nil "Fake arguments"
- from: thisContext methodHome sender
- ilc: nil "fake ilc")
+ ^ (l
+ lookupMethodForSelector:aSelector
+ directedTo:self
+ for: nil "Fake receiver"
+ withArguments: nil "Fake arguments"
+ from: thisContext methodHome sender
+ ilc: nil "fake ilc")
].
cls := self.
[
- m := cls compiledMethodAt:aSelector.
- m notNil ifTrue:[^ m].
- cls hasMultipleSuperclasses ifTrue:[
- cls superclasses do:[:aSuperClass |
- m := aSuperClass lookupMethodFor:aSelector.
- m notNil ifTrue:[^ m].
- ].
- ^ nil
- ] ifFalse:[
- cls := cls superclass
- ]
+ m := cls compiledMethodAt:aSelector.
+ m notNil ifTrue:[^ m].
+ cls hasMultipleSuperclasses ifTrue:[
+ cls superclasses do:[:aSuperClass |
+ m := aSuperClass lookupMethodFor:aSelector.
+ m notNil ifTrue:[^ m].
+ ].
+ ^ nil
+ ] ifFalse:[
+ cls := cls superclass
+ ]
] doWhile:[cls notNil].
^ nil
!
@@ -4660,7 +4660,7 @@
cls := self whichClassIncludesSelector:aSelector.
cls notNil ifTrue:[
- ^ cls compiledMethodAt:aSelector
+ ^ cls compiledMethodAt:aSelector
].
^ nil
@@ -4698,8 +4698,8 @@
md := self methodDictionary.
md isNil ifTrue:[
- 'OOPS - nil methodDictionary' errorPrintCR.
- ^ nil
+ 'OOPS - nil methodDictionary' errorPrintCR.
+ ^ nil
].
^ md keyAtValue:aMethod ifAbsent:failBlock.
@@ -4737,18 +4737,18 @@
cls := self.
[cls notNil] whileTrue:[
- (cls includesSelector:aSelector) ifTrue:[^ cls].
- cls hasMultipleSuperclasses ifTrue:[
- cls superclasses do:[:aSuperClass |
- |implementingClass|
-
- implementingClass := aSuperClass whichClassIncludesSelector:aSelector.
- implementingClass notNil ifTrue:[^ implementingClass].
- ].
- ^ nil
- ] ifFalse:[
- cls := cls superclass
- ]
+ (cls includesSelector:aSelector) ifTrue:[^ cls].
+ cls hasMultipleSuperclasses ifTrue:[
+ cls superclasses do:[:aSuperClass |
+ |implementingClass|
+
+ implementingClass := aSuperClass whichClassIncludesSelector:aSelector.
+ implementingClass notNil ifTrue:[^ implementingClass].
+ ].
+ ^ nil
+ ] ifFalse:[
+ cls := cls superclass
+ ]
].
^ nil
@@ -4886,16 +4886,16 @@
superclass := self superclass.
s := ''.
superclass isNil ifTrue:[
- superInsts := 0
+ superInsts := 0
] ifFalse:[
- superInsts := superclass instSize
+ superInsts := superclass instSize
].
n := self instSize.
first := true.
superInsts+1 to:n do:[:i |
- first ifFalse:[s := s , ' '] ifTrue:[first := false].
-
- s := s , 'instvar' , i printString
+ first ifFalse:[s := s , ' '] ifTrue:[first := false].
+
+ s := s , 'instvar' , i printString
].
^ s
@@ -4925,15 +4925,15 @@
!
whichSelectorsAssign: instVarName
- "Answer a set of selectors whose methods write the argument, instVarName,
- as a named instance variable."
-
- ^ self whichSelectorsWrite: instVarName
+ "Answer a set of selectors whose methods write the argument, instVarName,
+ as a named instance variable."
+
+ ^ self whichSelectorsWrite: instVarName
!
whichSelectorsRead: instVarName
- "Answer a set of selectors whose methods read the argument, instVarName,
- as a named instance variable."
+ "Answer a set of selectors whose methods read the argument, instVarName,
+ as a named instance variable."
"/ | instVarIndex methodDict|
"/ instVarIndex := self allInstVarNames indexOf: instVarName ifAbsent: [^Set new].
@@ -4941,10 +4941,10 @@
"/ ^methodDict keys select: [:sel | (methodDict at: sel)
"/ readsField: instVarIndex]
- | methodDict |
- methodDict := self methodDictionary.
- ^ methodDict keys
- select: [:sel | (methodDict at: sel) readsInstVar: instVarName]
+ | methodDict |
+ methodDict := self methodDictionary.
+ ^ methodDict keys
+ select: [:sel | (methodDict at: sel) readsInstVar: instVarName]
"Modified: / 23-07-2012 / 11:22:04 / cg"
!
@@ -4957,9 +4957,9 @@
setOfSelectors := IdentitySet new.
self methodDictionary keysAndValuesDo:[:sel :mthd |
- (mthd referencesLiteral:someLiteralConstant) ifTrue:[
- setOfSelectors add:sel
- ].
+ (mthd referencesLiteral:someLiteralConstant) ifTrue:[
+ setOfSelectors add:sel
+ ].
].
^ setOfSelectors
@@ -5002,18 +5002,18 @@
!
whichSelectorsWrite: instVarName
- "Answer a set of selectors whose methods write the argument, instVarName,
- as a named instance variable."
+ "Answer a set of selectors whose methods write the argument, instVarName,
+ as a named instance variable."
"/ | instVarIndex methodDict |
"/ instVarIndex := self allInstVarNames indexOf: instVarName ifAbsent: [^Set new].
"/ methodDict := self methodDictionary.
"/ ^methodDict keys select: [:sel | (methodDict at: sel)
"/ writesField: instVarIndex]
- | methodDict |
- methodDict := self methodDictionary.
- ^ methodDict keys
- select: [:sel | (methodDict at: sel) writesInstVar: instVarName]
+ | methodDict |
+ methodDict := self methodDictionary.
+ ^ methodDict keys
+ select: [:sel | (methodDict at: sel) writesInstVar: instVarName]
"Modified: / 23-07-2012 / 11:21:17 / cg"
! !
@@ -5056,10 +5056,10 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.355 2014-02-14 16:35:05 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.356 2014-02-17 10:28:38 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.355 2014-02-14 16:35:05 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.356 2014-02-17 10:28:38 cg Exp $'
! !