hg/stx-libbasic: comparison Behavior.st

equal deleted inserted replaced

-:95efb21c1fac
+:c7353f86a302
 other person.  No title to or ownership of the software is
 hereby transferred.
 "
 Object subclass:#Behavior
-instanceVariableNames:'superclass flags selectorArray methodArray
+	 instanceVariableNames:'superclass flags selectorArray methodArray otherSuperclasses
-			      otherSuperclasses instSize'
+instSize'
-classVariableNames:'SubclassInfo'
+	 classVariableNames:'SubclassInfo'
-poolDictionaries:''
+	 poolDictionaries:''
-category:'Kernel-Classes'
+	 category:'Kernel-Classes'
 !
 !Behavior class methodsFor:'documentation'!
 copyright
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
 "
-!
-version
-^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.52 1995-11-11 14:26:59 cg Exp $'
 !
 documentation
 "
 Every class in the system inherits from Behavior (via Class, ClassDescription);
 NOTICE: layout known by compiler and runtime system; be careful when changing
 "
 !
+version
+^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.53 1995-11-23 10:45:04 cg Exp $'
+!
 virtualMachineRelationship
 "
 NOTICE:
 	the stuff described below may not be available on other
 	Smalltalk implementations; be aware that these error mechanisms
 	with:
 		'Smalltalk debugPrinting:false'
 	and:
 		'Smalltalk infoPrinting:false'
 "
-! !
-!Behavior class methodsFor:'queries'!
-isBuiltInClass
-"this class is known by the run-time-system"
-^ true
 ! !
 !Behavior class methodsFor:'creating new classes'!
 new
 Metaclass new new          <- an instance (i.e. a class) of it
 Metaclass new new new      <- an instance of this new class
 "
 ! !
+!Behavior class methodsFor:'flag bit constants'!
+flagBehavior
+"return the flag code which marks Behavior-like instances.
+You have to check this single bit in the flag value when
+checking for behaviors."
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(BEHAVIOR_INSTS) );
+%}
+"consistency check:
+all class-entries must be behaviors;
+all behaviors must be flagged so (in its class's flags)
+(otherwise, VM will bark)
+all non-behaviors may not be flagged
+|bit|
+bit := Class flagBehavior.
+ObjectMemory allObjectsDo:[:o|
+o isBehavior ifTrue:[
+	 (o class flags bitTest:bit) ifFalse:[
+	     self halt
+	 ].
+] ifFalse:[
+	 (o class flags bitTest:bit) ifTrue:[
+	     self halt
+	 ].
+].
+o class isBehavior ifFalse:[
+	 self halt
+] ifTrue:[
+	 (o class class flags bitTest:bit) ifFalse:[
+	     self halt
+	 ]
+]
+]
+"
+!
+flagBlock
+"return the flag code which marks Block-like instances.
+You have to check this single bit in the flag value when
+checking for blocks."
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(BLOCK_INSTS) );
+%}
+!
+flagBlockContext
+"return the flag code which marks BlockContext-like instances.
+You have to check this single bit in the flag value when
+checking for blockContexts."
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(BCONTEXT_INSTS) );
+%}
+!
+flagBytes
+"return the flag code for byte-valued indexed instances.
+You have to mask the flag value with indexMask when comparing
+it with flagBytes."
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(BYTEARRAY) );
+%}
+"
+Behavior flagBytes
+"
+!
+flagContext
+"return the flag code which marks Context-like instances.
+You have to check this single bit in the flag value when
+checking for contexts."
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(CONTEXT_INSTS) );
+%}
+!
+flagDoubles
+"return the flag code for double-valued indexed instances (i.e. 8-byte reals).
+You have to mask the flag value with indexMask when comparing
+it with flagDoubles."
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(DOUBLEARRAY) );
+%}
+"
+Behavior flagDoubles
+"
+!
+flagFloat
+"return the flag code which marks Float-like instances.
+You have to check this single bit in the flag value when
+checking for floats."
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(FLOAT_INSTS) );
+%}
+!
+flagFloats
+"return the flag code for float-valued indexed instances (i.e. 4-byte reals).
+You have to mask the flag value with indexMask when comparing
+it with flagFloats."
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(FLOATARRAY) );
+%}
+"
+Behavior flagFloats
+"
+!
+flagLongs
+"return the flag code for long-valued indexed instances (i.e. 4-byte).
+You have to mask the flag value with indexMask when comparing
+it with flagLongs."
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(LONGARRAY) );
+%}
+"
+Behavior flagLongs
+"
+!
+flagMethod
+"return the flag code which marks Method-like instances.
+You have to check this single bit in the flag value when
+checking for methods."
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(METHOD_INSTS) );
+%}
+!
+flagNonObjectInst
+"return the flag code which marks instances which have a
+non-object instance variable (in slot 1).
+(these are ignored by the garbage collector)"
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(NONOBJECT_INSTS) );
+%}
+!
+flagNotIndexed
+"return the flag code for non-indexed instances.
+You have to mask the flag value with indexMask when comparing
+it with flagNotIndexed."
+^ 0
+!
+flagPointers
+"return the flag code for pointer indexed instances (i.e. Array of object).
+You have to mask the flag value with indexMask when comparing
+it with flagPointers."
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(POINTERARRAY) );
+%}
+"
+Behavior flagPointers
+"
+!
+flagSymbol
+"return the flag code which marks Symbol-like instances.
+You have to check this single bit in the flag value when
+checking for symbols."
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(SYMBOL_INSTS) );
+%}
+!
+flagWeakPointers
+"return the flag code for weak pointer indexed instances (i.e. WeakArray).
+You have to mask the flag value with indexMask when comparing
+it with flagWeakPointers."
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(WKPOINTERARRAY) );
+%}
+!
+flagWords
+"return the flag code for word-valued indexed instances (i.e. 2-byte).
+You have to mask the flag value with indexMask when comparing
+it with flagWords."
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(WORDARRAY) );
+%}
+"
+Behavior flagWords
+"
+!
+maskIndexType
+"return a mask to extract all index-type bits"
+%{  /* NOCONTEXT */
+/* this is defined as a primitive to get defines from stc.h */
+RETURN ( _MKSMALLINT(ARRAYMASK) );
+%}
+! !
 !Behavior class methodsFor:'private '!
+flushSubclassInfo
+SubclassInfo := nil.
+"
+Class flushSubclassInfo
+"
+!
 subclassInfo
 |d|
 SubclassInfo notNil ifTrue:[^ SubclassInfo].
 ^ d
 "
 Class subclassInfo
 "
