# HG changeset patch
# User Claus Gittinger <cg@exept.de>
# Date 817123595 -3600
# Node ID c7353f86a30216e38f1535d3b34885b4b348bd03
# Parent  95efb21c1fac4fab805ae86d150e8a48f1ae4edd
checkin from browser

diff -r 95efb21c1fac -r c7353f86a302 Autoload.st
--- a/Autoload.st	Thu Nov 23 03:13:03 1995 +0100
+++ b/Autoload.st	Thu Nov 23 11:46:35 1995 +0100
@@ -10,11 +10,11 @@
  hereby transferred.
 "
 
-Object subclass:#Autoload
-       instanceVariableNames:''
-       classVariableNames:'LazyLoading AutoloadFailedSignal LoadedClasses'
-       poolDictionaries:''
-       category:'Kernel-Classes'
+nil subclass:#Autoload
+	 instanceVariableNames:''
+	 classVariableNames:'LazyLoading AutoloadFailedSignal LoadedClasses'
+	 poolDictionaries:''
+	 category:'Kernel-Classes'
 !
 
 !Autoload class methodsFor:'documentation'!
@@ -31,10 +31,6 @@
  other person.  No title to or ownership of the software is
  hereby transferred.
 "
-! 
-
-version
-    ^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.29 1995-11-11 14:26:46 cg Exp $'
 !
 
 documentation
@@ -60,6 +56,10 @@
 	AutoloadFailedSignal    <Signal>        signal raised if an autoloaded 
 						classes source is not available.
 "
+!
+
+version
+    ^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.30 1995-11-23 10:44:41 cg Exp $'
 ! !
 
 !Autoload class methodsFor:'initialization'!
@@ -83,51 +83,8 @@
     ^ AutoloadFailedSignal
 ! !
 
-!Autoload class methodsFor:'queries'!
-
-isBehavior
-    "return true if the recevier is some kind of class.
-     Autoloaded classes are definitely; therefore return true."
-
-    ^ true
-!
-
-isLoaded
-    "return true, if the class has been loaded; redefined in Autoload;
-     see comment there. this allows testing for a class been already loaded."
-
-    ^ (self == Autoload)
-!
-
-wasAutoloaded:aClass
-    ^ LoadedClasses notNil and:[LoadedClasses includes:aClass]
-! !
-
-!Autoload class methodsFor:'lazy compilation'!
-
-compileLazy
-    "return the lazy loading flag - if on, fileIn is much faster,
-     but pauses are to be expected later, since methods are compiled
-     when first executed."
-
-    ^ LazyLoading
-!
-
-compileLazy:aBoolean
-    "turn on/off lazy loading - if on, fileIn is much faster,
-     but pauses are to be expected later, since methods are compiled
-     when first executed.
-     If you like it, add a line to your startup file."
-
-    LazyLoading := aBoolean
-! !
-
 !Autoload class methodsFor:'adding/removing autoloaded classes'!
 
-removeClass:aClass
-    LoadedClasses remove:aClass ifAbsent:[]
-!
-
 addClass:aClassName
     self addClass:aClassName inCategory:'autoloaded-Classes'
 
@@ -150,6 +107,87 @@
     "
      Autoload addClass:'Clock' inCategory:'autoloaded-Demos'
     "
