--- a/Behavior.st Sat Apr 25 06:43:41 2015 +0200
+++ b/Behavior.st Mon Apr 27 06:43:29 2015 +0200
@@ -2,7 +2,7 @@
"
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
@@ -31,7 +31,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
@@ -76,25 +76,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
"
!
@@ -103,14 +103,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
@@ -140,9 +140,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.
@@ -176,111 +176,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:
-----------------------------
@@ -289,11 +289,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,
@@ -320,10 +320,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
"
@@ -349,7 +349,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_ALIENPOINTERS );
+#else
RETURN ( __mkSmallInteger(ALIENPOINTERS) );
+#endif
%}
!
@@ -361,7 +365,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_BEHAVIOR_INSTS );
+#else
RETURN ( __mkSmallInteger(BEHAVIOR_INSTS) );
+#endif
%}
"consistency check:
@@ -375,20 +383,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
+ ]
]
]
"
@@ -403,7 +411,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_BLOCK_INSTS );
+#else
RETURN ( __mkSmallInteger(BLOCK_INSTS) );
+#endif
%}
!
@@ -415,7 +427,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_BCONTEXT_INSTS );
+#else
RETURN ( __mkSmallInteger(BCONTEXT_INSTS) );
+#endif
%}
!
@@ -429,7 +445,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_BLOCKLIKE_INSTS );
+#else
RETURN ( __mkSmallInteger(BLOCKLIKE_INSTS) );
+#endif
%}
!
@@ -442,7 +462,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_BYTEARRAY );
+#else
RETURN ( __mkSmallInteger(BYTEARRAY) );
+#endif
%}
"
Behavior flagBytes
@@ -457,7 +481,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_CONTEXT_INSTS );
+#else
RETURN ( __mkSmallInteger(CONTEXT_INSTS) );
+#endif
%}
!
@@ -470,7 +498,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_DOUBLEARRAY );
+#else
RETURN ( __mkSmallInteger(DOUBLEARRAY) );
+#endif
%}
"
Behavior flagDoubles
@@ -489,7 +521,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_EXTERNALBYTES_INSTS );
+#else
RETURN ( __mkSmallInteger(EXTERNALBYTES_INSTS) );
+#endif
%}
!
@@ -501,7 +537,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_FLOAT_INSTS );
+#else
RETURN ( __mkSmallInteger(FLOAT_INSTS) );
+#endif
%}
!
@@ -514,7 +554,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_FLOATARRAY );
+#else
RETURN ( __mkSmallInteger(FLOATARRAY) );
+#endif
%}
"
Behavior flagFloats
@@ -524,50 +568,86 @@
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 */
+#ifdef __SCHTEAM__
if (aSymbol == @symbol(float)) {
- RETURN ( __mkSmallInteger(FLOATARRAY) );
+ return __c__._RETURN ( STClass.FLAG_FLOATARRAY );
}
if (aSymbol == @symbol(double)) {
- RETURN ( __mkSmallInteger(DOUBLEARRAY) );
+ return __c__._RETURN ( STClass.FLAG_DOUBLEARRAY );
}
if (aSymbol == @symbol(long)) {
- RETURN ( __mkSmallInteger(LONGARRAY) );
+ return __c__._RETURN ( STClass.FLAG_LONGARRAY );
}
if (aSymbol == @symbol(longLong)) {
- RETURN ( __mkSmallInteger(LONGLONGARRAY) );
+ return __c__._RETURN ( STClass.FLAG_LONGLONGARRAY );
}
if (aSymbol == @symbol(word)) {
- RETURN ( __mkSmallInteger(WORDARRAY) );
+ return __c__._RETURN ( STClass.FLAG_WORDARRAY );
}
if (aSymbol == @symbol(signedWord)) {
- RETURN ( __mkSmallInteger(SWORDARRAY) );
+ return __c__._RETURN ( STClass.FLAG_SWORDARRAY );
}
if (aSymbol == @symbol(signedLong)) {
- RETURN ( __mkSmallInteger(SLONGARRAY) );
+ return __c__._RETURN ( STClass.FLAG_SLONGARRAY );
}
if (aSymbol == @symbol(signedLongLong)) {
- RETURN ( __mkSmallInteger(SLONGLONGARRAY) );
+ return __c__._RETURN ( STClass.FLAG_SLONGLONGARRAY );
}
if ((aSymbol == @symbol(byte)) || (aSymbol == @symbol(bytes))) {
- RETURN ( __mkSmallInteger(BYTEARRAY) );
+ return __c__._RETURN ( STClass.FLAG_BYTEARRAY );
}
if (aSymbol == @symbol(objects)) {
- RETURN ( __mkSmallInteger(POINTERARRAY) );
+ return __c__._RETURN ( STClass.FLAG_POINTERARRAY );
}
if ((aSymbol == @symbol(weakObjects)) || (aSymbol == @symbol(weak))) {
- RETURN ( __mkSmallInteger(WKPOINTERARRAY) );
+ return __c__._RETURN ( STClass.FLAG_WKPOINTERARRAY );
+ }
+#else
+ if (aSymbol == @symbol(float)) {
+ RETURN ( __mkSmallInteger(FLOATARRAY) );
+ }
+ if (aSymbol == @symbol(double)) {
+ RETURN ( __mkSmallInteger(DOUBLEARRAY) );
+ }
+ if (aSymbol == @symbol(long)) {
+ RETURN ( __mkSmallInteger(LONGARRAY) );
+ }
+ if (aSymbol == @symbol(longLong)) {
+ RETURN ( __mkSmallInteger(LONGLONGARRAY) );
+ }
+ if (aSymbol == @symbol(word)) {
+ RETURN ( __mkSmallInteger(WORDARRAY) );
}
+ if (aSymbol == @symbol(signedWord)) {
+ RETURN ( __mkSmallInteger(SWORDARRAY) );
+ }
+ if (aSymbol == @symbol(signedLong)) {
+ RETURN ( __mkSmallInteger(SLONGARRAY) );
+ }
+ if (aSymbol == @symbol(signedLongLong)) {
+ RETURN ( __mkSmallInteger(SLONGLONGARRAY) );
+ }
+ if ((aSymbol == @symbol(byte)) || (aSymbol == @symbol(bytes))) {
+ RETURN ( __mkSmallInteger(BYTEARRAY) );
+ }
+ if (aSymbol == @symbol(objects)) {
+ RETURN ( __mkSmallInteger(POINTERARRAY) );
+ }
+ if ((aSymbol == @symbol(weakObjects)) || (aSymbol == @symbol(weak))) {
+ RETURN ( __mkSmallInteger(WKPOINTERARRAY) );
+ }
+#endif
%}.
^ 0 "/ not indexed
@@ -582,7 +662,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_JARRAY_INSTS );
+#else
RETURN ( __mkSmallInteger(JARRAY_INSTS) );
+#endif
%}
!
@@ -594,7 +678,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_JCLASS_INSTS );
+#else
RETURN ( __mkSmallInteger(JCLASS_INSTS) );
+#endif
%}
!
@@ -606,7 +694,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_JMETHOD_INSTS );
+#else
RETURN ( __mkSmallInteger(JMETHOD_INSTS) );
+#endif
%}
!
@@ -619,7 +711,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_LONGLONGARRAY );
+#else
RETURN ( __mkSmallInteger(LONGLONGARRAY) );
+#endif
%}
"
Behavior flagLongLongs
@@ -635,7 +731,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_LONGARRAY );
+#else
RETURN ( __mkSmallInteger(LONGARRAY) );
+#endif
%}
"
Behavior flagLongs
@@ -650,7 +750,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_METAMETHOD_INSTS );
+#else
RETURN ( __mkSmallInteger(METAMETHOD_INSTS) );
+#endif
%}
!
@@ -662,7 +766,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_METHOD_INSTS );
+#else
RETURN ( __mkSmallInteger(METHOD_INSTS) );
+#endif
%}
!
@@ -674,7 +782,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_NONOBJECT_INSTS );
+#else
RETURN ( __mkSmallInteger(NONOBJECT_INSTS) );
+#endif
%}
!
@@ -695,7 +807,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_POINTERARRAY );
+#else
RETURN ( __mkSmallInteger(POINTERARRAY) );
+#endif
%}
"
Behavior flagPointers
@@ -719,7 +835,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_SLONGLONGARRAY );
+#else
RETURN ( __mkSmallInteger(SLONGLONGARRAY) );
+#endif
%}
"
Behavior flagSignedLongLongs
@@ -735,7 +855,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_SLONGARRAY );
+#else
RETURN ( __mkSmallInteger(SLONGARRAY) );
+#endif
%}
"
Behavior flagSignedLongs
@@ -751,7 +875,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_SWORDARRAY );
+#else
RETURN ( __mkSmallInteger(SWORDARRAY) );
+#endif
%}
"
Behavior flagSignedWords
@@ -766,7 +894,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_SYMBOL_INSTS );
+#else
RETURN ( __mkSmallInteger(SYMBOL_INSTS) );
+#endif
%}
!
@@ -779,7 +911,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_WKPOINTERARRAY );
+#else
RETURN ( __mkSmallInteger(WKPOINTERARRAY) );
+#endif
%}
"
Behavior flagWeak
@@ -796,7 +932,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_WKPOINTERARRAY );
+#else
RETURN ( __mkSmallInteger(WKPOINTERARRAY) );
+#endif
%}
!
@@ -809,7 +949,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_WORDARRAY );
+#else
RETURN ( __mkSmallInteger(WORDARRAY) );
+#endif
%}
"
Behavior flagWords
@@ -822,7 +966,11 @@
%{ /* NOCONTEXT */
/* this is defined as a primitive to get defines from stc.h */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( STClass.FLAG_ARRAYMASK );
+#else
RETURN ( __mkSmallInteger(ARRAYMASK) );
+#endif
%}
! !
@@ -839,24 +987,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"
@@ -887,59 +1035,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
@@ -962,22 +1110,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.
@@ -996,10 +1144,10 @@
"/ ]
"/ ].
"/ ].
- ]
- ].
- ].
- (common isNil or:[common == Object]) ifTrue:[^ common].
+ ]
+ ].
+ ].
+ (common isNil or:[common == Object]) ifTrue:[^ common].
].
^ common
@@ -1027,16 +1175,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:'
)
!
@@ -1044,43 +1192,43 @@
"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:'
-
- "/ VSE
- #'variableByteSubclass:classVariableNames:poolDictionaries:category:'
+ #'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:'
+
+ "/ VSE
+ #'variableByteSubclass:classVariableNames:poolDictionaries:category:'
)
!
@@ -1178,7 +1326,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
@@ -1212,7 +1360,7 @@
findSelector:aSelector
"return an array filled with class and method, which would be executed if aSelector was sent to
- an instance of the receiver.
+ an instance of the receiver.
I.e. the selector arrays of the receiver
and all of its superclasses are searched for aSelector.
Return nil if instances do not understand aSelector"
@@ -1221,7 +1369,7 @@
mthd := self lookupMethodFor:aSelector.
mthd notNil ifTrue:[
- ^ { mthd mclass . mthd }
+ ^ { mthd mclass . mthd }
].
^ nil
@@ -1295,30 +1443,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
+ ]
].
"
@@ -1328,12 +1476,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
].
"
@@ -1382,10 +1530,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.
@@ -1440,9 +1588,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.
@@ -1456,11 +1604,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.
@@ -1481,8 +1629,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.
@@ -1512,8 +1660,8 @@
|md|
(md := self methodDictionary) isNil ifTrue:[
- 'oops - nil methodDictionary' errorPrintCR.
- ^ #()
+ 'oops - nil methodDictionary' errorPrintCR.
+ ^ #()
].
^ md keys
@@ -1581,7 +1729,7 @@
compiler
"return the compiler to use for this class.
OBSOLETE: This is the old ST/X interface, kept for migration.
- Don't use it - it will vanish."
+ Don't use it - it will vanish."
<resource:#obsolete>
@@ -1676,8 +1824,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"
@@ -1689,10 +1837,10 @@
Returns the new method or nil (on failure)."
^ self compilerClass
- compile:code
- forClass:self
- inCategory:methodCategory
- notifying:nil
+ compile:code
+ forClass:self
+ inCategory:methodCategory
+ notifying:nil
!
compile:code categorized:methodCategory notifying:requestor
@@ -1701,10 +1849,10 @@
Returns the new method or nil (on failure)."
^ self compilerClass
- compile:code
- forClass:self
- inCategory:methodCategory
- notifying:requestor
+ compile:code
+ forClass:self
+ inCategory:methodCategory
+ notifying:requestor
!
compile:code notifying:requestor
@@ -1713,9 +1861,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"
@@ -1744,15 +1892,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.
@@ -1761,23 +1909,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.
]
"
@@ -1785,19 +1933,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.
]
"
!
@@ -1863,7 +2011,7 @@
"evaluate aBlock for all of my instances"
ObjectMemory allInstancesOf:self do:[:anObject |
- aBlock value:anObject
+ aBlock value:anObject
]
"
@@ -1878,8 +2026,8 @@
owner := self owningClass.
[owner notNil] whileTrue:[
- aBlock value:owner.
- owner := owner owningClass.
+ aBlock value:owner.
+ owner := owner owningClass.
].
"
@@ -1902,9 +2050,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
+ ]
]
"
@@ -1916,8 +2064,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
@@ -1947,11 +2095,11 @@
"evaluate aBlock for all of my subclasses.
The subclasses are enumerated breath first (i.e. all of a classes superclasses
come before a class, which comes before any of its subclasses).
- However, within one inheritance level, there is no specific order,
+ However, within one inheritance level, 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."
|meta toDo cls|
@@ -1960,13 +2108,13 @@
toDo := OrderedCollection new.
toDo addAll:self theNonMetaclass subclasses.
[toDo notEmpty] whileTrue:[
- cls := toDo removeFirst.
- toDo addAll:cls subclasses.
- meta ifTrue:[
- aBlock value:cls class.
- ] ifFalse:[
- aBlock value:cls.
- ]
+ cls := toDo removeFirst.
+ toDo addAll:cls subclasses.
+ meta ifTrue:[
+ aBlock value:cls class.
+ ] ifFalse:[
+ aBlock value:cls.
+ ]
].
"/ self isMeta ifTrue:[
@@ -1995,16 +2143,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.
- n := n + 1.
- n > 100000 ifTrue:[ VMInternalError raiseErrorString:'deep inheritance' ].
+ aBlock value:theClass.
+ theClass := theClass superclass.
+ n := n + 1.
+ n > 100000 ifTrue:[ VMInternalError raiseErrorString:'deep inheritance' ].
]
"
@@ -2061,9 +2209,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
+ ]
]
!
@@ -2075,8 +2223,8 @@
cls := self.
[cls notNil] whileTrue:[
- (aBlock value: cls) ifTrue: [^ cls].
- cls := cls superclass.
+ (aBlock value: cls) ifTrue: [^ cls].
+ cls := cls superclass.
].
^ nil
@@ -2089,8 +2237,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
@@ -2151,10 +2299,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"
@@ -2194,6 +2342,9 @@
** Do not redefine this method in any class **"
%{ /* NOCONTEXT */
+#ifdef __SCHTEAM__
+ return __c__._RETURN( self.basicNew() );
+#else
REGISTER OBJ newobj;
REGISTER char *nextPtr;
unsigned INT instsize;
@@ -2217,114 +2368,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);
-#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;
-#else
- if (instsize & (__ALIGN__-1)) {
- __newNextPtr = (char *)newobj + (instsize & ~(__ALIGN__-1)) + __ALIGN__;
- } else {
- __newNextPtr = nextPtr;
- }
-#endif
+ __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;
+# else
+ 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) {
-#if defined(memset4) && defined(FAST_OBJECT_MEMSET4) || defined(FAST_MEMSET4)
- memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
-#else
- 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--;
- }
+ __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);
# 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--;
- }
-
+ 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--;
+ }
# 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--;
- }
+# 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--;
+ }
+
# else
-# if defined(FAST_MEMSET)
- memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
+# 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--;
+ }
# 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--;
- }
+# if defined(FAST_MEMSET)
+ 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--;
+ }
+# endif
# endif
# endif
# endif
# endif
-#endif
- }
- RETURN ( newobj );
+ }
+ RETURN ( newobj );
}
/*
@@ -2334,6 +2485,7 @@
newobj = __STX___new((INT)instsize);
__UNPROTECT_CONTEXT__
if (newobj != nil) goto ok;
+#endif /* NOT REACHED */
%}
.
"
@@ -2354,400 +2506,403 @@
** Do not redefine this method in any class **"
%{ /* NOCONTEXT */
-
+#ifdef __SCHTEAM__
+ return __c__._RETURN( self.basicNew() );
+#else
OBJ newobj;
unsigned INT nInstVars;
unsigned INT instsize;
INT nindexedinstvars;
unsigned INT flags;
-#if ! defined(FAST_ARRAY_MEMSET)
+# if ! defined(FAST_ARRAY_MEMSET)
REGISTER char *cp;
short *sp;
long *lp;
-#endif
+# endif
REGISTER OBJ *op;
float *fp;
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);
-
-#if defined(memset4) && defined(FAST_ARRAY_MEMSET4) || defined(FAST_MEMSET4)
- 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);
+ 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);
# 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';
+# if defined(FAST_ARRAY_MEMSET)
+ 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';
+# endif
# 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);
-
-#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);
-#else
-# if defined(FAST_ARRAY_MEMSET)
- /*
- * knowing that nil is 0
- */
- memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
+ 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);
# 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';
+# if defined(FAST_ARRAY_MEMSET)
+ /*
+ * 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';
+# endif
# 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);
-
-#if defined(FAST_ARRAY_MEMSET)
- /*
- * 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;
-#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);
-
-#if defined(memset4)
- /*
- * knowing that nil is 0
- */
- {
- int n4 = nInstVars + nindexedinstvars;
-
- memset4(__InstPtr(newobj)->i_instvars, 0, n4);
- }
-#else
+ 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;
- lp = (long *)op;
- while (nindexedinstvars--)
- *lp++ = 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);
+
+# if defined(memset4)
+ /*
+ * 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);
+# else
+ 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);
+
+# ifdef __NEED_LONGLONG_ALIGN
+ instsize = ((instsize-1) + __LONGLONG_ALIGN) & ~(__LONGLONG_ALIGN-1);
# endif
-#endif
- RETURN ( newobj );
- break;
-
- case LONGLONGARRAY:
- case SLONGLONGARRAY:
- instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
-
-#ifdef __NEED_LONGLONG_ALIGN
- 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);
-
-#if defined(memset4)
- {
- int n4 = (instsize-OHDR_SIZE) / 4;
-
- memset4(__InstPtr(newobj)->i_instvars, 0, n4);
- }
-#else
- 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;
-#if defined(__FLOAT0_IS_INT0) /* knowin that float 0.0 is all-zeros */
+ 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
-#else
- while (nInstVars--)
- *op++ = nil;
- fp = (float *)op;
- while (nindexedinstvars--)
- *fp++ = 0.0;
-#endif
- RETURN ( newobj );
- break;
-
- case DOUBLEARRAY:
- instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
-#ifdef __NEED_DOUBLE_ALIGN
- 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);
-
-#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);
- }
+ 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);
+ }
+# else
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+# endif
# else
- memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+ while (nInstVars--)
+ *op++ = nil;
+ fp = (float *)op;
+ while (nindexedinstvars--)
+ *fp++ = 0.0;
+# endif
+ RETURN ( newobj );
+ break;
+
+ case DOUBLEARRAY:
+ instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
+# ifdef __NEED_DOUBLE_ALIGN
+ instsize = ((instsize-1) + __DOUBLE_ALIGN) & ~(__DOUBLE_ALIGN-1);
# endif
-#else
- 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;
- }
-# endif
- 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);
-
-#if defined(memset4) && defined(FAST_ARRAY_MEMSET4) || defined(FAST_MEMSET4)
- memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
-#else
- /*
- * knowing that nil is 0
- */
-# ifdef sparc
-# define FAST_ARRAY_MEMSET_DOUBLES_UNROLLED
+ 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);
+ }
+# else
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+# endif
+# else
+ 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;
+ }
+# endif
+ dp = (double *)op;
+ while (nindexedinstvars--)
+ *dp++ = 0.0;
# 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--;
- }
+ 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);
# 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--;
- }
+ /*
+ * 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--;
+ }
# else
-# if defined(FAST_ARRAY_MEMSET)
- memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+# 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--;
+ }
# 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;
+# if defined(FAST_ARRAY_MEMSET)
+ 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;
+# endif
# 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) {
-#if defined(memset4) && defined(FAST_OBJECT_MEMSET4) || defined(FAST_MEMSET4)
- 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);
+ 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);
# else
- op = __InstPtr(newobj)->i_instvars;
- do {
- *op++ = nil;
- } while (--nInstVars);
+# if defined(FAST_MEMSET)
+ /*
+ * 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);
+# endif
# endif
-#endif
- }
- RETURN ( newobj );
- }
- break;
- }
- }
+ }
+ RETURN ( newobj );
+ }
+ break;
+ }
+ }
}
+#endif /* not SCHTEAM */
%}.
"
arrive here if something went wrong ...
@@ -2755,26 +2910,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.
@@ -2794,7 +2949,7 @@
"
Rectangle
- decodeFromLiteralArray:#(Rectangle 10 10 100 100)
+ decodeFromLiteralArray:#(Rectangle 10 10 100 100)
"
"Modified: / 28.1.1998 / 17:40:30 / cg"
@@ -2831,10 +2986,10 @@
size := self sizeOfInst:anInteger.
(ObjectMemory checkForFastNew:size) ifFalse:[
- "
- incrementally collect garbage
- "
- ObjectMemory incrementalGC.
+ "
+ incrementally collect garbage
+ "
+ ObjectMemory incrementalGC.
].
^ self basicNew:anInteger
!
@@ -2846,13 +3001,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|
@@ -2866,20 +3021,20 @@
"read an object's printed representation from the argument, aStream
and return it (i.e. the stream should contain some representation of
the object which was created using #storeOn:).
- The read object must be a kind of myself.
+ The read object must be a kind of myself.
If its not, the value of exceptionBlock is returned.
To get any object, use 'Object readFrom:...',
To get any number, use 'Number readFrom:...' and so on.
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."
^ [
- |newObject|
- newObject := self evaluatorClass evaluateFrom:aStream ifFail:exceptionBlock.
- (newObject isKindOf:self) ifTrue:[newObject] ifFalse:[exceptionBlock value].
+ |newObject|
+ newObject := self evaluatorClass evaluateFrom:aStream ifFail:exceptionBlock.
+ (newObject isKindOf:self) ifTrue:[newObject] ifFalse:[exceptionBlock value].
] on:Error do:exceptionBlock.
"
@@ -2887,7 +3042,7 @@
s := WriteStream on:String new.
#(1 2 3 4) storeOn:s.
Transcript showCR:(
- Array readFrom:(ReadStream on:s contents) onError:'not an Array'
+ Array readFrom:(ReadStream on:s contents) onError:'not an Array'
)
"
"
@@ -2895,7 +3050,7 @@
s := WriteStream on:String new.
#[1 2 3 4] storeOn:s.
Transcript showCR:(
- Array readFrom:(ReadStream on:s contents) onError:'not an Array'
+ Array readFrom:(ReadStream on:s contents) onError:'not an Array'
)
"
"
@@ -2913,9 +3068,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'
@@ -2936,10 +3091,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
@@ -3039,7 +3194,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
@@ -3057,12 +3212,12 @@
This method is for special uses only - there will be no recompilation
and no change record written here;
Warning:
- the flags slot specifies the layout and behavior of my instances slots
- 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 flags slot specifies the layout and behavior of my instances slots
+ 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."
flags := aNumber
!
@@ -3072,12 +3227,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
!
@@ -3095,16 +3250,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).
@@ -3129,19 +3284,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.
@@ -3202,10 +3357,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
@@ -3221,7 +3376,7 @@
superclass := self superclass.
(superclass notNil) ifTrue:[
- superclass addAllInstVarNamesTo:aCollection
+ superclass addAllInstVarNamesTo:aCollection
].
aCollection addAll:self instVarNames.
^ aCollection
@@ -3236,8 +3391,8 @@
"add all of my private classes to aCollection"
self privateClassesDo:[:aPrivateClass |
- aCollection add:aPrivateClass.
- aPrivateClass addAllPrivateClassesTo:aCollection
+ aCollection add:aPrivateClass.
+ aPrivateClass addAllPrivateClassesTo:aCollection
].
!
@@ -3257,9 +3412,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>"
@@ -3336,34 +3491,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:'
!
@@ -3624,9 +3779,9 @@
newColl := OrderedCollection new.
self allSubclassesDo:[:aClass |
- (aClass isRealNameSpace) ifFalse:[
- newColl add:aClass
- ]
+ (aClass isRealNameSpace) ifFalse:[
+ newColl add:aClass
+ ]
].
^ newColl
@@ -3646,9 +3801,9 @@
newColl := OrderedCollection new.
self allSubclassesInOrderDo:[:aClass |
- (aClass isRealNameSpace) ifFalse:[
- newColl add:aClass
- ]
+ (aClass isRealNameSpace) ifFalse:[
+ newColl add:aClass
+ ]
].
^ newColl
@@ -3666,12 +3821,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
@@ -3760,15 +3915,15 @@
int n = 0;
while (__theClass != nil) {
- if (__theClass == aClass) {
- RETURN(true);
- }
- if (__isBehaviorLike(__theClass)) {
- __theClass = __ClassInstPtr(__theClass)->c_superclass;
- } else {
- __theClass = nil;
- }
- if (++n > 100000) goto vmError;
+ if (__theClass == aClass) {
+ RETURN(true);
+ }
+ if (__isBehaviorLike(__theClass)) {
+ __theClass = __ClassInstPtr(__theClass)->c_superclass;
+ } else {
+ __theClass = nil;
+ }
+ if (++n > 100000) goto vmError;
}
RETURN (false);
vmError: ;
@@ -3806,7 +3961,7 @@
newColl := OrderedCollection new.
self subclassesDo:[:aClass |
- newColl add:aClass
+ newColl add:aClass
].
^ newColl.
!
@@ -3851,7 +4006,7 @@
coll := OrderedCollection new.
self withAllSuperclassesDo:[:cls |
- coll add:cls
+ coll add:cls
].
^ coll
@@ -3886,7 +4041,7 @@
coll := OrderedCollection new:100.
self allInstancesDo:[:anObject |
- coll add:anObject
+ coll add:anObject
].
^ coll
@@ -3906,7 +4061,7 @@
coll := self allInstances.
doWeakly ifTrue:[
- coll := WeakArray withAll:coll
+ coll := WeakArray withAll:coll
].
^ coll
@@ -3921,7 +4076,7 @@
coll := OrderedCollection new:100.
self allSubInstancesDo:[:anObject |
- coll add:anObject
+ coll add:anObject
].
^ coll
@@ -3968,9 +4123,9 @@
count := 0.
ObjectMemory allObjectsDo:[:anObject |
- (anObject isKindOf:self) ifTrue:[
- count := count + 1
- ]
+ (anObject isKindOf:self) ifTrue:[
+ count := count + 1
+ ]
].
^ count
@@ -3988,9 +4143,9 @@
instances of SmallInteger and UndefinedObject"
ObjectMemory allObjectsDo:[:anObject |
- (anObject isKindOf:self) ifTrue:[
- ^ true
- ]
+ (anObject isKindOf:self) ifTrue:[
+ ^ true
+ ]
].
^ false
@@ -4030,7 +4185,7 @@
"/ ].
ObjectMemory allInstancesOf:self do:[:anObject |
- ^ true
+ ^ true
].
^ false
@@ -4067,7 +4222,7 @@
"/ ].
ObjectMemory allInstancesOf:self do:[:anObject |
- count := count + 1
+ count := count + 1
].
^ count
@@ -4087,13 +4242,13 @@
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].
@@ -4120,7 +4275,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]
!
@@ -4139,12 +4294,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 );
%}
!
@@ -4152,7 +4307,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 */
@@ -4164,7 +4319,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 */
@@ -4176,7 +4331,7 @@
"return true, if instances do not have indexed instance variables"
"this could also be defined as:
- ^ self isVariable not
+ ^ self isVariable not
"
%{ /* NOCONTEXT */
@@ -4190,7 +4345,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 */
@@ -4207,7 +4362,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]
@@ -4251,24 +4406,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 );
}
%}
!
@@ -4304,7 +4459,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 */
@@ -4322,7 +4477,7 @@
flags = __intVal(__INST(flags)) & ARRAYMASK;
if (flags == WKPOINTERARRAY) {
- RETURN ( true );
+ RETURN ( true );
}
%}.
^ false
@@ -4332,7 +4487,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 */
@@ -4352,60 +4507,60 @@
%{
INT nBytes = __intVal(nInstvars) * sizeof(OBJ) + OHDR_SIZE;
if (__isSmallInteger(n)) {
- int nIndex;
-
- nIndex = __intVal(n);
- switch (__intVal(__INST(flags)) & ARRAYMASK) {
- case BYTEARRAY:
- nBytes += nIndex;
- if (nBytes & (__ALIGN__ - 1)) {
- nBytes = (nBytes & ~(__ALIGN__ - 1)) + __ALIGN__;
- }
- break;
-
- case WORDARRAY:
- case SWORDARRAY:
- nBytes += nIndex * 2;
- if (nBytes & (__ALIGN__ - 1)) {
- nBytes = (nBytes & ~(__ALIGN__ - 1)) + __ALIGN__;
- }
- break;
-
- case LONGARRAY:
- case SLONGARRAY:
- nBytes += nIndex * 4;
- break;
-
- case LONGLONGARRAY:
- case SLONGLONGARRAY:
- nBytes += nIndex * 8;
+ int nIndex;
+
+ nIndex = __intVal(n);
+ switch (__intVal(__INST(flags)) & ARRAYMASK) {
+ case BYTEARRAY:
+ nBytes += nIndex;
+ if (nBytes & (__ALIGN__ - 1)) {
+ nBytes = (nBytes & ~(__ALIGN__ - 1)) + __ALIGN__;
+ }
+ break;
+
+ case WORDARRAY:
+ case SWORDARRAY:
+ nBytes += nIndex * 2;
+ if (nBytes & (__ALIGN__ - 1)) {
+ nBytes = (nBytes & ~(__ALIGN__ - 1)) + __ALIGN__;
+ }
+ break;
+
+ case LONGARRAY:
+ case SLONGARRAY:
+ nBytes += nIndex * 4;
+ break;
+
+ case LONGLONGARRAY:
+ case SLONGLONGARRAY:
+ nBytes += nIndex * 8;
#ifdef __NEED_LONGLONG_ALIGN
- nBytes = (nBytes-1+__LONGLONG_ALIGN) &~ (__LONGLONG_ALIGN-1);
+ nBytes = (nBytes-1+__LONGLONG_ALIGN) &~ (__LONGLONG_ALIGN-1);
#endif
- break;
-
- case FLOATARRAY:
- nBytes += nIndex * sizeof(float);
- break;
-
- case DOUBLEARRAY:
- nBytes += nIndex * sizeof(double);
+ break;
+
+ case FLOATARRAY:
+ nBytes += nIndex * sizeof(float);
+ break;
+
+ case DOUBLEARRAY:
+ nBytes += nIndex * sizeof(double);
#ifdef __NEED_DOUBLE_ALIGN
- nBytes = (nBytes-1+__DOUBLE_ALIGN) &~ (__DOUBLE_ALIGN-1);
+ nBytes = (nBytes-1+__DOUBLE_ALIGN) &~ (__DOUBLE_ALIGN-1);
#endif
- break;
-
- default:
- nBytes += nIndex * sizeof(OBJ);
- break;
- }
+ break;
+
+ default:
+ nBytes += nIndex * sizeof(OBJ);
+ break;
+ }
}
RETURN (__mkSmallInteger(nBytes));
%}
"
- DoubleArray sizeOfInst:8
- IntegerArray sizeOfInst:8
+ DoubleArray sizeOfInst:8
+ IntegerArray sizeOfInst:8
"
! !
@@ -4420,7 +4575,7 @@
superclass := self superclass.
superclass notNil ifTrue:[
- ^ superclass allSelectors addAll:(self selectors); yourself.
+ ^ superclass allSelectors addAll:(self selectors); yourself.
].
^ self selectors asNewIdentitySet
@@ -4491,8 +4646,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
@@ -4544,8 +4699,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.
@@ -4553,8 +4708,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
@@ -4600,14 +4755,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
@@ -4640,14 +4795,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
@@ -4679,28 +4834,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
!
@@ -4713,7 +4868,7 @@
cls := self whichClassIncludesSelector:aSelector.
cls notNil ifTrue:[
- ^ cls compiledMethodAt:aSelector
+ ^ cls compiledMethodAt:aSelector
].
^ nil
@@ -4751,8 +4906,8 @@
md := self methodDictionary.
md isNil ifTrue:[
- 'OOPS - nil methodDictionary' errorPrintCR.
- ^ failBlock value.
+ 'OOPS - nil methodDictionary' errorPrintCR.
+ ^ failBlock value.
].
^ md keyAtValue:aMethod ifAbsent:failBlock.
@@ -4790,18 +4945,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
@@ -4855,7 +5010,7 @@
(only Classes do). This allows different Behavior-like objects
(alien classes) to be handled by the browser as well.
Traditionally, this was called classVarNames, but newer versions of squeak
- seem to have changed to use classVariableNames.
+ seem to have changed to use classVariableNames.
So you probably should use the alias"
^ #()
@@ -4872,7 +5027,7 @@
^ self classVarNames
"
- Infinity classVariableNames
+ Infinity classVariableNames
"
!
@@ -4899,19 +5054,19 @@
"return a collection of the instance variable name-strings.
Behavior does not provide this info - generate synthetic names.
Traditionally, this was called instVarNames, but newer versions of squeak
- seem to have changed to use instanceVariableNames.
+ seem to have changed to use instanceVariableNames.
So you probably should use the alias"
|superclass superInsts|
superclass := self superclass.
superclass isNil ifTrue:[
- superInsts := 0
+ superInsts := 0
] ifFalse:[
- superInsts := superclass instSize
+ superInsts := superclass instSize
].
^ (superInsts+1 to:self instSize)
- collect:[:index | self instVarNameForIndex:index]
+ collect:[:index | self instVarNameForIndex:index]
"Modified: / 17-07-2006 / 00:28:40 / cg"
!
@@ -4919,7 +5074,7 @@
instanceVariableNames
"alias for instVarNames.
Traditionally, this was called instVarNames, but newer versions of squeak
- seem to have changed to use instanceVariableNames.
+ seem to have changed to use instanceVariableNames.
So you probably should use this alias"
^ self instVarNames
@@ -4939,16 +5094,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
@@ -4978,15 +5133,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].
@@ -4994,10 +5149,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"
!
@@ -5010,9 +5165,9 @@
setOfSelectors := IdentitySet new.
self methodDictionary keysAndValuesDo:[:sel :mthd |
- (mthd referencesLiteral:someLiteralConstant) ifTrue:[
- setOfSelectors add:sel
- ].
+ (mthd referencesLiteral:someLiteralConstant) ifTrue:[
+ setOfSelectors add:sel
+ ].
].
^ setOfSelectors
@@ -5055,18 +5210,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"
! !
@@ -5110,10 +5265,9 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.372 2015-04-20 13:16:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.373 2015-04-26 11:30:22 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.372 2015-04-20 13:16:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.373 2015-04-26 11:30:22 cg Exp $'
! !
-