-!
+! !
-flushSubclassInfo
+!Behavior class methodsFor:'queries'!
+isBuiltInClass
+"this class is known by the run-time-system"
+^ true
+! !
+!Behavior methodsFor:'accessing'!
+addSelector:newSelector withLazyMethod:newMethod
+"add the method given by 2nd argument under the selector given by
+1st argument to the methodDictionary. Since it does not flush
+any caches, this is only allowed for lazy methods."
+newMethod isLazyMethod ifFalse:[
+	self error:'operation only allowed for lazy methods'.
+	^ false
+].
+"/ oops: we must flush, if this method already exists ...
+(selectorArray includes:newSelector) ifTrue:[
+	ObjectMemory flushCaches
+].
+(self primAddSelector:newSelector withMethod:newMethod) ifTrue:[
+	self changed:#methodDictionary with:newSelector.
+	^ true
+].
+^ false
+!
+addSelector:newSelector withMethod:newMethod
+"add the method given by 2nd argument under the selector given by
+1st argument to the methodDictionary. Flush all caches."
+|nargs|
+(self primAddSelector:newSelector withMethod:newMethod) ifFalse:[^ false].
+self changed:#methodDictionary with:newSelector.
+"
+if I have no subclasses, all we have to flush is cached
+data for myself ... (actually, in any case all that needs
+to be flushed is info for myself and all of my subclasses)
+"
+"
+problem: this is slower; since looking for all subclasses is (currently)
+	     a bit slow :-(
+	     We need the hasSubclasses-info bit in Behavior; now
+self withAllSubclassesDo:[:aClass |
+	ObjectMemory flushInlineCachesFor:aClass withArgs:nargs.
+	ObjectMemory flushMethodCacheFor:aClass
+].
+"
+"
+actually, we would do better with less flushing ...
+"
+nargs := newSelector numArgs.
+ObjectMemory flushMethodCache.
+ObjectMemory flushInlineCachesWithArgs:nargs.
+^ true
+!
+addSuperclass:aClass
+"EXPERIMENTAL MI support: add aClass to the set of classes, from which instances
+inherit protocol."
+"first, check if the class is abstract -
+allows abstract mixins are allowed in the current implementation"
+aClass instSize == 0 ifFalse:[
+	self error:'only abstract mixins allowed'.
+	^ self
+].
+otherSuperclasses isNil ifTrue:[
+	otherSuperclasses := Array with:aClass
+] ifFalse:[
+	otherSuperclasses := otherSuperclasses copyWith:aClass
+].
 SubclassInfo := nil.
+ObjectMemory flushCaches
-"
+!
-Class flushSubclassInfo
-"
+category
+"return the category of the class.
+Returning nil here, since Behavior does not define a category
+(only ClassDescriptions do)."
+^ nil
+"
+Point category
+Behavior new category
+"
+!
+displayString
+"although behaviors have no name, we return something
+useful here - there are many places (inspectors) where
+a classes name is asked for.
+Implementing this message here allows instances of anonymous classes
+to show a reasonable name."
+^ 'someBehavior'
+!
+flags
+"return the receivers flag bits"
+^ flags
+!
+implicit_methodDict
+"ST-80 compatibility.
+This allows subclasses to assume there is an instance variable
+named methodDict."
+^ self methodDictionary
+!
+implicit_methodDict:aDictionary
+"ST-80 compatibility.
+This allows subclasses to assume there is an instance variable
+named methodDict."
+^ self error:'not allowed to set the methodDictionary'
+!
+instSize
+"return the number of instance variables of the receiver.
+This includes all superclass instance variables."
+^ instSize
+!
+methodArray
+"return the receivers method array.
+Notice: this is not compatible with ST-80."
+^ methodArray
+!
+methodDictionary
+"return the receivers method dictionary.
+Since no dictionary is actually present, create one for ST-80 compatibility."
+|dict n "{ Class: SmallInteger }"|
+dict := IdentityDictionary new.
+n := selectorArray size.
+1 to:n do:[:index |
+	dict at:(selectorArray at:index) put:(methodArray at:index)
+].
+^ dict
+!
+name
+"although behaviors have no name, we return something
+useful here - there are many places (inspectors) where
+a classes name is asked for.
+Implementing this message here allows anonymous classes
+and instances of them to be inspected."
+^ 'someBehavior'
+!
+removeSelector:aSelector
+"remove the selector, aSelector and its associated method
+from the methodDictionary"
+|index oldSelectorArray oldMethodArray newSelectorArray newMethodArray|
+index := selectorArray identityIndexOf:aSelector startingAt:1.
+(index == 0) ifTrue:[^ false].
+newSelectorArray := selectorArray copyWithoutIndex:index.
+newMethodArray := methodArray copyWithoutIndex:index.
+oldSelectorArray := selectorArray.
+oldMethodArray := methodArray.
+selectorArray := newSelectorArray.
+methodArray := newMethodArray.
+"
+[
+	|nargs|
+	nargs := aSelector numArgs.
+	ObjectMemory flushMethodCache.
+	ObjectMemory flushInlineCachesWithArgs:nargs.
+] value
+"
+"
+actually, we would do better with less flushing ...
+"
+ObjectMemory flushCaches.
+^ true
+!
+removeSuperclass:aClass
+"EXPERIMENTAL MI support: remove aClass from the set of classes, from which instances
+inherit protocol."
+otherSuperclasses notNil ifTrue:[
+	otherSuperclasses := otherSuperclasses copyWithout:aClass.
+	otherSuperclasses isEmpty ifTrue:[
+	    otherSuperclasses := nil
+	].
+	SubclassInfo := nil.
+	ObjectMemory flushCaches
+].
+!
+selectorArray
+"return the receivers selector array.
+Notice: this is not compatible with ST-80."
+^ selectorArray
+!
+selectors
+"return the receivers selector array as an orderedCollection.
+Notice: this may not be compatible with ST-80.
+(should we return a Set ?)"
+^ selectorArray asOrderedCollection
+!
+selectors:newSelectors methods:newMethods
+"set both selector array and method array of the receiver,
+and flush caches"
+ObjectMemory flushCaches.
+selectorArray := newSelectors.
+methodArray := newMethods
+!
+superclass
+"return the receivers superclass"
+^ superclass
+!
+superclass:aClass
+"set the superclass - this actually creates a new class,
+recompiling all methods for the new one. The receiving class stays
+around anonymous to allow existing instances some life.
+This may change in the future (adjusting existing instances)"
+SubclassInfo := nil.
+"must flush caches since lookup chain changes"
+ObjectMemory flushCaches.
+"
+superclass := aClass
+"
+"for correct recompilation, just create a new class ..."
+aClass subclass:(self name)
+	   instanceVariableNames:(self instanceVariableString)
+	   classVariableNames:(self classVariableString)
+	   poolDictionaries:''
+	   category:self category
 ! !
+!Behavior methodsFor:'autoload check'!
+autoload
+"force autoloading - do nothing here;
+redefined in Autoload; see comment there"
+^ self
+!
+isLoaded
+"return true, if the class has been loaded;
+redefined in Autoload; see comment there"
+^ true
+! !
+!Behavior methodsFor:'binary storage'!
+binaryDefinitionFrom:stream manager:manager
+"sent during a binary read by the input manager.
+Read the definition on an empty instance (of my class) from stream.
+All pointer instances are left nil, while all bits are read in here.
+return the new object."
+|obj t
+basicSize "{ Class: SmallInteger }" |
+self isPointers ifTrue: [
+	"/
+	"/ inst size not needed - if you uncomment the line below,
+	"/ also uncomment the corresponding line in
+	"/ Object>>storeBinaryDefinitionOn:manager:
+	"/
+	"/ stream next. "skip instSize"
+	self isVariable ifTrue: [
+	    ^ self basicNew:(stream nextNumber:3)
+	].
+	^ self basicNew
+].
+"
+an object with bit-valued instance variables.
+These are read here.
+"
+basicSize := stream nextNumber:4.
+obj := self basicNew:basicSize.
+self isBytes ifTrue: [
+	stream nextBytes:basicSize into:obj
+] ifFalse: [
+	self isWords ifTrue: [
+	    1 to:basicSize do:[:i |
+		obj basicAt:i put:(stream nextNumber:2)
+	    ]
+	] ifFalse:[
+	    self isLongs ifTrue: [
+		1 to:basicSize do:[:i |
+		    obj basicAt:i put:(stream nextNumber:4)
+		]
+	    ] ifFalse:[
+		self isFloats ifTrue: [
+		    "could do it in one big read on machines which use IEEE floats ..."
+		    t := Float basicNew.
+		    1 to:basicSize do:[:i |
+			Float readBinaryIEEESingleFrom:stream into:t.
+			obj basicAt:i put: t
+		    ]
+		] ifFalse:[
+		    self isDoubles ifTrue: [
+			"could do it in one big read on machines which use IEEE doubles ..."
+			t := Float basicNew.
+			1 to:basicSize do:[:i |
+			    Float readBinaryIEEEDoubleFrom:stream into:t.
+			    obj basicAt:i put: t
+			]
+		    ]
+		]
+	    ]
+	]
+].
+^obj
+!
+canCloneFrom:anObject
+"return true, if this class can clone an obsolete object as retrieved
+by a binary load. Subclasses which do not want to have obsolete objects
+be converted, should redefine this method to return false.
+(However, conversion is never done silently in a binary load; you
+have to have a handler for the binaryload errors and for the conversion
+request signal.)"
+^ true
+!
+cloneFrom:aPrototype
+"return an instance of myself with variables initialized from
+a prototype. This is used when instances of obsolete classes are
+binary loaded and a conversion is done on the obsolete object.
+UserClasses may redefine this for better conversions."
+|newInst indexed myInfo otherInfo varIndexAssoc|
+indexed := false.
+aPrototype class isVariable ifTrue:[
+	self isVariable ifTrue:[
+	    indexed := true.
+	].
+	"otherwise, these are lost ..."
+].
+indexed ifTrue:[
+	newInst := self basicNew:aPrototype basicSize
+] ifFalse:[
+	newInst := self basicNew
+].
+myInfo := self instanceVariableOffsets.
+otherInfo := aPrototype class instanceVariableOffsets.
+myInfo keysAndValuesDo:[:name :index |
+	varIndexAssoc := otherInfo at:name ifAbsent:[].
+	varIndexAssoc notNil ifTrue:[
+	    newInst instVarAt:index put:(aPrototype instVarAt:(varIndexAssoc value))
+	]
+].
+indexed ifTrue:[
+	1 to:aPrototype basicSize do:[:index |
+	    newInst basicAt:index put:(aPrototype basicAt:index)
+	].
+].
+^ newInst
+"
+Class withoutUpdatingChangesDo:[
+	 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.
+]
+"
+"
+|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.
+]
+"
+!
+readBinaryFrom:aStream
+"read an objects binary representation from the argument,
+aStream and return it.
+The read object must be a kind of myself, otherwise an error is raised.
+To get any object, use 'Object readBinaryFrom:...',
+To get any number, use 'Number readBinaryFrom:...' and so on.
+This is the reverse operation to 'storeBinaryOn:'. "
+^ self readBinaryFrom:aStream onError:[self error:('expected ' , self name)]
+"
+|s|
+s := WriteStream on:(ByteArray new).
+#(1 2 3 4) storeBinaryOn:s.
+Object readBinaryFrom:(ReadStream on:s contents)
+"
+"
+|s|
+s := 'testFile' asFilename writeStream binary.
+#(1 2 3 4) storeBinaryOn:s.
+'hello world' storeBinaryOn:s.
+s close.
+s := 'testFile' asFilename readStream binary.
+Transcript showCr:(Object readBinaryFrom:s).
+Transcript showCr:(Object readBinaryFrom:s).
+s close.
+"
+!
+readBinaryFrom:aStream onError:exceptionBlock
+"read an objects binary representation from the argument,
+aStream and return it.
+The read object must be a kind of myself, otherwise the value of
+the exceptionBlock is returned.
+To get any object, use 'Object readBinaryFrom:...',
+To get any number, use 'Number readBinaryFrom:...' and so on.
+This is the reverse operation to 'storeBinaryOn:'. "
+|newObject|
+newObject := (BinaryInputManager new:1024) readFrom:aStream.
+(newObject isKindOf:self) ifFalse:[^ exceptionBlock value].
+^ newObject
+"
+|s|
+s := WriteStream on:(ByteArray new).
+#(1 2 3 4) storeBinaryOn:s.
+Object readBinaryFrom:(ReadStream on:s contents) onError:['oops']
+"
+"
+|s|
+s := WriteStream on:(ByteArray new).
+#[1 2 3 4] storeBinaryOn:s.
+Array readBinaryFrom:(ReadStream on:s contents)  onError:['oops']
+"
+!
+storeBinaryDefinitionOn: stream manager: manager
+"binary store of a classes definition.
+Classes will store the name only and restore by looking for
+that name in the Smalltalk dictionary."
+| myName |
+myName := self name.
+stream nextNumber:4 put:self signature.
+stream nextNumber:2 put:0.
+stream nextNumber:2 put:myName size.
+myName do:[:c|
+	stream nextPut:c asciiValue
+]
+"
+|s|
+s := WriteStream on:ByteArray new.
+#(1 2 3 4) storeBinaryOn:s.
+Object readBinaryFrom:(ReadStream on:s contents)
+|s|
+s := WriteStream on:ByteArray new.
+Rectangle storeBinaryOn:s.
+Object readBinaryFrom:(ReadStream on:s contents)
+"
+! !
+!Behavior methodsFor:'compiler interface'!
+compiler
+"return the compiler to use for this class.
+OBSOLETE: This is the old ST/X interface, kept for migration.
+	       Dont use it - it will vanish."
+^ self compilerClass
+!
+compilerClass
+"return the compiler to use for this class -
+this can be redefined in special classes, to get classes with
+Lisp, Prolog, ASN1, Basic :-) or whatever syntax."
+^ Compiler
+!
+evaluatorClass
+"return the compiler to use for expression evaluation for this class -
+this can be redefined in special classes, to get classes with
+Lisp, Prolog, ASN1, Basic :-) or whatever syntax."
+^ Compiler
+! !
+!Behavior methodsFor:'copying'!
+deepCopy
+"return a deep copy of the receiver
+- return the receiver here - time will show if this is ok"
+^ self
+!
+deepCopyUsing:aDictionary
+"return a deep copy of the receiver
+- return the receiver here - time will show if this is ok"
+^ self
+!
+simpleDeepCopy
+"return a deep copy of the receiver
+- return the receiver here - time will show if this is ok"
+^ self
+! !
+!Behavior methodsFor:'enumerating'!
+allDerivedInstancesDo:aBlock
+"evaluate aBlock for all of my instances and all instances of subclasses.
+This method is going to be removed for protocol compatibility with
+other STs; use allSubInstancesDo:"
+self obsoleteMethodWarning:'please use #allSubInstancesDo:'.
+self allSubInstancesDo:aBlock
+"
+StandardSystemView allDerivedInstancesDo:[:v | Transcript showCr:(v name)]
+"
+!
+allInstancesDo:aBlock
+"evaluate aBlock for all of my instances"
+"/    ObjectMemory allObjectsDo:[:anObject |
+"/        (anObject class == self) ifTrue:[
+"/            aBlock value:anObject
+"/        ]
+"/    ]
+ObjectMemory allInstancesOf:self do:[:anObject |
+	aBlock value:anObject
+]
+"
+StandardSystemView allInstancesDo:[:v | Transcript showCr:(v name)]
+"
+!
+allSubInstancesDo:aBlock
+"evaluate aBlock for all of my instances and all instances of subclasses"
+ObjectMemory allObjectsDo:[:anObject |
+	(anObject isKindOf:self) ifTrue:[
+	    aBlock value:anObject
+	]
+]
+"
+StandardSystemView allSubInstancesDo:[:v | Transcript showCr:(v name)]
+"
+!
+allSubclassesDo:aBlock
+"evaluate aBlock for all of my subclasses.
+There is no specific order, in which the entries are enumerated.
+This will only enumerate globally known classes - for anonymous
+behaviors, you have to walk over all instances of Behavior."
+Smalltalk allBehaviorsDo:[:aClass |
+	(aClass isSubclassOf:self) ifTrue:[
+	    aBlock value:aClass
+	]
+]
+"
+Collection allSubclassesDo:[:c | Transcript showCr:(c name)]
+"
+!
+allSubclassesInOrderDo:aBlock
+"evaluate aBlock for all of my subclasses.
+Higher level subclasses will be enumerated before the deeper ones,
+so the order in which aBlock gets called is ok to fileOut classes in
+correct order for later fileIn.
+This will only enumerate globally known classes - for anonymous
+behaviors, you have to walk over all instances of Behavior"
+self subclassesDo:[:aClass |
+	aBlock value:aClass.
+	aClass allSubclassesInOrderDo:aBlock
+]
+"
+Collection allSubclassesInOrderDo:[:c | Transcript showCr:(c name)]
+"
+!
+allSuperclassesDo:aBlock
+"evaluate aBlock for all of my superclasses"
+|theClass|
+theClass := superclass.
+[theClass notNil] whileTrue:[
+	aBlock value:theClass.
+	theClass := theClass superclass
+]
+"
+String allSuperclassesDo:[:c | Transcript showCr:(c name)]
+"
+!
+subclassesDo:aBlock
+"evaluate the argument, aBlock for all immediate subclasses.
+This will only enumerate globally known classes - for anonymous
+behaviors, you have to walk over all instances of Behavior."
+|coll|
+SubclassInfo isNil ifTrue:[
+	Behavior subclassInfo
+].
+SubclassInfo notNil ifTrue:[
+	coll := SubclassInfo at:self ifAbsent:nil.
+	coll notNil ifTrue:[
+	    coll do:aBlock.
+	].
+	^ self
+].
+Smalltalk allBehaviorsDo:[:aClass |
+	(aClass superclass == self) ifTrue:[
+	    aBlock value:aClass
+	]
+]
+"
+Collection subclassesDo:[:c | Transcript showCr:(c name)]
+"
+! !
 !Behavior methodsFor:'initialization'!