+!
+
+removeClass:aClass
+    LoadedClasses remove:aClass ifAbsent:[]
+! !
+
+!Autoload class methodsFor:'fileout'!
+
+fileOutDefinitionOn:aStream
+    "print an expression to define myself on aStream.
+     Since autoloaded classes dont know their real definition, simply
+     output some comment string making things clear in the browser."
+
+    |myName fileName nm|
+
+    (self == Autoload) ifTrue:[^ super fileOutDefinitionOn:aStream].
+
+    myName := self name.
+    aStream nextPutAll:'"' ; nextPutAll:'Notice from Autoload:'; cr; cr;
+	    spaces:4; nextPutAll:myName , ' is not yet loaded.'; cr; cr.
+    aStream nextPutAll:'to load, execute: '.
+    aStream cr; cr; spaces:4; nextPutAll:myName  , ' autoload'; cr.
+
+    "
+     the following is simply informative ...
+     actually, its a hack & kludge - there ought to be a method for this
+     in Smalltalk 
+     (knowing the details of loading here is no good coding style)
+    "
+    fileName := Smalltalk fileNameForClass:myName.
+    (ObjectFileLoader notNil and:[Smalltalk loadBinaries]) ifTrue:[
+	(nm := Smalltalk libraryFileNameOfClass:myName) notNil ifTrue:[
+	    nm := nm , ' (a classLibrary, possibly including more classes)'
+	] ifFalse:[
+	    nm := Smalltalk getBinaryFileName:(fileName , '.so').
+	    nm isNil ifTrue:[
+		nm := Smalltalk getBinaryFileName:(fileName , '.o')
+	    ].
+	    nm notNil ifTrue:[
+		nm := nm , ' (a classBinary)'
+	    ]
+	].
+    ].
+    nm isNil ifTrue:[
+	nm := Smalltalk getFileInFileName:(fileName , '.st').
+	nm isNil ifTrue:[
+	    nm := Smalltalk getSourceFileName:(fileName , '.st').
+	].
+    ].
+    nm notNil ifTrue:[
+	aStream cr; nextPutAll:'When accessed, ' , myName , ' will automatically be loaded'; cr.
+	aStream nextPutAll:'from: '; cr; spaces:4; nextPutAll:nm.
+	nm asFilename isSymbolicLink ifTrue:[
+	    aStream cr; cr.
+	    aStream nextPutAll:'which is a link to: '; cr; spaces:4; 
+		    nextPutAll:(nm asFilename linkInfo at:#path).
+	]
+    ] ifFalse:[
+	aStream cr; nextPutAll:'there is currently no file to load ' , myName , ' from.'.
+	aStream cr; nextPutAll:'When accessed, an error will be reported.'.
+    ].
+    aStream cr; nextPutAll:'"'.
+! !
+
+!Autoload class methodsFor:'lazy compilation'!
+
+compileLazy
+    "return the lazy loading flag - if on, fileIn is much faster,
+     but pauses are to be expected later, since methods are compiled
+     when first executed."
+
+    ^ LazyLoading
+!
+
+compileLazy:aBoolean
+    "turn on/off lazy loading - if on, fileIn is much faster,
+     but pauses are to be expected later, since methods are compiled
+     when first executed.
+     If you like it, add a line to your startup file."
+
+    LazyLoading := aBoolean
 ! !
 
 !Autoload class methodsFor:'loading'!
@@ -214,6 +252,26 @@
 
 !Autoload class methodsFor:'message catching'!
 
+basicNew
+    "catch basicNew"
+
+    ^ self doesNotUnderstand:(Message selector:#basicNew)
+!
+
+basicNew:arg
+    "catch basicNew:"
+
+    ^ self doesNotUnderstand:(Message selector:#basicNew: with:arg)
+!
+
+comment
+    "return the classes comment.
+     Autoloaded classes have no comment; but I myself have one"
+
+    (self == Autoload) ifTrue:[^ super comment].
+    ^ 'not yet loaded'
+!
+
 doesNotUnderstand:aMessage
     "cought a message; load class and retry"
 
@@ -235,24 +293,12 @@
     ^ self doesNotUnderstand:(Message selector:#new)
 !
 
-basicNew
-    "catch basicNew"
-
-    ^ self doesNotUnderstand:(Message selector:#basicNew)
-!
-
 new:arg
     "catch new:"
 
     ^ self doesNotUnderstand:(Message selector:#new: with:arg)
 !
 
-basicNew:arg
-    "catch basicNew:"
-
-    ^ self doesNotUnderstand:(Message selector:#basicNew: with:arg)
-!
-
 subclass:a1 instanceVariableNames:a2 classVariableNames:a3 poolDictionaries:a4 category:a5
     "catch subclass creation - this forces missing superclasses to be 
      loaded first"
@@ -275,70 +321,26 @@
 	^ newClass perform:sel withArguments:args
     ].
     ^ nil
-!
-
-comment
-    "return the classes comment.
-     Autoloaded classes have no comment; but I myself have one"
-
-    (self == Autoload) ifTrue:[^ super comment].
-    ^ 'not yet loaded'
 ! !
 
-!Autoload class methodsFor:'fileout'!
-
-fileOutDefinitionOn:aStream
-    "print an expression to define myself on aStream.
-     Since autoloaded classes dont know their real definition, simply
-     output some comment string making things clear in the browser."
+!Autoload class methodsFor:'queries'!
 
-    |myName fileName nm|
-
-    (self == Autoload) ifTrue:[^ super fileOutDefinitionOn:aStream].
+isBehavior
+    "return true if the recevier is some kind of class.
+     Autoloaded classes are definitely; therefore return true."
 
-    myName := self name.
-    aStream nextPutAll:'"' ; nextPutAll:'Notice from Autoload:'; cr; cr;
-	    spaces:4; nextPutAll:myName , ' is not yet loaded.'; cr; cr.
-    aStream nextPutAll:'to load, execute: '.
-    aStream cr; cr; spaces:4; nextPutAll:myName  , ' autoload'; cr.
+    ^ true
+!
 
-    "
-     the following is simply informative ...
-     actually, its a hack & kludge - there ought to be a method for this
-     in Smalltalk 
-     (knowing the details of loading here is no good coding style)
-    "
-    fileName := Smalltalk fileNameForClass:myName.
-    (ObjectFileLoader notNil and:[Smalltalk loadBinaries]) ifTrue:[
-	(nm := Smalltalk libraryFileNameOfClass:myName) notNil ifTrue:[
-	    nm := nm , ' (a classLibrary, possibly including more classes)'
-	] ifFalse:[
-	    nm := Smalltalk getBinaryFileName:(fileName , '.so').
-	    nm isNil ifTrue:[
-		nm := Smalltalk getBinaryFileName:(fileName , '.o')
-	    ].
-	    nm notNil ifTrue:[
-		nm := nm , ' (a classBinary)'
-	    ]
-	].
-    ].
-    nm isNil ifTrue:[
-	nm := Smalltalk getFileInFileName:(fileName , '.st').
-	nm isNil ifTrue:[
-	    nm := Smalltalk getSourceFileName:(fileName , '.st').
-	].
-    ].
-    nm notNil ifTrue:[
-	aStream cr; nextPutAll:'When accessed, ' , myName , ' will automatically be loaded'; cr.
-	aStream nextPutAll:'from: '; cr; spaces:4; nextPutAll:nm.
-	nm asFilename isSymbolicLink ifTrue:[
-	    aStream cr; cr.
-	    aStream nextPutAll:'which is a link to: '; cr; spaces:4; 
-		    nextPutAll:(nm asFilename linkInfo at:#path).
-	]
-    ] ifFalse:[
-	aStream cr; nextPutAll:'there is currently no file to load ' , myName , ' from.'.
-	aStream cr; nextPutAll:'When accessed, an error will be reported.'.
-    ].
-    aStream cr; nextPutAll:'"'.
+isLoaded
+    "return true, if the class has been loaded; redefined in Autoload;
+     see comment there. this allows testing for a class been already loaded."
+
+    ^ (self == Autoload)
+!
+
+wasAutoloaded:aClass
+    ^ LoadedClasses notNil and:[LoadedClasses includes:aClass]
 ! !
+
+Autoload initialize!
diff -r 95efb21c1fac -r c7353f86a302 Behavior.st
--- a/Behavior.st	Thu Nov 23 03:13:03 1995 +0100
+++ b/Behavior.st	Thu Nov 23 11:46:35 1995 +0100
@@ -11,11 +11,11 @@
 "
 
 Object subclass:#Behavior
-       instanceVariableNames:'superclass flags selectorArray methodArray
-			      otherSuperclasses instSize'
-       classVariableNames:'SubclassInfo'
-       poolDictionaries:''
-       category:'Kernel-Classes'
+	 instanceVariableNames:'superclass flags selectorArray methodArray otherSuperclasses
+                instSize'
+	 classVariableNames:'SubclassInfo'
+	 poolDictionaries:''
+	 category:'Kernel-Classes'
 !
 
 !Behavior class methodsFor:'documentation'!
@@ -34,10 +34,6 @@
 "
 !
 
-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);
@@ -90,6 +86,10 @@
 "
 !
 
+version
+    ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.53 1995-11-23 10:45:04 cg Exp $'
+!
+
 virtualMachineRelationship 
 "
     NOTICE: 
@@ -256,14 +256,6 @@
 "
 ! !
 
-!Behavior class methodsFor:'queries'!
-
-isBuiltInClass
-    "this class is known by the run-time-system"
-
-    ^ true
-! !
-
 !Behavior class methodsFor:'creating new classes'!
 
 new
@@ -299,8 +291,263 @@
     "
 ! !
 
+!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|
 
@@ -327,18 +574,722 @@
     "
      Class subclassInfo
     "
+! !
+
+!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
 !
 
-flushSubclassInfo
+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
+!
+
+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
+    ].
 
     "
-     Class flushSubclassInfo
+     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
@@ -367,96 +1318,10 @@
      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
@@ -1011,6 +1876,45 @@
     ^ 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. 
@@ -1107,543 +2011,734 @@
      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"
+!Behavior methodsFor:'private accessing'!
+
+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
+!
+
+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
+!
+
+primAddSelector:newSelector withMethod:newMethod
+    "add the method given by 2nd argument under the selector given by
+     the 1st argument to the methodDictionary. 
+     Does NOT flush any caches, does NOT write a change record.
+
+     Do not use this in normal situations, strange behavior will be
+     the consequence.
+     I.e. executing obsolete methods, since the old method will still 
+     be executed out of the caches."
+
+    |index oldSelectorArray oldMethodArray newSelectorArray newMethodArray|
+
+    (newSelector isMemberOf:Symbol) ifFalse:[
+	self error:'invalid selector'. 
+	^ false
+    ].
+    newMethod isNil ifTrue:[
+	self error:'invalid method'. 
+	^ false
+    ].
+
+    index := selectorArray identityIndexOf:newSelector startingAt:1.
+    (index == 0) ifTrue:[
+	"
+	 a new selector
+	"
+	newSelectorArray := selectorArray copyWith:newSelector.
+	newMethodArray := methodArray copyWith:newMethod.
+	"
+	 keep a reference so they wont go away ...
+	 mhmh: this is no longer needed - try without
+	"
+	oldSelectorArray := selectorArray.
+	oldMethodArray := methodArray.
+	selectorArray := newSelectorArray.
+	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:'queries'!
+
+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."
+
+    ^ #()
+!
+
+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
+!
+
+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."
+
+    ^ #()
+!
+
+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
 !
 
-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."
+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:
+    "
 !
 
-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) );
-%}
+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
+
     "
-     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    
+     Object compiledMethodAt:#==
+     (Object compiledMethodAt:#==) category
     "
-! 
-
-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    
+!
+
+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
+
     "
-! 
-
-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    
+     View derivedInstanceCount
+     SequenceableCollection derivedInstanceCount
     "
-! 
-
-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    
+!
+
+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
+
     "
-! 
-
-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) );
-%}
+     Object hasInstances
+     SequenceableCollection hasInstances
+     Float hasInstances
+     SmallInteger hasInstances
     "
-     Behavior flagPointers    
+!
+
+hasMethods
+    "return true, if there are any (local) methods in this class"
+
+    ^ (methodArray size ~~ 0)
+
     "
-! 
-
-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
-	 ]
-       ]
-     ]
+     True hasMethods
+     True class hasMethods
+    "
+!
+
+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
+!
+
+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:#==
+    "
+!
+
+includesSelector:aSelector
+    "for ST-80 compatibility"
+
+    ^ self implements:aSelector
+!
+
+inheritsFrom:aClass
+    "return true, if the receiver inherits methods from aClass"
+
+    ^ self isSubclassOf:aClass
+
+    "
+     True inheritsFrom:Object
+     LinkedList inheritsFrom:Array
     "
-! 
-
-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."
+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
+    "
+!
+
+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
+    "
+!
+
+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 */
-    /* this is defined as a primitive to get defines from stc.h */
-
-    RETURN ( _MKSMALLINT(SYMBOL_INSTS) );
+
+    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 ); 
 %}
-! !
-
-!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'
+!
+
+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 ); 
+%}
 !
 
-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'
+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 ); 
+%}
 !
 
-category
-    "return the category of the class. 
-     Returning nil here, since Behavior does not define a category
-     (only ClassDescriptions do)."
-
-    ^ nil
+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:[
+	(theClass == aClass) ifTrue:[^ true].
+%{
+	if (__isBehaviorLike(theClass)) {
+	    theClass = __ClassInstPtr(theClass)->c_superclass;
+	} else {
+	    theClass = nil;
+	}
+%}.
+"/        theClass := theClass superclass.
+    ].
+    ^ false
 
     "
-     Point category                
-     Behavior new category           
+     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.
     "
 !
 
-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.
+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
 
     "
-     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)
+     |m|
+
+     m := Object compiledMethodAt:#copy.
+     Object selectorAtMethod:m ifAbsent:['oops'].
+    "
     "
-"
-    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
-    ].
-"
-
+     |m|
+
+     m := Object compiledMethodAt:#copy.
+     Fraction selectorAtMethod:m ifAbsent:['oops'].
     "
-     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
+selectorIndex:aSelector
+    "return the index in the arrays for given selector aSelector"
+
+    ^ selectorArray identityIndexOf:aSelector startingAt:1
 !
 
-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 
@@ -1697,220 +2792,20 @@
 %}
 !
 
-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
+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 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 
+     True sourceCodeAt:#ifTrue:
+     Object sourceCodeAt:#==
+     Behavior sourceCodeAt:#sourceCodeAt:
     "
 !
 
@@ -1935,357 +2830,21 @@
     "
 !
 
-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.
+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
     ].
-    ^ 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
+    ^ a
 
     "
-     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:
+     String superclasses  
     "
 !
 
@@ -2326,609 +2885,51 @@
     "
 !
 
-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]
+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
 
     "
-     |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
-    "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
-!
-
-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.
-    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. 
-     Does NOT flush any caches, does NOT write a change record.
-
-     Do not use this in normal situations, strange behavior will be
-     the consequence.
-     I.e. executing obsolete methods, since the old method will still 
-     be executed out of the caches."
-
-    |index oldSelectorArray oldMethodArray newSelectorArray newMethodArray|
-
-    (newSelector isMemberOf:Symbol) ifFalse:[
-	self error:'invalid selector'. 
-	^ false
-    ].
-    newMethod isNil ifTrue:[
-	self error:'invalid method'. 
-	^ false
-    ].
-
-    index := selectorArray identityIndexOf:newSelector startingAt:1.
-    (index == 0) ifTrue:[
-	"
-	 a new selector
-	"
-	newSelectorArray := selectorArray copyWith:newSelector.
-	newMethodArray := methodArray copyWith:newMethod.
-	"
-	 keep a reference so they wont go away ...
-	 mhmh: this is no longer needed - try without
-	"
-	oldSelectorArray := selectorArray.
-	oldMethodArray := methodArray.
-	selectorArray := newSelectorArray.
-	methodArray := newMethodArray
-    ] ifFalse:[
-	methodArray at:index put:newMethod
-    ].
-    ^ true
-! !
-
-!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:'enumerating'!
-
-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)]
-    "
-!
-
-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)]
-    "
-!
-
-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)]
+     Collection withAllSubclasses
     "
 !
 
-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
+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
     ].
-
-    Smalltalk allBehaviorsDo:[:aClass |
-	(aClass superclass == self) ifTrue:[
-	    aBlock value:aClass
-	]
-    ]
-
-    "
-     Collection subclassesDo:[:c | Transcript showCr:(c 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)]
-    "
-! !
-
-!Behavior methodsFor:'binary storage'!
-
-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)  
-    "
-!
-
-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
+    ^ aCollection
 
     "
-     |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.
-     ]
+     String withAllSuperclasses 
     "
 ! !
+
+!Behavior methodsFor:'snapshots'!
+
+postSnapshot
+    "sent by ObjectMemory, after a snapshot has been written.
+     Nothing done here."
+!
+
+preSnapshot
+    "sent by ObjectMemory, before a snapshot is written.
+     Nothing done here."
+! !
+
diff -r 95efb21c1fac -r c7353f86a302 Class.st
--- a/Class.st	Thu Nov 23 03:13:03 1995 +0100
+++ b/Class.st	Thu Nov 23 11:46:35 1995 +0100
@@ -12,10 +12,10 @@
 
 ClassDescription subclass:#Class
 	 instanceVariableNames:'classvars comment subclasses classFilename package revision
-		history'
+                history'
 	 classVariableNames:'UpdatingChanges LockChangesFile FileOutErrorSignal