+deinitialize
+"deinitialize is sent to a class before it is physically unloaded.
+This is only done with classes which have been loaded in from a binary
+file. Classes may release any primitive memory or other stuff which is
+not visible to smalltalk (for example, release internal memory).
+The default action here is to do nothing."
+^ self
+!
 initialize
 "initialize is sent to a class either during startup,
 (for all statically compiled-in classes) or after a class
 has been loaded into the system (either bytecodes or machinecode).
 This gives classes a chance to flush any device dependent or otherwise
 obsolete data which may be a leftover from the previous live.
 The default action here is to do nothing."
 ^ self
-!
-deinitialize
-"deinitialize is sent to a class before it is physically unloaded.
-This is only done with classes which have been loaded in from a binary
-file. Classes may release any primitive memory or other stuff which is
-not visible to smalltalk (for example, release internal memory).
-The default action here is to do nothing."
-^ self
 ! !
-!Behavior methodsFor:'copying'!
-deepCopy
-"return a deep copy of the receiver
-- return the receiver here - time will show if this is ok"
-^ self
-!
-deepCopyUsing:aDictionary
-"return a deep copy of the receiver
-- return the receiver here - time will show if this is ok"
-^ self
-!
-simpleDeepCopy
-"return a deep copy of the receiver
-- return the receiver here - time will show if this is ok"
-^ self
-! !
 !Behavior methodsFor:'instance creation'!
-uninitializedNew
-"create an instance of myself with uninitialized contents.
-For all classes except ByteArray, this is the same as #basicNew."
-^ self basicNew
-!
-uninitializedNew:anInteger
-"create an instance of myself with uninitialized contents.
-For all classes except ByteArray, this is the same as #basicNew:."
-^ self basicNew:anInteger
-!
-niceBasicNew:anInteger
-"same as basicNew:anInteger, but tries to avoid long pauses
-due to garbage collection. This method checks to see if
-allocation is possible without a pause, and does a background
-incremental garbage collect first if there is not enough memory
-available at the moment for fast allocation.
-This is useful in low-priority background processes which like to
-avoid disturbing any higher priority foreground process while allocating
-big amounts of memory. Of course, using this method only makes
-sense for big or huge objects (say > 200k).
-EXPERIMENTAL: this is a non-standard interface and should only
-be used for special applications. There is no guarantee, that this
-method will be available in future ST/X releases."
-|size|
-size := self sizeOfInst:anInteger.
-(ObjectMemory checkForFastNew:size) ifFalse:[
-	"
-	 incrementally collect garbage
-	"
-	ObjectMemory incrementalGC.
-].
-^ self basicNew:anInteger
-!
-new
-"return an instance of myself without indexed variables"
-^ self basicNew
-!
-new:anInteger
-"return an instance of myself with anInteger indexed variables"
-^ self basicNew:anInteger
-!
 basicNew
 "return an instance of myself without indexed variables.
 If the receiver-class has indexed instvars, the new object will have
 a basicSize of zero -
 Bad luck - you should increase the swap space on your machine.
 "
 ^ ObjectMemory allocationFailureSignal raise.
 !
+new
+"return an instance of myself without indexed variables"
+^ self basicNew
+!
+new:anInteger
+"return an instance of myself with anInteger indexed variables"
+^ self basicNew:anInteger
+!
+niceBasicNew:anInteger
+"same as basicNew:anInteger, but tries to avoid long pauses
+due to garbage collection. This method checks to see if
+allocation is possible without a pause, and does a background
+incremental garbage collect first if there is not enough memory
+available at the moment for fast allocation.
+This is useful in low-priority background processes which like to
+avoid disturbing any higher priority foreground process while allocating
+big amounts of memory. Of course, using this method only makes
+sense for big or huge objects (say > 200k).
+EXPERIMENTAL: this is a non-standard interface and should only
+be used for special applications. There is no guarantee, that this
+method will be available in future ST/X releases."
+|size|
+size := self sizeOfInst:anInteger.
+(ObjectMemory checkForFastNew:size) ifFalse:[
+	"
+	 incrementally collect garbage
+	"
+	ObjectMemory incrementalGC.
+].
+^ self basicNew:anInteger
+!
 readFrom:aStream
 "read an objects printed representation from the argument, aStream
 and return it.
 The read object must be a kind of myself if its not, an error is raised.
 This is the reverse operation to 'storeOn:'.
 Integer readFromString:'abc' onError:0
 Point readFromString:'1@2'
 Point readFromString:'0'
 Point readFromString:'0' onError:[0@0]
 "
+!
+uninitializedNew
+"create an instance of myself with uninitialized contents.
+For all classes except ByteArray, this is the same as #basicNew."
+^ self basicNew
+!
+uninitializedNew:anInteger
+"create an instance of myself with uninitialized contents.
+For all classes except ByteArray, this is the same as #basicNew:."
+^ self basicNew:anInteger
 ! !