-		CatchMethodRedefinitions MethodRedefinitionSignal
-		UpdateChangeFileQuerySignal'
+                CatchMethodRedefinitions MethodRedefinitionSignal
+                UpdateChangeFileQuerySignal'
 	 poolDictionaries:''
 	 category:'Kernel-Classes'
 !
@@ -106,7 +106,7 @@
 !
 
 version
-^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.80 1995-11-23 00:26:55 cg Exp $'! !
+^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.81 1995-11-23 10:45:55 cg Exp $'! !
 
 !Class class methodsFor:'initialization'!
 
@@ -164,64 +164,6 @@
 
 ! !
 
-!Class class methodsFor:'helpers'!
-
-revisionInfoFromString:aString
-    "return a dictionary filled with revision info.
-     This extracts the relevant info from aString."
-
-    |words info nm|
-
-    info := IdentityDictionary new.
-    words := aString asCollectionOfWords.
-
-    "/
-    "/ supported formats:
-    "/
-    "/ $-Header: pathName rev date time user state $
-    "/ $-Revision: rev $
-    "/ $-Id: fileName rev date time user state $
-    "/
-
-    ((words at:1) = '$Header:') ifTrue:[
-	nm := words at:2.
-	info at:#repositoryPathName put:nm.
-	(nm endsWith:',v') ifTrue:[
-	    nm := nm copyWithoutLast:2
-	].
-	info at:#fileName put:nm asFilename baseName.
-	info at:#revision put:(words at:3).
-	info at:#date put:(words at:4).
-	info at:#time put:(words at:5).
-	info at:#user put:(words at:6).
-	info at:#state put:(words at:7).
-	^ info
-    ].
-    ((words at:1) = '$Revision:') ifTrue:[
-	info at:#revision put:(words at:2).
-	^ info
-    ].
-    ((words at:1) = '$Id:') ifTrue:[
-	info at:#fileName put:(words at:2).
-	info at:#revision put:(words at:3).
-	info at:#date put:(words at:4).
-	info at:#time put:(words at:5).
-	info at:#user put:(words at:6).
-	info at:#state put:(words at:7).
-	^ info
-    ].
-
-    "/
-    "/ mhmh - maybe its some other source code system
-    "/
-    SourceCodeManager notNil ifTrue:[
-	^ SourceCodeManager revisionInfoFromString:aString
-    ].
-    ^ nil
-
-    "Created: 15.11.1995 / 14:58:35 / cg"
-! !
-
 !Class class methodsFor:'accessing - flags'!
 
 catchMethodRedefinitions
@@ -310,6 +252,64 @@
     classes do:aBlock
 ! !
 
+!Class class methodsFor:'helpers'!
+
+revisionInfoFromString:aString
+    "return a dictionary filled with revision info.
+     This extracts the relevant info from aString."
+
+    |words info nm|
+
+    info := IdentityDictionary new.
+    words := aString asCollectionOfWords.
+
+    "/
+    "/ supported formats:
+    "/
+    "/ $-Header: pathName rev date time user state $
+    "/ $-Revision: rev $
+    "/ $-Id: fileName rev date time user state $
+    "/
+
+    ((words at:1) = '$Header:') ifTrue:[
+	nm := words at:2.
+	info at:#repositoryPathName put:nm.
+	(nm endsWith:',v') ifTrue:[
+	    nm := nm copyWithoutLast:2
+	].
+	info at:#fileName put:nm asFilename baseName.
+	info at:#revision put:(words at:3).
+	info at:#date put:(words at:4).
+	info at:#time put:(words at:5).
+	info at:#user put:(words at:6).
+	info at:#state put:(words at:7).
+	^ info
+    ].
+    ((words at:1) = '$Revision:') ifTrue:[
+	info at:#revision put:(words at:2).
+	^ info
+    ].
+    ((words at:1) = '$Id:') ifTrue:[
+	info at:#fileName put:(words at:2).
+	info at:#revision put:(words at:3).
+	info at:#date put:(words at:4).
+	info at:#time put:(words at:5).
+	info at:#user put:(words at:6).
+	info at:#state put:(words at:7).
+	^ info
+    ].
+
+    "/
+    "/ mhmh - maybe its some other source code system
+    "/
+    SourceCodeManager notNil ifTrue:[
+	^ SourceCodeManager revisionInfoFromString:aString
+    ].
+    ^ nil
+
+    "Created: 15.11.1995 / 14:58:35 / cg"
+! !
+
 !Class methodsFor:'ST/V subclass creation'!
 
 subclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s
@@ -1237,6 +1237,14 @@
     ]
 !
 
+addChangeRecordForClassCheckIn:aClass
+    "append a class-was-checkedIn-record to the changes file"
+
+    self addInfoRecord:('checkin ' , aClass name)
+
+    "Created: 18.11.1995 / 17:04:58 / cg"
+!
+
 addChangeRecordForClassComment:aClass
     "add a class-comment-record to the changes file"
 
@@ -1256,14 +1264,6 @@
     self addInfoRecord:('fileOut ' , aClass name) 
 !
 
-addChangeRecordForClassCheckIn:aClass
-    "append a class-was-checkedIn-record to the changes file"
-
-    self addInfoRecord:('checkin ' , aClass name)
-
-    "Created: 18.11.1995 / 17:04:58 / cg"
-!
-
 addChangeRecordForClassInstvars:aClass
     "add a class-instvars-record to the changes file"
 
@@ -1472,6 +1472,17 @@
     self addInfoRecord:('snapshot ' , aFileName) to:aStream
 !
 
+addChangeTimeStampTo:aStream
+    "a timestamp - prepended to any change, except infoRecords"
+
+    |info|
+
+    info := 'timestamp ' , OperatingSystem getLoginName , '@' , OperatingSystem getHostName.
+    self addInfoRecord:info to:aStream. aStream cr.
+
+    "Created: 18.11.1995 / 15:41:01 / cg"
+!
+
 addInfoRecord:aMessage
     "add an info-record (snapshot, class fileOut etc.) to the changes file"
 
@@ -1490,17 +1501,6 @@
     aStream nextPutChunkSeparator.
 !
 
-addChangeTimeStampTo:aStream
-    "a timestamp - prepended to any change, except infoRecords"
-
-    |info|
-
-    info := 'timestamp ' , OperatingSystem getLoginName , '@' , OperatingSystem getHostName.
-    self addInfoRecord:info to:aStream. aStream cr.
-
-    "Created: 18.11.1995 / 15:41:01 / cg"
-!
-
 changesStream
     "return a Stream for the writing changes file - or nil if no update is wanted"
 
@@ -1565,6 +1565,26 @@
     ].
 !
 
+writingChangeDo:aBlock
+    "common helper to write a change record.
+     Opens the changefile and executes aBlock passing the stream
+     as argument. WriteErrors are cought and will lead to a warning.
+     The changefile is not kept open, to force the change to go to disk
+     as soon as possible - thus, in case of a crash, no changes should
+     be lost due to buffering."
+
+    self writingChangeWithTimeStamp:true do:aBlock
+
+    "Modified: 18.11.1995 / 15:43:36 / cg"
+!
+
+writingChangePerform:aSelector with:anArgument
+    self writingChangeWithTimeStamp:true perform:aSelector with:anArgument
+
+    "Created: 28.10.1995 / 16:50:48 / cg"
+    "Modified: 18.11.1995 / 15:44:53 / cg"
+!
+
 writingChangeWithTimeStamp:doStampIt do:aBlock
     "common helper to write a change record.
      Opens the changefile and executes aBlock passing the stream
@@ -1591,32 +1611,12 @@
     "Created: 18.11.1995 / 15:36:02 / cg"
 !
 
-writingChangeDo:aBlock
-    "common helper to write a change record.
-     Opens the changefile and executes aBlock passing the stream
-     as argument. WriteErrors are cought and will lead to a warning.
-     The changefile is not kept open, to force the change to go to disk
-     as soon as possible - thus, in case of a crash, no changes should
-     be lost due to buffering."
-
-    self writingChangeWithTimeStamp:true do:aBlock
-
-    "Modified: 18.11.1995 / 15:43:36 / cg"
-!
-
 writingChangeWithTimeStamp:stampIt perform:aSelector with:anArgument
     self writingChangeWithTimeStamp:stampIt do:[:stream |
 	self perform:aSelector with:anArgument with:stream.
     ]
 
     "Created: 18.11.1995 / 15:44:28 / cg"
-!
-
-writingChangePerform:aSelector with:anArgument
-    self writingChangeWithTimeStamp:true perform:aSelector with:anArgument
-
-    "Created: 28.10.1995 / 16:50:48 / cg"
-    "Modified: 18.11.1995 / 15:44:53 / cg"
 ! !
 
 !Class methodsFor:'compiling'!
@@ -2795,21 +2795,6 @@
     "Modified: 15.11.1995 / 14:59:34 / cg"
 !
 
-revisionStringFromSource:aMethodSourceString
-    "extract a revision string from a methods source string"
-
-    |lines idx val|
-
-    lines := aMethodSourceString asCollectionOfLines.
-    idx := lines findFirst:[:l |
-	l withoutSpaces startsWith:'$Header'
-    ].
-    idx == 0 ifTrue:[^ nil].
-    ^ lines at:idx.
-
-    "Created: 15.11.1995 / 15:01:19 / cg"
-!
-
 revisionString
     "return my revision string; that one is extracted from the
      classes #version method. Either this is a method returning that string,
@@ -2849,6 +2834,21 @@
     "Modified: 15.11.1995 / 15:01:54 / cg"
 !
 
+revisionStringFromSource:aMethodSourceString
+    "extract a revision string from a methods source string"
+
+    |lines idx val|
+
+    lines := aMethodSourceString asCollectionOfLines.
+    idx := lines findFirst:[:l |
+	l withoutSpaces startsWith:'$Header'
+    ].
+    idx == 0 ifTrue:[^ nil].
+    ^ lines at:idx.
+
+    "Created: 15.11.1995 / 15:01:19 / cg"
+!
+
 setPrimitiveSpecsAt:index to:aString
     "set a primitiveSpecification component to aString"
 
diff -r 95efb21c1fac -r c7353f86a302 ClassDescr.st
--- a/ClassDescr.st	Thu Nov 23 03:13:03 1995 +0100
+++ b/ClassDescr.st	Thu Nov 23 11:46:35 1995 +0100
@@ -11,10 +11,10 @@
 "
 
 Behavior subclass:#ClassDescription
-       instanceVariableNames:'name category instvars primitiveSpec signature'
-       classVariableNames:''
-       poolDictionaries:''
-       category:'Kernel-Classes'
+	 instanceVariableNames:'name category instvars primitiveSpec signature'
+	 classVariableNames:''
+	 poolDictionaries:''
+	 category:'Kernel-Classes'
 !
 
 !ClassDescription class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
 "
 !
 
-version
-    ^ '$Header: /cvs/stx/stx/libbasic/Attic/ClassDescr.st,v 1.20 1995-11-11 14:27:50 cg Exp $'
-!
-
 documentation
 "
     this class has been added for ST-80 compatibility only.
@@ -55,6 +51,10 @@
 	signature       <SmallInteger>  the classes signature (used to detect obsolete
 					or changed classes with binaryStorage)
 "
+!
+
+version
+    ^ '$Header: /cvs/stx/stx/libbasic/Attic/ClassDescr.st,v 1.21 1995-11-23 10:46:35 cg Exp $'
 ! !
 
 !ClassDescription class methodsFor:'instance creation'!
@@ -70,66 +70,8 @@
     ^ newClass
 ! !
 
-!ClassDescription methodsFor:'special accessing'!
-
-setName:aString
-    "set the classes name - be careful, it will be still
-     in the Smalltalk dictionary - under another key.
-     This is NOT for general use - see renameTo:"
-
-    name := aString
-!
-
-setInstanceVariableString:aString
-    "set the classes instvarnames string - no recompilation
-     or updates are done and no changeList records are written.
-     This is NOT for general use."
-
-    instvars := aString.
-! !
-
 !ClassDescription methodsFor:'accessing'!
 
-instanceVariableString
-    "return a string of the instance variable names"
-
-    instvars isNil ifTrue:[^ ''].
-    ^ instvars
-
-    "
-     Point instanceVariableString   
-    "
-!
-
-instVarNames
-    "return a collection of the instance variable name-strings"
-
-    instvars isNil ifTrue:[
-	^ OrderedCollection new
-    ].
-    ^ instvars asCollectionOfWords
-
-    "
-     Point instVarNames  
-    "
-!
-
-instanceVariableOffsets
-    "returns a dictionary containing the instance variable index
-     for each instVar name"
-
-    |dict index|
-
-    index := 0. dict := Dictionary new.
-    self allInstVarNames do:[:nm | index := index + 1. dict at:nm put:index].
-    ^ dict
-
-    "
-     Point instanceVariableOffsets 
-     GraphicsContext instanceVariableOffsets 
-    "
-!
-        
 allInstVarNames
     "return a collection of all the instance variable name-strings
      this includes all superclass-instance variables.
@@ -144,27 +86,6 @@
     "
 !
 
-instVarOffsetOf:aVariableName
-    "return the index (as used in instVarAt:/instVarAt:put:) of a named instance
-     variable. The returned number is 1..instSize for valid variable names, nil for
-     illegal names."
-
-    ^ self allInstVarNames indexOf:aVariableName ifAbsent:nil
-!
-
-instVarAtOffset:index
-    "return the name of the instance variable at index"
-
-    ^ self allInstanceVariableNames at:index
-!
-
-name
-    "return the name of the class. In the current implementation,
-     this returns a string, but will be changed to Symbol soon."
-
-    ^ name
-!
-
 category
     "return the category of the class. 
      The returned value may be a string or symbol."
@@ -187,6 +108,67 @@
     ]
 !
 