-!Behavior methodsFor:'autoload check'!
-isLoaded
-"return true, if the class has been loaded;
-redefined in Autoload; see comment there"
-^ true
-!
-autoload
-"force autoloading - do nothing here;
-redefined in Autoload; see comment there"
-^ self
-! !
-!Behavior methodsFor:'snapshots'!
-preSnapshot
-"sent by ObjectMemory, before a snapshot is written.
-Nothing done here."
-!
-postSnapshot
-"sent by ObjectMemory, after a snapshot has been written.
-Nothing done here."
-! !
-!Behavior class methodsFor:'flag bit constants'!
-flagNotIndexed
-"return the flag code for non-indexed instances.
-You have to mask the flag value with indexMask when comparing
-it with flagNotIndexed."
-^ 0
-!
-flagBytes
-"return the flag code for byte-valued indexed instances.
-You have to mask the flag value with indexMask when comparing
-it with flagBytes."
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(BYTEARRAY) );
-%}
-"
-Behavior flagBytes
-"
-!
-flagWords
-"return the flag code for word-valued indexed instances (i.e. 2-byte).
-You have to mask the flag value with indexMask when comparing
-it with flagWords."
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(WORDARRAY) );
-%}
-"
-Behavior flagWords
-"
-!
-flagLongs
-"return the flag code for long-valued indexed instances (i.e. 4-byte).
-You have to mask the flag value with indexMask when comparing
-it with flagLongs."
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(LONGARRAY) );
-%}
-"
-Behavior flagLongs
-"
-!
-flagFloats
-"return the flag code for float-valued indexed instances (i.e. 4-byte reals).
-You have to mask the flag value with indexMask when comparing
-it with flagFloats."
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(FLOATARRAY) );
-%}
-"
-Behavior flagFloats
-"
-!
-flagDoubles
-"return the flag code for double-valued indexed instances (i.e. 8-byte reals).
-You have to mask the flag value with indexMask when comparing
-it with flagDoubles."
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(DOUBLEARRAY) );
-%}
-"
-Behavior flagDoubles
-"
-!
-flagPointers
-"return the flag code for pointer indexed instances (i.e. Array of object).
-You have to mask the flag value with indexMask when comparing
-it with flagPointers."
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(POINTERARRAY) );
-%}
-"
-Behavior flagPointers
-"
-!
-flagWeakPointers
-"return the flag code for weak pointer indexed instances (i.e. WeakArray).
-You have to mask the flag value with indexMask when comparing
-it with flagWeakPointers."
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(WKPOINTERARRAY) );
-%}
-!
-maskIndexType
-"return a mask to extract all index-type bits"
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(ARRAYMASK) );
-%}
-!
-flagBehavior
-"return the flag code which marks Behavior-like instances.
-You have to check this single bit in the flag value when
-checking for behaviors."
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(BEHAVIOR_INSTS) );
-%}
-"consistency check:
-all class-entries must be behaviors;
-all behaviors must be flagged so (in its class's flags)
-(otherwise, VM will bark)
-all non-behaviors may not be flagged
-|bit|
-bit := Class flagBehavior.
-ObjectMemory allObjectsDo:[:o|
-o isBehavior ifTrue:[
-	 (o class flags bitTest:bit) ifFalse:[
-	     self halt
-	 ].
-] ifFalse:[
-	 (o class flags bitTest:bit) ifTrue:[
-	     self halt
-	 ].
-].
-o class isBehavior ifFalse:[
-	 self halt
-] ifTrue:[
-	 (o class class flags bitTest:bit) ifFalse:[
-	     self halt
-	 ]
-]
-]
-"
-!
-flagBlock
-"return the flag code which marks Block-like instances.
-You have to check this single bit in the flag value when
-checking for blocks."
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(BLOCK_INSTS) );
-%}
-!
-flagMethod
-"return the flag code which marks Method-like instances.
-You have to check this single bit in the flag value when
-checking for methods."
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(METHOD_INSTS) );
-%}
-!
-flagNonObjectInst
-"return the flag code which marks instances which have a
-non-object instance variable (in slot 1).
-(these are ignored by the garbage collector)"
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(NONOBJECT_INSTS) );
-%}
-!
-flagContext
-"return the flag code which marks Context-like instances.
-You have to check this single bit in the flag value when
-checking for contexts."
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(CONTEXT_INSTS) );
-%}
-!
-flagBlockContext
-"return the flag code which marks BlockContext-like instances.
-You have to check this single bit in the flag value when
-checking for blockContexts."
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(BCONTEXT_INSTS) );
-%}
-!
-flagFloat
-"return the flag code which marks Float-like instances.
-You have to check this single bit in the flag value when
-checking for floats."
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(FLOAT_INSTS) );
-%}
-!
-flagSymbol
-"return the flag code which marks Symbol-like instances.
-You have to check this single bit in the flag value when
-checking for symbols."
-%{  /* NOCONTEXT */
-/* this is defined as a primitive to get defines from stc.h */
-RETURN ( _MKSMALLINT(SYMBOL_INSTS) );
-%}
-! !
-!Behavior methodsFor:'accessing'!
-name
-"although behaviors have no name, we return something
-useful here - there are many places (inspectors) where
-a classes name is asked for.
-Implementing this message here allows anonymous classes
-and instances of them to be inspected."
-^ 'someBehavior'
-!
-displayString
-"although behaviors have no name, we return something
-useful here - there are many places (inspectors) where
-a classes name is asked for.
-Implementing this message here allows instances of anonymous classes
-to show a reasonable name."
-^ 'someBehavior'
-!
-category
-"return the category of the class.
-Returning nil here, since Behavior does not define a category
-(only ClassDescriptions do)."
-^ nil
-"
-Point category
-Behavior new category
-"
-!
-superclass
-"return the receivers superclass"
-^ superclass
-!
-selectorArray
-"return the receivers selector array.
-Notice: this is not compatible with ST-80."
-^ selectorArray
-!
-selectors
-"return the receivers selector array as an orderedCollection.
-Notice: this may not be compatible with ST-80.
-(should we return a Set ?)"
-^ selectorArray asOrderedCollection
-!
-methodArray
-"return the receivers method array.
-Notice: this is not compatible with ST-80."
-^ methodArray
-!
-methodDictionary
-"return the receivers method dictionary.
-Since no dictionary is actually present, create one for ST-80 compatibility."
-|dict n "{ Class: SmallInteger }"|
-dict := IdentityDictionary new.
-n := selectorArray size.
-1 to:n do:[:index |
-	dict at:(selectorArray at:index) put:(methodArray at:index)
-].
-^ dict
-!
-implicit_methodDict
-"ST-80 compatibility.
-This allows subclasses to assume there is an instance variable
-named methodDict."
-^ self methodDictionary
-!
-implicit_methodDict:aDictionary
-"ST-80 compatibility.
-This allows subclasses to assume there is an instance variable
-named methodDict."
-^ self error:'not allowed to set the methodDictionary'
-!
-instSize
-"return the number of instance variables of the receiver.
-This includes all superclass instance variables."
-^ instSize
-!
-flags
-"return the receivers flag bits"
-^ flags
-!
-superclass:aClass
-"set the superclass - this actually creates a new class,
-recompiling all methods for the new one. The receiving class stays
-around anonymous to allow existing instances some life.
-This may change in the future (adjusting existing instances)"
-SubclassInfo := nil.
-"must flush caches since lookup chain changes"
-ObjectMemory flushCaches.
-"
-superclass := aClass
-"
-"for correct recompilation, just create a new class ..."
-aClass subclass:(self name)
-	   instanceVariableNames:(self instanceVariableString)
-	   classVariableNames:(self classVariableString)
-	   poolDictionaries:''
-	   category:self category
-!
-addSuperclass:aClass
-"EXPERIMENTAL MI support: add aClass to the set of classes, from which instances
-inherit protocol."
-"first, check if the class is abstract -
-allows abstract mixins are allowed in the current implementation"
-aClass instSize == 0 ifFalse:[
-	self error:'only abstract mixins allowed'.
-	^ self
-].
-otherSuperclasses isNil ifTrue:[
-	otherSuperclasses := Array with:aClass
-] ifFalse:[
-	otherSuperclasses := otherSuperclasses copyWith:aClass
-].
-SubclassInfo := nil.
-ObjectMemory flushCaches
-!
-removeSuperclass:aClass
-"EXPERIMENTAL MI support: remove aClass from the set of classes, from which instances
-inherit protocol."
-otherSuperclasses notNil ifTrue:[
-	otherSuperclasses := otherSuperclasses copyWithout:aClass.
-	otherSuperclasses isEmpty ifTrue:[
-	    otherSuperclasses := nil
-	].
-	SubclassInfo := nil.
-	ObjectMemory flushCaches
-].
-!
-selectors:newSelectors methods:newMethods
-"set both selector array and method array of the receiver,
-and flush caches"
-ObjectMemory flushCaches.
-selectorArray := newSelectors.
-methodArray := newMethods
-!
-addSelector:newSelector withMethod:newMethod
-"add the method given by 2nd argument under the selector given by
-1st argument to the methodDictionary. Flush all caches."
-|nargs|
-(self primAddSelector:newSelector withMethod:newMethod) ifFalse:[^ false].
-self changed:#methodDictionary with:newSelector.
-"
-if I have no subclasses, all we have to flush is cached
-data for myself ... (actually, in any case all that needs
-to be flushed is info for myself and all of my subclasses)
-"
-"
-problem: this is slower; since looking for all subclasses is (currently)
-	     a bit slow :-(
-	     We need the hasSubclasses-info bit in Behavior; now
-self withAllSubclassesDo:[:aClass |
-	ObjectMemory flushInlineCachesFor:aClass withArgs:nargs.
-	ObjectMemory flushMethodCacheFor:aClass
-].
-"
-"
-actually, we would do better with less flushing ...
-"
-nargs := newSelector numArgs.
-ObjectMemory flushMethodCache.
-ObjectMemory flushInlineCachesWithArgs:nargs.
-^ true
-!
-addSelector:newSelector withLazyMethod:newMethod
-"add the method given by 2nd argument under the selector given by
-1st argument to the methodDictionary. Since it does not flush
-any caches, this is only allowed for lazy methods."
-newMethod isLazyMethod ifFalse:[
-	self error:'operation only allowed for lazy methods'.
-	^ false
-].
-"/ oops: we must flush, if this method already exists ...
-(selectorArray includes:newSelector) ifTrue:[
-	ObjectMemory flushCaches
-].
-(self primAddSelector:newSelector withMethod:newMethod) ifTrue:[
-	self changed:#methodDictionary with:newSelector.
-	^ true
-].
-^ false
-!
-removeSelector:aSelector
-"remove the selector, aSelector and its associated method
-from the methodDictionary"
-|index oldSelectorArray oldMethodArray newSelectorArray newMethodArray|
-index := selectorArray identityIndexOf:aSelector startingAt:1.
-(index == 0) ifTrue:[^ false].
-newSelectorArray := selectorArray copyWithoutIndex:index.
-newMethodArray := methodArray copyWithoutIndex:index.
-oldSelectorArray := selectorArray.
-oldMethodArray := methodArray.
-selectorArray := newSelectorArray.
-methodArray := newMethodArray.
-"
-[
-	|nargs|
-	nargs := aSelector numArgs.
-	ObjectMemory flushMethodCache.
-	ObjectMemory flushInlineCachesWithArgs:nargs.
-] value
-"
-"
-actually, we would do better with less flushing ...
-"
-ObjectMemory flushCaches.
-^ true
-! !
-!Behavior methodsFor:'queries'!
-sizeOfInst:n
-"return the number of bytes required for an instance of
-myself with n indexed instance variables. The argument n
-should be zero for classes without indexed instance variables.
-See Behavior>>niceNew: for an application of this."
-|nInstvars|
-nInstvars := self instSize.
-%{
-int nBytes;
-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:
-		nBytes += nIndex * sizeof(short);
-		if (nBytes & (ALIGN - 1)) {
-		    nBytes = (nBytes & ~(ALIGN - 1)) + ALIGN;
-		}
-		break;
-	    case LONGARRAY:
-		nBytes += nIndex * sizeof(long);
-		break;
-	    case FLOATARRAY:
-		nBytes += nIndex * sizeof(float);
-		break;
-	    case DOUBLEARRAY:
-		nBytes += nIndex * sizeof(double);
-		break;
-	    default:
-		nBytes += nIndex * sizeof(OBJ);
-		break;
-	}
-}
-RETURN (_MKSMALLINT(nBytes));
-%}
-!
-isVariable
-"return true, if instances have indexed instance variables"
-"this could also be defined as:
-	^ (flags bitAnd:(Behavior maskIndexType)) ~~ 0
-"
-%{  /* NOCONTEXT */
-RETURN ( (_intVal(_INST(flags)) & ARRAYMASK) ? true : false );
-%}
-!
-isFixed
-"return true, if instances do not have indexed instance variables"
-"this could also be defined as:
-	^ self isVariable not
-"
-%{  /* NOCONTEXT */
-RETURN ( (_intVal(_INST(flags)) & ARRAYMASK) ? false : true );
-%}
-!
-isBits
-"return true, if instances have indexed byte or short instance variables.
-Ignore long, float and double arrays, since ST-80 code using isBits are probably
-not prepared to handle them correctly."
-%{  /* NOCONTEXT */
-REGISTER int flags;
-RETURN ( (((flags = (_intVal(_INST(flags)) & ARRAYMASK)) == BYTEARRAY)
-	     || (flags == WORDARRAY)) ? true : false );
-%}
-!
-isBytes
-"return true, if instances have indexed byte instance variables"
-"this could also be defined as:
-	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagBytes
-"
-%{  /* NOCONTEXT */
-RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == BYTEARRAY) ? true : false );
-%}
-!
-isWords
-"return true, if instances have indexed short instance variables"
-"this could also be defined as:
-	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagWords
-"
-%{  /* NOCONTEXT */
-RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == WORDARRAY) ? true : false );
-%}
-!
-isLongs
-"return true, if instances have indexed long instance variables"
-"this could also be defined as:
-	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagLongs
-"
-%{  /* NOCONTEXT */
-RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == LONGARRAY) ? true : false );
-%}
-!
-isFloats
-"return true, if instances have indexed float instance variables"
-"this could also be defined as:
-	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagFloats
-"
-%{  /* NOCONTEXT */
-RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == FLOATARRAY) ? true : false );
-%}
-!
-isDoubles
-"return true, if instances have indexed double instance variables"
-"this could also be defined as:
-	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagDoubles
-"
-%{  /* NOCONTEXT */
-RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == DOUBLEARRAY) ? true : false );
-%}
-!
-isPointers
-"return true, if instances have pointer instance variables
-i.e. are either non-indexed or have indexed pointer variables"
-"QUESTION: should we ignore WeakPointers ?"
-%{  /* NOCONTEXT */
-REGISTER int flags;
-flags = _intVal(_INST(flags)) & ARRAYMASK;
-switch (flags) {
-	default:
-	    /* normal objects */
-	    RETURN ( true );
-	case BYTEARRAY:
-	case WORDARRAY:
-	case LONGARRAY:
-	case FLOATARRAY:
-	case DOUBLEARRAY:
-	    RETURN (false );
-	case WKPOINTERARRAY:
-	    /* what about those ? */
-	    RETURN (true );
-}
-%}
-!
-isBehavior
-"return true, if the receiver is describing another objects behavior,
-i.e. is a class. Defined to avoid the need to use isKindOf:"
-^ true
-"
-True isBehavior
-true isBehavior
-"
-!
-canBeSubclassed
-"return true, if its allowed to create subclasses of the receiver.
-This method is redefined in SmallInteger and UndefinedObject, since
-instances are detected by their pointer-fields, i.e. they do not have
-a class entry (you dont have to understand this :-)"
-^ true
-!
-hasMultipleSuperclasses
-"Return true, if this class inherits from other classes
-(beside its primary superclass).
-This method is a preparation for a future multiple inheritance extension
-- currently it is not supported by the VM"
-^ otherSuperclasses notNil
-!
-superclasses
-"return a collection of the receivers immediate superclasses.
-This method is a preparation for a future multiple inheritance extension
-- currently it is not supported by the VM"
-|a|
-a := Array with:superclass.
-otherSuperclasses notNil ifTrue:[
-	^ a , otherSuperclasses
-].
-^ a
-"
-String superclasses
-"
-!
-allSuperclasses
-"return a collection of the receivers accumulated superclasses"
-|aCollection theSuperClass|
-theSuperClass := superclass.
-theSuperClass notNil ifTrue:[
-	aCollection := OrderedCollection new.
-	[theSuperClass notNil] whileTrue:[
-	    aCollection add:theSuperClass.
-	    theSuperClass := theSuperClass superclass
-	]
-].
-^ aCollection
-"
-String allSuperclasses
-"
-!
-withAllSuperclasses
-"return a collection containing the receiver and all
-of the receivers accumulated superclasses"
-|aCollection theSuperClass|
-aCollection := OrderedCollection with:self.
-theSuperClass := superclass.
-[theSuperClass notNil] whileTrue:[
-	aCollection add:theSuperClass.
-	theSuperClass := theSuperClass superclass
-].
-^ aCollection
-"
-String withAllSuperclasses
-"
-!
-subclasses
-"return a collection of the direct subclasses of the receiver"
-|newColl|
-SubclassInfo notNil ifTrue:[
-	newColl := SubclassInfo at:self ifAbsent:nil.
-	newColl notNil ifTrue:[^ newColl asOrderedCollection]
-].
-newColl := OrderedCollection new.
-self subclassesDo:[:aClass |
-	newColl add:aClass
-].
-^ newColl
-"
-Collection subclasses
-"
-!
-allSubclasses
-"return a collection of all subclasses (direct AND indirect) of
-the receiver. There will be no specific order, in which entries
-are returned."
-|newColl|
-newColl := OrderedCollection new.
-self allSubclassesDo:[:aClass |
-	newColl add:aClass
-].
-^ newColl
-"
-Collection allSubclasses
-"
-!
-allSubclassesInOrder
-"return a collection of all subclasses (direct AND indirect) of
-the receiver. Higher level subclasses will come before lower ones."
-|newColl|
-newColl := OrderedCollection new.
-self allSubclassesInOrderDo:[:aClass |
-	newColl add:aClass
-].
-^ newColl
-"
-Collection allSubclassesInOrder
-"
-!
-withAllSubclasses
-"return a collection containing the receiver and
-all subclasses (direct AND indirect) of the receiver"
-|newColl|
-newColl := OrderedCollection with:self.
-self allSubclassesDo:[:aClass |
-	newColl add:aClass
-].
-^ newColl
-"
-Collection withAllSubclasses
-"
-!
-isSubclassOf:aClass
-"return true, if I am a subclass of the argument, aClass"
-|theClass|
-theClass := superclass.
-[theClass notNil] whileTrue:[
-	(theClass == aClass) ifTrue:[^ true].
-%{
-	if (__isBehaviorLike(theClass)) {
-	    theClass = __ClassInstPtr(theClass)->c_superclass;
-	} else {
-	    theClass = nil;
-	}
-%}.
-"/        theClass := theClass superclass.
-].
-^ false
-"
-String isSubclassOf:Collection
-LinkedList isSubclassOf:Array
-1 isSubclassOf:Number              <- will fail since 1 is no class
-"
-!
-allInstVarNames
-"return a collection of all the instance variable name-strings
-this includes all superclass-instance variables.
-Since Behavior has no idea of instvar-names, return an empty collection
-here. Redefined in ClassDescription."
-^ #()
-!
-allClassVarNames
-"return a collection of all the class variable name-strings
-this includes all superclass-class variables.
-Since Behavior has no idea of classvar-names, return an empty collection
-here. Redefined in ClassDescription."
-^ #()
-!
-allInstances
-"return a collection of all my instances"
-"Read the documentation on why there seem to be no
-instances of SmallInteger and UndefinedObject"
-|coll|
-coll := OrderedCollection new:100.
-self allInstancesDo:[:anObject |
-	coll add:anObject
-].
-^ coll
-"
-ScrollBar allInstances
-"
-!
-allSubInstances
-"return a collection of all instances of myself and
-instances of all subclasses of myself."
-|coll|
-coll := OrderedCollection new:100.
-self allSubInstancesDo:[:anObject |
-	(anObject isKindOf:self) ifTrue:[
-	    coll add:anObject
-	]
-].
-^ coll
-"
-View allSubInstances
-"
-!
-allDerivedInstances
-"return a collection of all instances of myself and
-instances of all subclasses of myself.
-This method is going to be removed for protocol compatibility with
-other STs; use allSubInstances"
-self obsoleteMethodWarning:'please use #allSubInstances'.
-^ self allSubInstances
-!
-hasInstances
-"return true, if there are any instances of myself"
-"Read the documentation on why there seem to be no
-instances of SmallInteger and UndefinedObject"
-"/    ObjectMemory allObjectsDo:[:anObject |
-"/        (anObject class == self) ifTrue:[
-"/            ^ true
-"/        ]
-"/    ].
-ObjectMemory allInstancesOf:self do:[:anObject |
-	    ^ true
-].
-^ false
-"
-Object hasInstances
-SequenceableCollection hasInstances
-Float hasInstances
-SmallInteger hasInstances
-"
-!
-instanceCount
-"return the number of instances of myself."
-"Read the documentation on why there seem to be no
-instances of SmallInteger and UndefinedObject"
-|count|
-count := 0.
-"/    ObjectMemory allObjectsDo:[:anObject |
-"/        (anObject class == self) ifTrue:[
-"/            count := count + 1
-"/        ]
-"/    ].
-ObjectMemory allInstancesOf:self do:[:anObject |
-	count := count + 1
-].
-^ count
-"
-View instanceCount
-Object instanceCount
-Float instanceCount
-SequenceableCollection instanceCount
-SmallInteger instanceCount   .... mhmh - hear, hear
-"
-!
-derivedInstanceCount
-"return the number of instances of myself and of subclasses"
-|count|
-count := 0.
-ObjectMemory allObjectsDo:[:anObject |
-	(anObject isKindOf:self) ifTrue:[
-	    count := count + 1
-	]
-].
-^ count
-"
-View derivedInstanceCount
-SequenceableCollection derivedInstanceCount
-"
-!
-selectorIndex:aSelector
-"return the index in the arrays for given selector aSelector"
-^ selectorArray identityIndexOf:aSelector startingAt:1
-!
-includesSelector:aSelector
-"for ST-80 compatibility"
-^ self implements:aSelector
-!
-compiledMethodAt:aSelector
-"return the method for given selector aSelector or nil.
-Only methods in the receiver - not in the superclass chain are tested."
-|index|
-selectorArray isNil ifTrue:[
-	('oops: nil selectorArray in ' , self name) errorPrintNL.
-	^ nil
-].
-index := selectorArray identityIndexOf:aSelector startingAt:1.
-(index == 0) ifTrue:[^ nil].
-^ methodArray at:index
-"
-Object compiledMethodAt:#==
-(Object compiledMethodAt:#==) category
-"
-!
-sourceCodeAt:aSelector
-"return the methods source for given selector aSelector or nil.
-Only methods in the receiver - not in the superclass chain are tested."
-|method|
-method := self compiledMethodAt:aSelector.
-method isNil ifTrue:[^ nil].
-^ method source
-"
-True sourceCodeAt:#ifTrue:
-Object sourceCodeAt:#==
-Behavior sourceCodeAt:#sourceCodeAt:
-"
-!
-lookupMethodFor:aSelector
-"return the method, which would be executed if aSelector was sent to
-an instance of the receiver. I.e. the selector arrays of the receiver
-and all of its superclasses are searched for aSelector.
-Return the method, or nil if instances do not understand aSelector.
-EXPERIMENTAL: take care of multiple superclasses."
-|m cls|
-cls := self.
-[cls notNil] whileTrue:[
-	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
-	]
-].
-^ nil
-!
-cachedLookupMethodFor:aSelector
-"return the method, which would be executed if aSelector was sent to
-an instance of the receiver. I.e. the selector arrays of the receiver
-and all of its superclasses are searched for aSelector.
-Return the method, or nil if instances do not understand aSelector.
-This interface provides exactly the same information as #lookupMethodFor:,
-but uses the lookup-cache in the VM for faster search.
-However, keep in mind, that doing a lookup through the cache also adds new
-entries and can thus slow down the system by polluting the cache with
-irrelevant entries. (do NOT loop over all objects calling this method).
-Does NOT (currently) handle MI"
-%{  /* NOCONTEXT */
-extern OBJ __lookup();
-RETURN ( __lookup(self, aSelector, SENDER) );
-%}
-"
-String cachedLookupMethodFor:#=
-String cachedLookupMethodFor:#asOrderedCollection
-"
-!
-hasMethods
-"return true, if there are any (local) methods in this class"
-^ (methodArray size ~~ 0)
-"
-True hasMethods
-True class hasMethods
-"
-!
-implements:aSelector
-"return true, if the receiver implements aSelector.
-(i.e. implemented in THIS class - NOT in a superclass).
-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."
-^ (selectorArray identityIndexOf:aSelector startingAt:1) ~~ 0
-"
-True implements:#ifTrue:
-True implements:#==
-"
-!
-canUnderstand:aSelector
-"return true, if the receiver or one of its superclasses implements aSelector.
-(i.e. true if my instances understand aSelector)"
-^ (self lookupMethodFor:aSelector) notNil
-"
-True canUnderstand:#ifTrue:
-True canUnderstand:#==
-True canUnderstand:#do:
-"
-!
-whichClassImplements:aSelector
-"obsolete interface;
-use whichClassIncludesSelector: for ST-80 compatibility."
-^ self whichClassIncludesSelector:aSelector
-!
-whichClassIncludesSelector:aSelector
-"return the class in the inheritance chain, which implements the method
-for aSelector; return nil if none.
-EXPERIMENTAL: handle multiple superclasses"
-|cls|
-cls := self.
-[cls notNil] whileTrue:[
-	(cls implements: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
-"
-String whichClassIncludesSelector:#==
-String whichClassIncludesSelector:#collect:
-"
-!
-inheritsFrom:aClass
-"return true, if the receiver inherits methods from aClass"
-^ self isSubclassOf:aClass
-"
-True inheritsFrom:Object
-LinkedList inheritsFrom:Array
-"
-!
-selectorAtMethod:aMethod ifAbsent:failBlock
-"return the selector for given method aMethod
-or the value of failBlock, if not found."
-|index|
-index := methodArray identityIndexOf:aMethod startingAt:1.
-(index == 0) ifTrue:[^ failBlock value].
-^ selectorArray at:index
-"
-|m|
-m := Object compiledMethodAt:#copy.
-Object selectorAtMethod:m ifAbsent:['oops'].
-"
-"
-|m|
-m := Object compiledMethodAt:#copy.
-Fraction selectorAtMethod:m ifAbsent:['oops'].
-"
-!
-selectorAtMethod:aMethod
-"Return the selector for given method aMethod."
-^ self selectorAtMethod:aMethod ifAbsent:[nil]
-"
-|m|
-m := Object compiledMethodAt:#copy.
-Fraction selectorAtMethod:m.
-"
-"
-|m|
-m := Object compiledMethodAt:#copy.
-Object selectorAtMethod:m.
-"
-!
-containsMethod:aMethod
-"Return true, if the argument, aMethod is a method of myself"
-methodArray isNil ifTrue:[^ false].  "degenerated class"
-^ (methodArray identityIndexOf:aMethod startingAt:1) ~~ 0
-! !
 !Behavior methodsFor:'private accessing'!
-setSuperclass:sup selectors:sels methods:m instSize:i flags:f
+flags:aNumber
-"set some inst vars.
+"set the flags.
-this method is for special uses only - there will be no recompilation
-and no change record is written here. Also, if the receiver class has
-already been in use, future operation of the system is not guaranteed to
-be correct, since no caches are flushed.
-Therefore: do NOT use it; use Behavior>>superclass: (or flush the caches, at least)"
-SubclassInfo := nil.
-superclass := sup.
-selectorArray := sels.
-methodArray := m.
-instSize := i.
-flags := f
-!
-setSuperclass:aClass
-"set the superclass of the receiver.
-this method is for special uses only - there will be no recompilation
-and no change record written here. Also, if the receiver class has
-already been in use, future operation of the system is not guaranteed to
-be correct, since no caches are flushed.
-Therefore: do NOT use it; use Behavior>>superclass: (or flush the caches, at least)"
-SubclassInfo := nil.
-superclass := aClass
-!
-setOtherSuperclasses:anArrayOfClasses
-"EXPERIMENTAL: set the other superclasses of the receiver.
 this method is for special uses only - there will be no recompilation
 and no change record written here;
 Do NOT use it."
-SubclassInfo := nil.
+flags := aNumber
-otherSuperclasses := anArrayOfClasses
 !
 instSize:aNumber
 "set the instance size.
 this method is for special uses only - there will be no recompilation
 and no change record written here;
 Do NOT use it."
 instSize := aNumber
-!
-flags:aNumber
-"set the flags.
-this method is for special uses only - there will be no recompilation
-and no change record written here;
-Do NOT use it."
-flags := aNumber
-!
-setSelectors:sels methods:m
-"set some inst vars.
-this method is for special uses only - there will be no recompilation
-and no change record written here;
-Do NOT use it."
-selectorArray := sels.
-methodArray := m.
-!
-setSelectorArray:anArray
-"set the selector array of the receiver.
-this method is for special uses only - there will be no recompilation
-and no change record written here.
-NOT for general use."
-selectorArray := anArray
-!
-setMethodArray:anArray
-"set the method array of the receiver.
-this method is for special uses only - there will be no recompilation
-and no change record written here.
-NOT for general use."
-methodArray := anArray
-!
-setMethodDictionary:aDictionary
-"set the receivers method dictionary.
-Since no dictionary is actually used, decompose into selector- and
-method arrays and set those. For ST-80 compatibility.
-NOT for general use."
-|n newSelectorArray newMethodArray idx|
-n := aDictionary size.
-newSelectorArray := Array basicNew:n.
-newMethodArray := Array basicNew:n.
-idx := 1.
-aDictionary keysAndValuesDo:[:sel :method |
-	newSelectorArray at:idx put:sel.
-	newMethodArray at:idx put:method.
-	idx := idx + 1
-].
-selectorArray := newSelectorArray.
-methodArray := newMethodArray
 !
 primAddSelector:newSelector withMethod:newMethod
 "add the method given by 2nd argument under the selector given by
 the 1st argument to the methodDictionary.
 	methodArray := newMethodArray
 ] ifFalse:[
 	methodArray at:index put:newMethod
 ].
 ^ true
+!
+setMethodArray:anArray
+"set the method array of the receiver.
+this method is for special uses only - there will be no recompilation
+and no change record written here.
+NOT for general use."
+methodArray := anArray
+!
+setMethodDictionary:aDictionary
+"set the receivers method dictionary.
+Since no dictionary is actually used, decompose into selector- and
+method arrays and set those. For ST-80 compatibility.
+NOT for general use."
+|n newSelectorArray newMethodArray idx|
+n := aDictionary size.
+newSelectorArray := Array basicNew:n.
+newMethodArray := Array basicNew:n.
+idx := 1.
+aDictionary keysAndValuesDo:[:sel :method |
+	newSelectorArray at:idx put:sel.
+	newMethodArray at:idx put:method.
+	idx := idx + 1
+].
+selectorArray := newSelectorArray.
+methodArray := newMethodArray
+!
+setOtherSuperclasses:anArrayOfClasses
+"EXPERIMENTAL: set the other superclasses of the receiver.
+this method is for special uses only - there will be no recompilation
+and no change record written here;
+Do NOT use it."
+SubclassInfo := nil.
+otherSuperclasses := anArrayOfClasses
+!
+setSelectorArray:anArray
+"set the selector array of the receiver.
+this method is for special uses only - there will be no recompilation
+and no change record written here.
+NOT for general use."
+selectorArray := anArray
+!
+setSelectors:sels methods:m
+"set some inst vars.
+this method is for special uses only - there will be no recompilation
+and no change record written here;
+Do NOT use it."
+selectorArray := sels.
+methodArray := m.
+!
+setSuperclass:aClass
+"set the superclass of the receiver.
+this method is for special uses only - there will be no recompilation
+and no change record written here. Also, if the receiver class has
+already been in use, future operation of the system is not guaranteed to
+be correct, since no caches are flushed.
+Therefore: do NOT use it; use Behavior>>superclass: (or flush the caches, at least)"
+SubclassInfo := nil.
+superclass := aClass
+!
+setSuperclass:sup selectors:sels methods:m instSize:i flags:f
+"set some inst vars.
+this method is for special uses only - there will be no recompilation
+and no change record is written here. Also, if the receiver class has
+already been in use, future operation of the system is not guaranteed to
+be correct, since no caches are flushed.
+Therefore: do NOT use it; use Behavior>>superclass: (or flush the caches, at least)"
+SubclassInfo := nil.
+superclass := sup.
+selectorArray := sels.
+methodArray := m.
+instSize := i.
+flags := f
 ! !
-!Behavior methodsFor:'compiler interface'!
+!Behavior methodsFor:'queries'!
-compiler
+allClassVarNames
-"return the compiler to use for this class.
+"return a collection of all the class variable name-strings
-OBSOLETE: This is the old ST/X interface, kept for migration.
+this includes all superclass-class variables.
-	       Dont use it - it will vanish."
+Since Behavior has no idea of classvar-names, return an empty collection
+here. Redefined in ClassDescription."
-^ self compilerClass
-!
+^ #()
+!
-compilerClass
-"return the compiler to use for this class -
+allDerivedInstances
-this can be redefined in special classes, to get classes with
+"return a collection of all instances of myself and
-Lisp, Prolog, ASN1, Basic :-) or whatever syntax."
+instances of all subclasses of myself.
+This method is going to be removed for protocol compatibility with
-^ Compiler
+other STs; use allSubInstances"
-!
+self obsoleteMethodWarning:'please use #allSubInstances'.
-evaluatorClass
+^ self allSubInstances
-"return the compiler to use for expression evaluation for this class -
+!
-this can be redefined in special classes, to get classes with
-Lisp, Prolog, ASN1, Basic :-) or whatever syntax."
+allInstVarNames
+"return a collection of all the instance variable name-strings
-^ Compiler
+this includes all superclass-instance variables.
-! !
+Since Behavior has no idea of instvar-names, return an empty collection
+here. Redefined in ClassDescription."
-!Behavior methodsFor:'enumerating'!
+^ #()
-allInstancesDo:aBlock
+!
-"evaluate aBlock for all of my instances"
+allInstances
+"return a collection of all my instances"
+"Read the documentation on why there seem to be no
+instances of SmallInteger and UndefinedObject"
+|coll|
+coll := OrderedCollection new:100.
+self allInstancesDo:[:anObject |
+	coll add:anObject
+].
+^ coll
+"
+ScrollBar allInstances
+"
+!
+allSubInstances
+"return a collection of all instances of myself and
+instances of all subclasses of myself."
+|coll|
+coll := OrderedCollection new:100.
+self allSubInstancesDo:[:anObject |
+	(anObject isKindOf:self) ifTrue:[
+	    coll add:anObject
+	]
+].
+^ coll
+"
+View allSubInstances
+"
+!
+allSubclasses
+"return a collection of all subclasses (direct AND indirect) of
+the receiver. There will be no specific order, in which entries
+are returned."
+|newColl|
+newColl := OrderedCollection new.
+self allSubclassesDo:[:aClass |
+	newColl add:aClass
+].
+^ newColl
+"
+Collection allSubclasses
+"
+!
+allSubclassesInOrder
+"return a collection of all subclasses (direct AND indirect) of
+the receiver. Higher level subclasses will come before lower ones."
+|newColl|
+newColl := OrderedCollection new.
+self allSubclassesInOrderDo:[:aClass |
+	newColl add:aClass
+].
+^ newColl
+"
+Collection allSubclassesInOrder
+"
+!
+allSuperclasses
+"return a collection of the receivers accumulated superclasses"
+|aCollection theSuperClass|
+theSuperClass := superclass.
+theSuperClass notNil ifTrue:[
+	aCollection := OrderedCollection new.
+	[theSuperClass notNil] whileTrue:[
+	    aCollection add:theSuperClass.
+	    theSuperClass := theSuperClass superclass
+	]
+].
+^ aCollection
+"
+String allSuperclasses
+"
+!
+cachedLookupMethodFor:aSelector
+"return the method, which would be executed if aSelector was sent to
+an instance of the receiver. I.e. the selector arrays of the receiver
+and all of its superclasses are searched for aSelector.
+Return the method, or nil if instances do not understand aSelector.
+This interface provides exactly the same information as #lookupMethodFor:,
+but uses the lookup-cache in the VM for faster search.
+However, keep in mind, that doing a lookup through the cache also adds new
+entries and can thus slow down the system by polluting the cache with
+irrelevant entries. (do NOT loop over all objects calling this method).
+Does NOT (currently) handle MI"
+%{  /* NOCONTEXT */
+extern OBJ __lookup();
+RETURN ( __lookup(self, aSelector, SENDER) );
+%}
+"
+String cachedLookupMethodFor:#=
+String cachedLookupMethodFor:#asOrderedCollection
+"
+!
+canBeSubclassed
+"return true, if its allowed to create subclasses of the receiver.
+This method is redefined in SmallInteger and UndefinedObject, since
+instances are detected by their pointer-fields, i.e. they do not have
+a class entry (you dont have to understand this :-)"
+^ true
+!
+canUnderstand:aSelector
+"return true, if the receiver or one of its superclasses implements aSelector.
+(i.e. true if my instances understand aSelector)"
+^ (self lookupMethodFor:aSelector) notNil
+"
+True canUnderstand:#ifTrue:
+True canUnderstand:#==
+True canUnderstand:#do:
+"
+!
+compiledMethodAt:aSelector
+"return the method for given selector aSelector or nil.
+Only methods in the receiver - not in the superclass chain are tested."
+|index|
+selectorArray isNil ifTrue:[
+	('oops: nil selectorArray in ' , self name) errorPrintNL.
+	^ nil
+].
+index := selectorArray identityIndexOf:aSelector startingAt:1.
+(index == 0) ifTrue:[^ nil].
+^ methodArray at:index
+"
+Object compiledMethodAt:#==
+(Object compiledMethodAt:#==) category
+"
+!
+containsMethod:aMethod
+"Return true, if the argument, aMethod is a method of myself"
+methodArray isNil ifTrue:[^ false].  "degenerated class"
+^ (methodArray identityIndexOf:aMethod startingAt:1) ~~ 0
+!
+derivedInstanceCount
+"return the number of instances of myself and of subclasses"
+|count|
+count := 0.
+ObjectMemory allObjectsDo:[:anObject |
+	(anObject isKindOf:self) ifTrue:[
+	    count := count + 1
+	]
+].
+^ count
+"
+View derivedInstanceCount
+SequenceableCollection derivedInstanceCount
+"
+!
+hasInstances
+"return true, if there are any instances of myself"
+"Read the documentation on why there seem to be no
+instances of SmallInteger and UndefinedObject"
 "/    ObjectMemory allObjectsDo:[:anObject |
 "/        (anObject class == self) ifTrue:[
-"/            aBlock value:anObject
+"/            ^ true
 "/        ]
-"/    ]
+"/    ].
 ObjectMemory allInstancesOf:self do:[:anObject |
-	aBlock value:anObject
+	    ^ true
-]
+].
+^ false
-"
-StandardSystemView allInstancesDo:[:v | Transcript showCr:(v name)]
+"
-"
+Object hasInstances
-!
+SequenceableCollection hasInstances
+Float hasInstances
-allDerivedInstancesDo:aBlock
+SmallInteger hasInstances
-"evaluate aBlock for all of my instances and all instances of subclasses.
+"
-This method is going to be removed for protocol compatibility with
+!
-other STs; use allSubInstancesDo:"
+hasMethods
-self obsoleteMethodWarning:'please use #allSubInstancesDo:'.
+"return true, if there are any (local) methods in this class"
-self allSubInstancesDo:aBlock
+^ (methodArray size ~~ 0)
-"
-StandardSystemView allDerivedInstancesDo:[:v | Transcript showCr:(v name)]
+"
-"
+True hasMethods
-!
+True class hasMethods
+"
-allSubInstancesDo:aBlock
+!
-"evaluate aBlock for all of my instances and all instances of subclasses"
+hasMultipleSuperclasses
-ObjectMemory allObjectsDo:[:anObject |
+"Return true, if this class inherits from other classes
-	(anObject isKindOf:self) ifTrue:[
+(beside its primary superclass).
-	    aBlock value:anObject
+This method is a preparation for a future multiple inheritance extension
-	]
+- currently it is not supported by the VM"
-]
+^ otherSuperclasses notNil
-"
+!
-StandardSystemView allSubInstancesDo:[:v | Transcript showCr:(v name)]
-"
+implements:aSelector
-!
+"return true, if the receiver implements aSelector.
+(i.e. implemented in THIS class - NOT in a superclass).
-subclassesDo:aBlock
+Dont use this method to check if someone responds to a message -
-"evaluate the argument, aBlock for all immediate subclasses.
+use #canUnderstand: on the class or #respondsTo: on the instance
-This will only enumerate globally known classes - for anonymous
+to do this."
-behaviors, you have to walk over all instances of Behavior."
+^ (selectorArray identityIndexOf:aSelector startingAt:1) ~~ 0
-|coll|
+"
-SubclassInfo isNil ifTrue:[
+True implements:#ifTrue:
-	Behavior subclassInfo
+True implements:#==
-].
+"
-SubclassInfo notNil ifTrue:[
+!
-	coll := SubclassInfo at:self ifAbsent:nil.
-	coll notNil ifTrue:[
+includesSelector:aSelector
-	    coll do:aBlock.
+"for ST-80 compatibility"
-	].
-	^ self
+^ self implements:aSelector
-].
+!
-Smalltalk allBehaviorsDo:[:aClass |
+inheritsFrom:aClass
-	(aClass superclass == self) ifTrue:[
+"return true, if the receiver inherits methods from aClass"
-	    aBlock value:aClass
-	]
+^ self isSubclassOf:aClass
-]
+"
-"
+True inheritsFrom:Object
-Collection subclassesDo:[:c | Transcript showCr:(c name)]
+LinkedList inheritsFrom:Array
 "
 !