+instVarAtOffset:index
+    "return the name of the instance variable at index"
+
+    ^ self allInstanceVariableNames at:index
+!
+
+instVarNames
+    "return a collection of the instance variable name-strings"
+
+    instvars isNil ifTrue:[
+	^ OrderedCollection new
+    ].
+    ^ instvars asCollectionOfWords
+
+    "
+     Point instVarNames  
+    "
+!
+
+instVarOffsetOf:aVariableName
+    "return the index (as used in instVarAt:/instVarAt:put:) of a named instance
+     variable. The returned number is 1..instSize for valid variable names, nil for
+     illegal names."
+
+    ^ self allInstVarNames indexOf:aVariableName ifAbsent:nil
+!
+
+instanceVariableOffsets
+    "returns a dictionary containing the instance variable index
+     for each instVar name"
+
+    |dict index|
+
+    index := 0. dict := Dictionary new.
+    self allInstVarNames do:[:nm | index := index + 1. dict at:nm put:index].
+    ^ dict
+
+    "
+     Point instanceVariableOffsets 
+     GraphicsContext instanceVariableOffsets 
+    "
+!
+
+instanceVariableString
+    "return a string of the instance variable names"
+
+    instvars isNil ifTrue:[^ ''].
+    ^ instvars
+
+    "
+     Point instanceVariableString   
+    "
+!
+
+name
+    "return the name of the class. In the current implementation,
+     this returns a string, but will be changed to Symbol soon."
+
+    ^ name
+!
+
 organization
     "for ST80 compatibility; 
      read the documentation in ClassOrganizer for more info."
@@ -194,106 +176,6 @@
     ^ ClassOrganizer for:self
 ! !
 
-!ClassDescription methodsFor:'signature checking'!
-
-signature
-    "return a signature number - this number is useful for a quick
-     check for changed classes, and is done in the binary-object loader, 
-     and the dynamic class loader.
-     Do NOT change the algorithm here - others may depend on it.
-     Also, the algorithm may change - so never interpret the returned value
-     (if at all, use the access #XXXFromSignature: methods)"
-
-    |value   "{ Class: SmallInteger }"
-     nameKey "{ Class: SmallInteger }" |
-
-    signature notNil ifTrue:[^ signature].
-
-    value := self flags bitAnd:(Class maskIndexType).
-    value := (value bitShift:3) + ((self class instSize - Class instSize) bitAnd:7).
-    value := (value bitShift:7) + (self instSize bitAnd:16r7F).
-
-    nameKey := 0.
-    self allInstVarNames do:[:name |
-	nameKey := nameKey bitShift:1.
-	(nameKey bitAnd:16r10000) ~~ 0 ifTrue:[
-	    nameKey := nameKey bitXor:1.
-	    nameKey := nameKey bitAnd:16rFFFF.
-	].
-	nameKey := (nameKey + (name at:1) asciiValue) bitAnd:16rFFFF.
-    ].
-    value := value + (nameKey bitShift:14).
-    signature := value.
-    ^ value
-
-    "
-     Array signature
-     ByteArray signature
-     View signature
-    "
-!
-
-instSizeFromSignature:aSignature
-    "for checking class compatibility: return the some number based on
-     the instSize from a signature key (not always the real instSize)."
-
-    ^ aSignature bitAnd:16r7F
-
-    "
-     Class instSizeFromSignature:Point signature.     
-     Class instSizeFromSignature:Association signature.   
-     Class instSizeFromSignature:Dictionary signature.    
-    "
-!
-
-classinstSizeFromSignature:aSignature
-    "for checking class compatibility: return some number based on 
-     the classinstSize from a signature key (not always the real classinstsize)."
-
-    ^ (aSignature bitShift:-7) bitAnd:7
-!
-
-instTypeFromSignature:aSignature
-    "for checking class compatibility: return some number based on
-     the instType (i.e. variableBytes/Pointers etc.) from a signature key."
-
-    ^ (aSignature bitShift:-10) bitAnd:(Class maskIndexType)
-
-    "
-     Class instTypeFromSignature:Object signature.               
-     Class instTypeFromSignature:Array signature.                
-     Class instTypeFromSignature:String signature.               
-     Class instTypeFromSignature:OrderedCollection signature.    
-    "
-!
-
-instNameKeyFromSignature:aSignature
-    "for checking class compatibility: return a number based on the
-     names and order of the instance variables from a signature key."
-
-    ^ (aSignature bitShift:-14) bitAnd:16rFFFF
-
-    "
-     Point instNameKeyFromSignature:Point signature.             
-     Association instNameKeyFromSignature:Association signature.  
-    "
-! !
-
-!ClassDescription methodsFor:'renaming'!
-
-renameTo:newName
-    "change the name of the class"
-
-    |oldSym|
-
-    oldSym := name asSymbol.
-    self setName:newName.
-
-    Smalltalk at:oldSym put:nil.
-    Smalltalk removeKey:oldSym.             "26.jun 93"
-    Smalltalk at:(newName asSymbol) put:self.
-! !
-
 !ClassDescription methodsFor:'printing & storing'!
 
 displayString
@@ -346,3 +228,122 @@
 
     "Modified: 30.10.1995 / 19:46:21 / cg"
 ! !
+
+!ClassDescription methodsFor:'renaming'!
+
+renameTo:newName
+    "change the name of the class"
+
+    |oldSym|
+
+    oldSym := name asSymbol.
+    self setName:newName.
+
+    Smalltalk at:oldSym put:nil.
+    Smalltalk removeKey:oldSym.             "26.jun 93"
+    Smalltalk at:(newName asSymbol) put:self.
+! !
+
+!ClassDescription methodsFor:'signature checking'!
+
+classinstSizeFromSignature:aSignature
+    "for checking class compatibility: return some number based on 
+     the classinstSize from a signature key (not always the real classinstsize)."
+
+    ^ (aSignature bitShift:-7) bitAnd:7
+!
+
+instNameKeyFromSignature:aSignature
+    "for checking class compatibility: return a number based on the
+     names and order of the instance variables from a signature key."
+
+    ^ (aSignature bitShift:-14) bitAnd:16rFFFF
+
+    "
+     Point instNameKeyFromSignature:Point signature.             
+     Association instNameKeyFromSignature:Association signature.  
+    "
+!
+
+instSizeFromSignature:aSignature
+    "for checking class compatibility: return the some number based on
+     the instSize from a signature key (not always the real instSize)."
+
+    ^ aSignature bitAnd:16r7F
+
+    "
+     Class instSizeFromSignature:Point signature.     
+     Class instSizeFromSignature:Association signature.   
+     Class instSizeFromSignature:Dictionary signature.    
+    "
+!
+
+instTypeFromSignature:aSignature
+    "for checking class compatibility: return some number based on
+     the instType (i.e. variableBytes/Pointers etc.) from a signature key."
+
+    ^ (aSignature bitShift:-10) bitAnd:(Class maskIndexType)
+
+    "
+     Class instTypeFromSignature:Object signature.               
+     Class instTypeFromSignature:Array signature.                
+     Class instTypeFromSignature:String signature.               
+     Class instTypeFromSignature:OrderedCollection signature.    
+    "
+!
+
+signature
+    "return a signature number - this number is useful for a quick
+     check for changed classes, and is done in the binary-object loader, 
+     and the dynamic class loader.
+     Do NOT change the algorithm here - others may depend on it.
+     Also, the algorithm may change - so never interpret the returned value
+     (if at all, use the access #XXXFromSignature: methods)"
+
+    |value   "{ Class: SmallInteger }"
+     nameKey "{ Class: SmallInteger }" |
+
+    signature notNil ifTrue:[^ signature].
+
+    value := self flags bitAnd:(Class maskIndexType).
+    value := (value bitShift:3) + ((self class instSize - Class instSize) bitAnd:7).
+    value := (value bitShift:7) + (self instSize bitAnd:16r7F).
+
+    nameKey := 0.
+    self allInstVarNames do:[:name |
+	nameKey := nameKey bitShift:1.
+	(nameKey bitAnd:16r10000) ~~ 0 ifTrue:[
+	    nameKey := nameKey bitXor:1.
+	    nameKey := nameKey bitAnd:16rFFFF.
+	].
+	nameKey := (nameKey + (name at:1) asciiValue) bitAnd:16rFFFF.
+    ].
+    value := value + (nameKey bitShift:14).
+    signature := value.
+    ^ value
+
+    "
+     Array signature
+     ByteArray signature
+     View signature
+    "
+! !
+
+!ClassDescription methodsFor:'special accessing'!
+
+setInstanceVariableString:aString
+    "set the classes instvarnames string - no recompilation
+     or updates are done and no changeList records are written.
+     This is NOT for general use."
+
+    instvars := aString.
+!
+
+setName:aString
+    "set the classes name - be careful, it will be still
+     in the Smalltalk dictionary - under another key.
+     This is NOT for general use - see renameTo:"
+
+    name := aString
+! !
+
diff -r 95efb21c1fac -r c7353f86a302 ClassDescription.st
--- a/ClassDescription.st	Thu Nov 23 03:13:03 1995 +0100
+++ b/ClassDescription.st	Thu Nov 23 11:46:35 1995 +0100
@@ -11,10 +11,10 @@
 "
 
 Behavior subclass:#ClassDescription
-       instanceVariableNames:'name category instvars primitiveSpec signature'
-       classVariableNames:''
-       poolDictionaries:''
-       category:'Kernel-Classes'
+	 instanceVariableNames:'name category instvars primitiveSpec signature'
+	 classVariableNames:''
+	 poolDictionaries:''
+	 category:'Kernel-Classes'
 !
 
 !ClassDescription class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
 "
 !
 
-version
-    ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.20 1995-11-11 14:27:50 cg Exp $'
-!
-
 documentation
 "
     this class has been added for ST-80 compatibility only.
@@ -55,6 +51,10 @@
 	signature       <SmallInteger>  the classes signature (used to detect obsolete
 					or changed classes with binaryStorage)
 "
+!
+
+version
+    ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.21 1995-11-23 10:46:35 cg Exp $'
 ! !
 
 !ClassDescription class methodsFor:'instance creation'!
@@ -70,66 +70,8 @@
     ^ newClass
 ! !
 
-!ClassDescription methodsFor:'special accessing'!
-
-setName:aString
-    "set the classes name - be careful, it will be still
-     in the Smalltalk dictionary - under another key.
-     This is NOT for general use - see renameTo:"
-
-    name := aString
-!
-
-setInstanceVariableString:aString
-    "set the classes instvarnames string - no recompilation
-     or updates are done and no changeList records are written.
-     This is NOT for general use."
-
-    instvars := aString.
-! !
-
 !ClassDescription methodsFor:'accessing'!
 
-instanceVariableString
-    "return a string of the instance variable names"
-
-    instvars isNil ifTrue:[^ ''].
-    ^ instvars
-
-    "
-     Point instanceVariableString   
-    "
-!
-
-instVarNames
-    "return a collection of the instance variable name-strings"
-
-    instvars isNil ifTrue:[
-	^ OrderedCollection new
-    ].
-    ^ instvars asCollectionOfWords
-
-    "
-     Point instVarNames  
-    "
-!
-
-instanceVariableOffsets
-    "returns a dictionary containing the instance variable index
-     for each instVar name"
-
-    |dict index|
-
-    index := 0. dict := Dictionary new.
-    self allInstVarNames do:[:nm | index := index + 1. dict at:nm put:index].
-    ^ dict
-
-    "
-     Point instanceVariableOffsets 
-     GraphicsContext instanceVariableOffsets 
-    "
-!
-        
 allInstVarNames
     "return a collection of all the instance variable name-strings
      this includes all superclass-instance variables.
@@ -144,27 +86,6 @@
     "
 !
 
-instVarOffsetOf:aVariableName
-    "return the index (as used in instVarAt:/instVarAt:put:) of a named instance
-     variable. The returned number is 1..instSize for valid variable names, nil for
-     illegal names."
-
-    ^ self allInstVarNames indexOf:aVariableName ifAbsent:nil
-!
-
-instVarAtOffset:index
-    "return the name of the instance variable at index"
-
-    ^ self allInstanceVariableNames at:index
-!
-
-name
-    "return the name of the class. In the current implementation,
-     this returns a string, but will be changed to Symbol soon."
-
-    ^ name
-!
-
 category
     "return the category of the class. 
      The returned value may be a string or symbol."
@@ -187,6 +108,67 @@
     ]
 !
 
+instVarAtOffset:index
+    "return the name of the instance variable at index"
+
+    ^ self allInstanceVariableNames at:index
+!
+
+instVarNames
+    "return a collection of the instance variable name-strings"
+
+    instvars isNil ifTrue:[
+	^ OrderedCollection new
+    ].
+    ^ instvars asCollectionOfWords
+
+    "
+     Point instVarNames  
+    "
+!
+
+instVarOffsetOf:aVariableName
+    "return the index (as used in instVarAt:/instVarAt:put:) of a named instance
+     variable. The returned number is 1..instSize for valid variable names, nil for
+     illegal names."
+
+    ^ self allInstVarNames indexOf:aVariableName ifAbsent:nil
+!
+
+instanceVariableOffsets
+    "returns a dictionary containing the instance variable index
+     for each instVar name"
+
+    |dict index|
+
+    index := 0. dict := Dictionary new.
+    self allInstVarNames do:[:nm | index := index + 1. dict at:nm put:index].
+    ^ dict
+
+    "
+     Point instanceVariableOffsets 
+     GraphicsContext instanceVariableOffsets 
+    "
+!
+
+instanceVariableString
+    "return a string of the instance variable names"
+
+    instvars isNil ifTrue:[^ ''].
+    ^ instvars
+
+    "
+     Point instanceVariableString   
+    "
+!
+
+name
+    "return the name of the class. In the current implementation,
+     this returns a string, but will be changed to Symbol soon."
+
+    ^ name
+!
+
 organization
     "for ST80 compatibility; 
      read the documentation in ClassOrganizer for more info."
@@ -194,106 +176,6 @@
     ^ ClassOrganizer for:self
 ! !
 
-!ClassDescription methodsFor:'signature checking'!
-
-signature
-    "return a signature number - this number is useful for a quick
-     check for changed classes, and is done in the binary-object loader, 
-     and the dynamic class loader.
-     Do NOT change the algorithm here - others may depend on it.
-     Also, the algorithm may change - so never interpret the returned value
-     (if at all, use the access #XXXFromSignature: methods)"
-
-    |value   "{ Class: SmallInteger }"
-     nameKey "{ Class: SmallInteger }" |
-
-    signature notNil ifTrue:[^ signature].
-
-    value := self flags bitAnd:(Class maskIndexType).
-    value := (value bitShift:3) + ((self class instSize - Class instSize) bitAnd:7).
-    value := (value bitShift:7) + (self instSize bitAnd:16r7F).
-
-    nameKey := 0.
-    self allInstVarNames do:[:name |
-	nameKey := nameKey bitShift:1.
-	(nameKey bitAnd:16r10000) ~~ 0 ifTrue:[
-	    nameKey := nameKey bitXor:1.
-	    nameKey := nameKey bitAnd:16rFFFF.
-	].
-	nameKey := (nameKey + (name at:1) asciiValue) bitAnd:16rFFFF.
-    ].
-    value := value + (nameKey bitShift:14).
-    signature := value.
-    ^ value
-
-    "
-     Array signature
-     ByteArray signature
-     View signature
-    "
-!
-
-instSizeFromSignature:aSignature
-    "for checking class compatibility: return the some number based on
-     the instSize from a signature key (not always the real instSize)."
-
-    ^ aSignature bitAnd:16r7F
-
-    "
-     Class instSizeFromSignature:Point signature.     
-     Class instSizeFromSignature:Association signature.   
-     Class instSizeFromSignature:Dictionary signature.    
-    "
-!
-
-classinstSizeFromSignature:aSignature
-    "for checking class compatibility: return some number based on 
-     the classinstSize from a signature key (not always the real classinstsize)."
-
-    ^ (aSignature bitShift:-7) bitAnd:7
-!
-
-instTypeFromSignature:aSignature
-    "for checking class compatibility: return some number based on
-     the instType (i.e. variableBytes/Pointers etc.) from a signature key."
-
-    ^ (aSignature bitShift:-10) bitAnd:(Class maskIndexType)
-
-    "
-     Class instTypeFromSignature:Object signature.               
-     Class instTypeFromSignature:Array signature.                
-     Class instTypeFromSignature:String signature.               
-     Class instTypeFromSignature:OrderedCollection signature.    
-    "
-!
-
-instNameKeyFromSignature:aSignature
-    "for checking class compatibility: return a number based on the
-     names and order of the instance variables from a signature key."
-
-    ^ (aSignature bitShift:-14) bitAnd:16rFFFF
-
-    "
-     Point instNameKeyFromSignature:Point signature.             
-     Association instNameKeyFromSignature:Association signature.  
-    "
-! !
-
-!ClassDescription methodsFor:'renaming'!
-
-renameTo:newName
-    "change the name of the class"
-
-    |oldSym|
-
-    oldSym := name asSymbol.
-    self setName:newName.
-
-    Smalltalk at:oldSym put:nil.
-    Smalltalk removeKey:oldSym.             "26.jun 93"
-    Smalltalk at:(newName asSymbol) put:self.
-! !
-
 !ClassDescription methodsFor:'printing & storing'!
 
 displayString
@@ -346,3 +228,122 @@
 
     "Modified: 30.10.1995 / 19:46:21 / cg"
 ! !
+
+!ClassDescription methodsFor:'renaming'!
+
+renameTo:newName
+    "change the name of the class"
+
+    |oldSym|
+
+    oldSym := name asSymbol.
+    self setName:newName.
+
+    Smalltalk at:oldSym put:nil.
+    Smalltalk removeKey:oldSym.             "26.jun 93"
+    Smalltalk at:(newName asSymbol) put:self.
+! !
+
+!ClassDescription methodsFor:'signature checking'!
+
+classinstSizeFromSignature:aSignature
+    "for checking class compatibility: return some number based on 
+     the classinstSize from a signature key (not always the real classinstsize)."
+
+    ^ (aSignature bitShift:-7) bitAnd:7
+!
+
+instNameKeyFromSignature:aSignature
+    "for checking class compatibility: return a number based on the
+     names and order of the instance variables from a signature key."
+
+    ^ (aSignature bitShift:-14) bitAnd:16rFFFF
+
+    "
+     Point instNameKeyFromSignature:Point signature.             
+     Association instNameKeyFromSignature:Association signature.  
+    "
+!
+
+instSizeFromSignature:aSignature
+    "for checking class compatibility: return the some number based on
+     the instSize from a signature key (not always the real instSize)."
+
+    ^ aSignature bitAnd:16r7F
+
+    "
+     Class instSizeFromSignature:Point signature.     
+     Class instSizeFromSignature:Association signature.   
+     Class instSizeFromSignature:Dictionary signature.    
+    "
+!
+
+instTypeFromSignature:aSignature
+    "for checking class compatibility: return some number based on
+     the instType (i.e. variableBytes/Pointers etc.) from a signature key."
+
+    ^ (aSignature bitShift:-10) bitAnd:(Class maskIndexType)
+
+    "
+     Class instTypeFromSignature:Object signature.               
+     Class instTypeFromSignature:Array signature.                
+     Class instTypeFromSignature:String signature.               
+     Class instTypeFromSignature:OrderedCollection signature.    
+    "
+!
+
+signature
+    "return a signature number - this number is useful for a quick
+     check for changed classes, and is done in the binary-object loader, 
+     and the dynamic class loader.
+     Do NOT change the algorithm here - others may depend on it.
+     Also, the algorithm may change - so never interpret the returned value
+     (if at all, use the access #XXXFromSignature: methods)"
+
+    |value   "{ Class: SmallInteger }"
+     nameKey "{ Class: SmallInteger }" |
+
+    signature notNil ifTrue:[^ signature].
+
+    value := self flags bitAnd:(Class maskIndexType).
+    value := (value bitShift:3) + ((self class instSize - Class instSize) bitAnd:7).
+    value := (value bitShift:7) + (self instSize bitAnd:16r7F).
+
+    nameKey := 0.
+    self allInstVarNames do:[:name |
+	nameKey := nameKey bitShift:1.
+	(nameKey bitAnd:16r10000) ~~ 0 ifTrue:[
+	    nameKey := nameKey bitXor:1.
+	    nameKey := nameKey bitAnd:16rFFFF.
+	].
+	nameKey := (nameKey + (name at:1) asciiValue) bitAnd:16rFFFF.
+    ].
+    value := value + (nameKey bitShift:14).
+    signature := value.
+    ^ value
+
+    "
+     Array signature
+     ByteArray signature
+     View signature
+    "
+! !
+
+!ClassDescription methodsFor:'special accessing'!
+
+setInstanceVariableString:aString
+    "set the classes instvarnames string - no recompilation
+     or updates are done and no changeList records are written.
+     This is NOT for general use."
+
+    instvars := aString.
+!
+
+setName:aString
+    "set the classes name - be careful, it will be still
+     in the Smalltalk dictionary - under another key.
+     This is NOT for general use - see renameTo:"
+
+    name := aString
+! !
+