-allSubclassesDo:aBlock
+instanceCount
-"evaluate aBlock for all of my subclasses.
+"return the number of instances of myself."
-There is no specific order, in which the entries are enumerated.
-This will only enumerate globally known classes - for anonymous
+"Read the documentation on why there seem to be no
-behaviors, you have to walk over all instances of Behavior."
+instances of SmallInteger and UndefinedObject"
-Smalltalk allBehaviorsDo:[:aClass |
+|count|
-	(aClass isSubclassOf:self) ifTrue:[
-	    aBlock value:aClass
+count := 0.
-	]
+"/    ObjectMemory allObjectsDo:[:anObject |
-]
+"/        (anObject class == self) ifTrue:[
+"/            count := count + 1
-"
+"/        ]
-Collection allSubclassesDo:[:c | Transcript showCr:(c name)]
+"/    ].
-"
+ObjectMemory allInstancesOf:self do:[:anObject |
-!
+	count := count + 1
+].
-allSubclassesInOrderDo:aBlock
+^ count
-"evaluate aBlock for all of my subclasses.
-Higher level subclasses will be enumerated before the deeper ones,
+"
-so the order in which aBlock gets called is ok to fileOut classes in
+View instanceCount
-correct order for later fileIn.
+Object instanceCount
-This will only enumerate globally known classes - for anonymous
+Float instanceCount
-behaviors, you have to walk over all instances of Behavior"
+SequenceableCollection instanceCount
+SmallInteger instanceCount   .... mhmh - hear, hear
-self subclassesDo:[:aClass |
+"
-	aBlock value:aClass.
+!
-	aClass allSubclassesInOrderDo:aBlock
-]
+isBehavior
+"return true, if the receiver is describing another objects behavior,
-"
+i.e. is a class. Defined to avoid the need to use isKindOf:"
-Collection allSubclassesInOrderDo:[:c | Transcript showCr:(c name)]
-"
+^ true
-!
+"
-allSuperclassesDo:aBlock
+True isBehavior
-"evaluate aBlock for all of my superclasses"
+true isBehavior
+"
+!
+isBits
+"return true, if instances have indexed byte or short instance variables.
+Ignore long, float and double arrays, since ST-80 code using isBits are probably
+not prepared to handle them correctly."
+%{  /* NOCONTEXT */
+REGISTER int flags;
+RETURN ( (((flags = (_intVal(_INST(flags)) & ARRAYMASK)) == BYTEARRAY)
+	     || (flags == WORDARRAY)) ? true : false );
+%}
+!
+isBytes
+"return true, if instances have indexed byte instance variables"
+"this could also be defined as:
+	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagBytes
+"
+%{  /* NOCONTEXT */
+RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == BYTEARRAY) ? true : false );
+%}
+!
+isDoubles
+"return true, if instances have indexed double instance variables"
+"this could also be defined as:
+	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagDoubles
+"
+%{  /* NOCONTEXT */
+RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == DOUBLEARRAY) ? true : false );
+%}
+!
+isFixed
+"return true, if instances do not have indexed instance variables"
+"this could also be defined as:
+	^ self isVariable not
+"
+%{  /* NOCONTEXT */
+RETURN ( (_intVal(_INST(flags)) & ARRAYMASK) ? false : true );
+%}
+!
+isFloats
+"return true, if instances have indexed float instance variables"
+"this could also be defined as:
+	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagFloats
+"
+%{  /* NOCONTEXT */
+RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == FLOATARRAY) ? true : false );
+%}
+!
+isLongs
+"return true, if instances have indexed long instance variables"
+"this could also be defined as:
+	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagLongs
+"
+%{  /* NOCONTEXT */
+RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == LONGARRAY) ? true : false );
+%}
+!
+isPointers
+"return true, if instances have pointer instance variables
+i.e. are either non-indexed or have indexed pointer variables"
+"QUESTION: should we ignore WeakPointers ?"
+%{  /* NOCONTEXT */
+REGISTER int flags;
+flags = _intVal(_INST(flags)) & ARRAYMASK;
+switch (flags) {
+	default:
+	    /* normal objects */
+	    RETURN ( true );
+	case BYTEARRAY:
+	case WORDARRAY:
+	case LONGARRAY:
+	case FLOATARRAY:
+	case DOUBLEARRAY:
+	    RETURN (false );
+	case WKPOINTERARRAY:
+	    /* what about those ? */
+	    RETURN (true );
+}
+%}
+!
+isSubclassOf:aClass
+"return true, if I am a subclass of the argument, aClass"
 |theClass|
 theClass := superclass.
 [theClass notNil] whileTrue:[
-	aBlock value:theClass.
+	(theClass == aClass) ifTrue:[^ true].
-	theClass := theClass superclass
+%{
-]
+	if (__isBehaviorLike(theClass)) {
+	    theClass = __ClassInstPtr(theClass)->c_superclass;
-"
+	} else {
-String allSuperclassesDo:[:c | Transcript showCr:(c name)]
+	    theClass = nil;
+	}
+%}.
+"/        theClass := theClass superclass.
+].
+^ false
+"
+String isSubclassOf:Collection
+LinkedList isSubclassOf:Array
+1 isSubclassOf:Number              <- will fail since 1 is no class
+"
+!
+isVariable
+"return true, if instances have indexed instance variables"
+"this could also be defined as:
+	^ (flags bitAnd:(Behavior maskIndexType)) ~~ 0
+"
+%{  /* NOCONTEXT */
+RETURN ( (_intVal(_INST(flags)) & ARRAYMASK) ? true : false );
+%}
+!
+isWords
+"return true, if instances have indexed short instance variables"
+"this could also be defined as:
+	^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagWords
+"
+%{  /* NOCONTEXT */
+RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == WORDARRAY) ? true : false );
+%}
+!
+lookupMethodFor:aSelector
+"return the method, which would be executed if aSelector was sent to
+an instance of the receiver. I.e. the selector arrays of the receiver
+and all of its superclasses are searched for aSelector.
+Return the method, or nil if instances do not understand aSelector.
+EXPERIMENTAL: take care of multiple superclasses."
+|m cls|
+cls := self.
+[cls notNil] whileTrue:[
+	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
+	]
+].
+^ nil
+!
+selectorAtMethod:aMethod
+"Return the selector for given method aMethod."
+^ self selectorAtMethod:aMethod ifAbsent:[nil]
+"
+|m|
+m := Object compiledMethodAt:#copy.
+Fraction selectorAtMethod:m.
+"
+"
+|m|
+m := Object compiledMethodAt:#copy.
+Object selectorAtMethod:m.
+"
+!
+selectorAtMethod:aMethod ifAbsent:failBlock
+"return the selector for given method aMethod
+or the value of failBlock, if not found."
+|index|
+index := methodArray identityIndexOf:aMethod startingAt:1.
+(index == 0) ifTrue:[^ failBlock value].
+^ selectorArray at:index
+"
+|m|
+m := Object compiledMethodAt:#copy.
+Object selectorAtMethod:m ifAbsent:['oops'].
+"
+"
+|m|
+m := Object compiledMethodAt:#copy.
+Fraction selectorAtMethod:m ifAbsent:['oops'].
+"
+!
+selectorIndex:aSelector
+"return the index in the arrays for given selector aSelector"
+^ selectorArray identityIndexOf:aSelector startingAt:1
+!
+sizeOfInst:n
+"return the number of bytes required for an instance of
+myself with n indexed instance variables. The argument n
+should be zero for classes without indexed instance variables.
+See Behavior>>niceNew: for an application of this."
+|nInstvars|
+nInstvars := self instSize.
+%{
+int nBytes;
+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:
+		nBytes += nIndex * sizeof(short);
+		if (nBytes & (ALIGN - 1)) {
+		    nBytes = (nBytes & ~(ALIGN - 1)) + ALIGN;
+		}
+		break;
+	    case LONGARRAY:
+		nBytes += nIndex * sizeof(long);
+		break;
+	    case FLOATARRAY:
+		nBytes += nIndex * sizeof(float);
+		break;
+	    case DOUBLEARRAY:
+		nBytes += nIndex * sizeof(double);
+		break;
+	    default:
+		nBytes += nIndex * sizeof(OBJ);
+		break;
+	}
+}
+RETURN (_MKSMALLINT(nBytes));
+%}
+!
+sourceCodeAt:aSelector
+"return the methods source for given selector aSelector or nil.
+Only methods in the receiver - not in the superclass chain are tested."
+|method|
+method := self compiledMethodAt:aSelector.
+method isNil ifTrue:[^ nil].
+^ method source
+"
+True sourceCodeAt:#ifTrue:
+Object sourceCodeAt:#==
+Behavior sourceCodeAt:#sourceCodeAt:
+"
+!
+subclasses
+"return a collection of the direct subclasses of the receiver"
+|newColl|
+SubclassInfo notNil ifTrue:[
+	newColl := SubclassInfo at:self ifAbsent:nil.
+	newColl notNil ifTrue:[^ newColl asOrderedCollection]
+].
+newColl := OrderedCollection new.
+self subclassesDo:[:aClass |
+	newColl add:aClass
+].
+^ newColl
+"
+Collection subclasses
+"
+!
+superclasses
+"return a collection of the receivers immediate superclasses.
+This method is a preparation for a future multiple inheritance extension
+- currently it is not supported by the VM"
+|a|
+a := Array with:superclass.
+otherSuperclasses notNil ifTrue:[
+	^ a , otherSuperclasses
+].
+^ a
+"
+String superclasses
+"
+!
+whichClassImplements:aSelector
+"obsolete interface;
+use whichClassIncludesSelector: for ST-80 compatibility."
+^ self whichClassIncludesSelector:aSelector
+!
+whichClassIncludesSelector:aSelector
+"return the class in the inheritance chain, which implements the method
+for aSelector; return nil if none.
+EXPERIMENTAL: handle multiple superclasses"
+|cls|
+cls := self.
+[cls notNil] whileTrue:[
+	(cls implements: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
+"
+String whichClassIncludesSelector:#==
+String whichClassIncludesSelector:#collect:
+"
+!
+withAllSubclasses
+"return a collection containing the receiver and
+all subclasses (direct AND indirect) of the receiver"
+|newColl|
+newColl := OrderedCollection with:self.
+self allSubclassesDo:[:aClass |
+	newColl add:aClass
+].
+^ newColl
+"
+Collection withAllSubclasses
+"
+!
+withAllSuperclasses
+"return a collection containing the receiver and all
+of the receivers accumulated superclasses"
+|aCollection theSuperClass|
+aCollection := OrderedCollection with:self.
+theSuperClass := superclass.
+[theSuperClass notNil] whileTrue:[
+	aCollection add:theSuperClass.
+	theSuperClass := theSuperClass superclass
+].
+^ aCollection
+"
+String withAllSuperclasses
 "
 ! !
-!Behavior methodsFor:'binary storage'!
+!Behavior methodsFor:'snapshots'!
-storeBinaryDefinitionOn: stream manager: manager
+postSnapshot
-"binary store of a classes definition.
+"sent by ObjectMemory, after a snapshot has been written.
-Classes will store the name only and restore by looking for
+Nothing done here."
-that name in the Smalltalk dictionary."
+!
-| myName |
+preSnapshot
+"sent by ObjectMemory, before a snapshot is written.
-myName := self name.
+Nothing done here."
-stream nextNumber:4 put:self signature.
-stream nextNumber:2 put:0.
-stream nextNumber:2 put:myName size.
-myName do:[:c|
-	stream nextPut:c asciiValue
-]
-"
-|s|
-s := WriteStream on:ByteArray new.
-#(1 2 3 4) storeBinaryOn:s.
-Object readBinaryFrom:(ReadStream on:s contents)
-|s|
-s := WriteStream on:ByteArray new.
-Rectangle storeBinaryOn:s.
-Object readBinaryFrom:(ReadStream on:s contents)
-"
-!
-readBinaryFrom:aStream
-"read an objects binary representation from the argument,
-aStream and return it.
-The read object must be a kind of myself, otherwise an error is raised.
-To get any object, use 'Object readBinaryFrom:...',
-To get any number, use 'Number readBinaryFrom:...' and so on.
-This is the reverse operation to 'storeBinaryOn:'. "
-^ self readBinaryFrom:aStream onError:[self error:('expected ' , self name)]
-"
-|s|
-s := WriteStream on:(ByteArray new).
-#(1 2 3 4) storeBinaryOn:s.
-Object readBinaryFrom:(ReadStream on:s contents)
-"
-"
-|s|
-s := 'testFile' asFilename writeStream binary.
-#(1 2 3 4) storeBinaryOn:s.
-'hello world' storeBinaryOn:s.
-s close.
-s := 'testFile' asFilename readStream binary.
-Transcript showCr:(Object readBinaryFrom:s).
-Transcript showCr:(Object readBinaryFrom:s).
-s close.
-"
-!
-readBinaryFrom:aStream onError:exceptionBlock
-"read an objects binary representation from the argument,
-aStream and return it.
-The read object must be a kind of myself, otherwise the value of
-the exceptionBlock is returned.
-To get any object, use 'Object readBinaryFrom:...',
-To get any number, use 'Number readBinaryFrom:...' and so on.
-This is the reverse operation to 'storeBinaryOn:'. "
-|newObject|
-newObject := (BinaryInputManager new:1024) readFrom:aStream.
-(newObject isKindOf:self) ifFalse:[^ exceptionBlock value].
-^ newObject
-"
-|s|
-s := WriteStream on:(ByteArray new).
-#(1 2 3 4) storeBinaryOn:s.
-Object readBinaryFrom:(ReadStream on:s contents) onError:['oops']
-"
-"
-|s|
-s := WriteStream on:(ByteArray new).
-#[1 2 3 4] storeBinaryOn:s.
-Array readBinaryFrom:(ReadStream on:s contents)  onError:['oops']
-"
-!
-binaryDefinitionFrom:stream manager:manager
-"sent during a binary read by the input manager.
-Read the definition on an empty instance (of my class) from stream.
-All pointer instances are left nil, while all bits are read in here.
-return the new object."
-|obj t
-basicSize "{ Class: SmallInteger }" |
-self isPointers ifTrue: [
-	"/
-	"/ inst size not needed - if you uncomment the line below,
-	"/ also uncomment the corresponding line in
-	"/ Object>>storeBinaryDefinitionOn:manager:
-	"/
-	"/ stream next. "skip instSize"
-	self isVariable ifTrue: [
-	    ^ self basicNew:(stream nextNumber:3)
-	].
-	^ self basicNew
-].
-"
-an object with bit-valued instance variables.
-These are read here.
-"
-basicSize := stream nextNumber:4.
-obj := self basicNew:basicSize.
-self isBytes ifTrue: [
-	stream nextBytes:basicSize into:obj
-] ifFalse: [
-	self isWords ifTrue: [
-	    1 to:basicSize do:[:i |
-		obj basicAt:i put:(stream nextNumber:2)
-	    ]
-	] ifFalse:[
-	    self isLongs ifTrue: [
-		1 to:basicSize do:[:i |
-		    obj basicAt:i put:(stream nextNumber:4)
-		]
-	    ] ifFalse:[
-		self isFloats ifTrue: [
-		    "could do it in one big read on machines which use IEEE floats ..."
-		    t := Float basicNew.
-		    1 to:basicSize do:[:i |
-			Float readBinaryIEEESingleFrom:stream into:t.
-			obj basicAt:i put: t
-		    ]
-		] ifFalse:[
-		    self isDoubles ifTrue: [
-			"could do it in one big read on machines which use IEEE doubles ..."
-			t := Float basicNew.
-			1 to:basicSize do:[:i |
-			    Float readBinaryIEEEDoubleFrom:stream into:t.
-			    obj basicAt:i put: t
-			]
-		    ]
-		]
-	    ]
-	]
-].
-^obj
-!
-canCloneFrom:anObject
-"return true, if this class can clone an obsolete object as retrieved
-by a binary load. Subclasses which do not want to have obsolete objects
-be converted, should redefine this method to return false.
-(However, conversion is never done silently in a binary load; you
-have to have a handler for the binaryload errors and for the conversion
-request signal.)"
-^ true
-!
-cloneFrom:aPrototype
-"return an instance of myself with variables initialized from
-a prototype. This is used when instances of obsolete classes are
-binary loaded and a conversion is done on the obsolete object.
-UserClasses may redefine this for better conversions."
-|newInst indexed myInfo otherInfo varIndexAssoc|
-indexed := false.
-aPrototype class isVariable ifTrue:[
-	self isVariable ifTrue:[
-	    indexed := true.
-	].
-	"otherwise, these are lost ..."
-].
-indexed ifTrue:[
-	newInst := self basicNew:aPrototype basicSize
-] ifFalse:[
-	newInst := self basicNew
-].
-myInfo := self instanceVariableOffsets.
-otherInfo := aPrototype class instanceVariableOffsets.
-myInfo keysAndValuesDo:[:name :index |
-	varIndexAssoc := otherInfo at:name ifAbsent:[].
-	varIndexAssoc notNil ifTrue:[
-	    newInst instVarAt:index put:(aPrototype instVarAt:(varIndexAssoc value))
-	]
-].
-indexed ifTrue:[
-	1 to:aPrototype basicSize do:[:index |
-	    newInst basicAt:index put:(aPrototype basicAt:index)
-	].
-].
-^ newInst
-"
-Class withoutUpdatingChangesDo:[
-	 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.
-]
-"
-"
-|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.
-]
-"
 ! !

changeset 620	c7353f86a302
parent 528	a083413dfbe8
child 642	dbf407bedf64