--- a/SnapShotImage.st	Thu Aug 23 10:33:10 2001 +0200
+++ b/SnapShotImage.st	Wed Sep 05 18:45:04 2001 +0200
@@ -1,7 +1,7 @@
 "{ Package: 'stx:libtool2' }"
 
 Object subclass:#SnapShotImage
-	instanceVariableNames:'memory globals'
+	instanceVariableNames:'memory globals cachedBehaviors'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'System-Support'
@@ -71,19 +71,24 @@
 !SnapShotImage methodsFor:'smalltalk protocol'!
 
 allClassesDo:aBlock
-    self keysAndValuesDo:[:key :valRef |
-        valRef isInteger ifFalse:[
-            valRef ~~ true ifTrue:[
-                valRef ~~ false ifTrue:[
-                    valRef notNil ifTrue:[
-                        valRef isImageBehavior ifTrue:[
-                            aBlock value:valRef
+    cachedBehaviors isNil ifTrue:[
+        cachedBehaviors := OrderedCollection new.
+
+        self keysAndValuesDo:[:key :valRef |
+            valRef isInteger ifFalse:[
+                valRef ~~ true ifTrue:[
+                    valRef ~~ false ifTrue:[
+                        valRef notNil ifTrue:[
+                            valRef isImageBehavior ifTrue:[
+                                cachedBehaviors add:valRef
+                            ]
                         ]
                     ]
                 ]
             ]
-        ]
+        ].
     ].
+    cachedBehaviors do:aBlock
 !
 
 allClassesInCategory:aCategory

--- a/SnapShotImageMemory.st	Thu Aug 23 10:33:10 2001 +0200
+++ b/SnapShotImageMemory.st	Wed Sep 05 18:45:04 2001 +0200
@@ -29,8 +29,15 @@
 	privateIn:SnapShotImageMemory
 !
 
+SnapShotImageMemory::ImageObject variableSubclass:#ImageMethodObject
+	instanceVariableNames:'cachedPackage'
+	classVariableNames:''
+	poolDictionaries:''
+	privateIn:SnapShotImageMemory
+!
+
 SnapShotImageMemory::ImageObject variableSubclass:#ImageClassObject
-	instanceVariableNames:''
+	instanceVariableNames:'cachedCategory cachedFlags cachedName'
 	classVariableNames:''
 	poolDictionaries:''
 	privateIn:SnapShotImageMemory
@@ -166,7 +173,8 @@
 !
 
 fetchObjectAt:baseAddr
-    |addr classPtr classRef size bits o nBytes nInsts flags imgAddr|
+    |addr classPtr classRef size bits o nBytes nInsts flags indexTypeFlags imgAddr
+     |
 
     baseAddr == 0 ifTrue:[^ nil].
     (baseAddr bitAnd:1) == 1 ifTrue:[(baseAddr bitTest:16r80000000) ifTrue:[
@@ -194,8 +202,9 @@
 
     classRef := self fetchClassObjectAt:classPtr.
 
-    flags := classRef flags bitAnd:Behavior maskIndexType.
-    (flags = Behavior flagBytes) ifTrue:[ 
+    flags := classRef flags.
+    indexTypeFlags := flags bitAnd:Behavior maskIndexType.
+    (indexTypeFlags = Behavior flagBytes) ifTrue:[ 
         nBytes := (size - (intSize * 3)).
         o := ImageByteObject new:nBytes.
         o classRef:classRef.
@@ -216,21 +225,25 @@
 "/Transcript cr.
 
     ] ifFalse:[
-        (flags = Behavior flagNotIndexed) ifFalse:[ 
-            (flags ~= Behavior flagPointers) ifTrue:[
-                (flags ~= Behavior flagWeakPointers) ifTrue:[
+        (indexTypeFlags = Behavior flagNotIndexed) ifFalse:[ 
+            (indexTypeFlags ~= Behavior flagPointers) ifTrue:[
+                (indexTypeFlags ~= Behavior flagWeakPointers) ifTrue:[
                     self halt 
                 ]
             ].
         ].
 
         nInsts := (size - (intSize * 3)) // intSize.
-        (classRef flags bitTest:Behavior flagBehavior)
+        (flags bitTest:Behavior flagBehavior)
         "/ classRef isImageBehavior 
         ifTrue:[
             o := ImageClassObject new:nInsts.
         ] ifFalse:[
-            o := ImageObject new:nInsts.
+            (flags bitTest:Behavior flagMethod) ifTrue:[
+                o := ImageMethodObject new:nInsts.
+            ] ifFalse:[
+                o := ImageObject new:nInsts.
+            ]
         ].
         o classRef:classRef.
 size > 8000 ifTrue:[self halt].
@@ -937,6 +950,10 @@
     ^ false
 !
 
+isObsolete
+    ^ false
+!
+
 isPrivate
     ^ false
 !
@@ -1071,35 +1088,7 @@
 !
 
 source
-    |sourcePosition sourcePositionPtr sourcePtr sourceRef source aStream junk|
-
-    self isMethodOrLazyMethod ifTrue:[
-        sourcePositionPtr := self at:(Method instVarOffsetOf:'sourcePosition').
-        sourcePtr := self at:(Method instVarOffsetOf:'source').
-        sourceRef := memory fetchObjectAt:sourcePtr.
-        sourceRef isString ifFalse:[
-            self halt.
-        ].
-        source := memory printStringOfString:sourceRef.
-        sourcePosition := memory fetchObjectAt:sourcePositionPtr.
-        sourcePosition isNil ifTrue:[
-            ^ source
-        ].
-
-        aStream := self sourceStream.
-        aStream notNil ifTrue:[
-            Stream positionErrorSignal handle:[:ex |
-                ^ nil
-            ] do:[
-                aStream position:sourcePosition abs.
-            ].
-            junk := aStream nextChunk.
-
-            aStream close.
-            ^ junk
-        ].
-    ].
-    self halt.
+    self halt:'unimplemented'.
 !
 
 sourceFilename
@@ -1337,19 +1326,81 @@
     ^ byteSize
 ! !
 
+!SnapShotImageMemory::ImageMethodObject methodsFor:'method protocol'!
+
+package
+    |packageSlotOffset packagePtr packageRef package|
+
+    cachedPackage isNil ifTrue:[
+        packageSlotOffset := Method instVarOffsetOf:'package'.
+
+        packagePtr := self at:packageSlotOffset.
+        packageRef := memory fetchObjectAt:packagePtr.
+        packageRef isNil ifTrue:[^ nil].
+
+        packageRef isImageSymbol ifFalse:[
+            packageRef isImageBytes ifFalse:[
+                self halt.
+            ].
+            "/ mhmh - can be a string sometimes ...
+        ].
+        package := memory fetchStringFor:packageRef.
+        cachedPackage := package asSymbol
+    ].
+    ^ cachedPackage
+!
+
+source
+    |sourcePosition sourcePositionPtr sourcePtr sourceRef source aStream junk|
+
+    sourcePositionPtr := self at:(Method instVarOffsetOf:'sourcePosition').
+    sourcePtr := self at:(Method instVarOffsetOf:'source').
+    sourceRef := memory fetchObjectAt:sourcePtr.
+    sourceRef isString ifFalse:[
+        self halt.
+    ].
+    source := memory printStringOfString:sourceRef.
+    sourcePosition := memory fetchObjectAt:sourcePositionPtr.
+    sourcePosition isNil ifTrue:[
+        ^ source
+    ].
+
+    aStream := self sourceStream.
+    aStream notNil ifTrue:[
+        Stream positionErrorSignal handle:[:ex |
+            ^ nil
+        ] do:[
+            aStream position:sourcePosition abs.
+        ].
+        junk := aStream nextChunk.
+
+        aStream close.
+        ^ junk
+    ].
+    self halt.
+! !
+
+!SnapShotImageMemory::ImageMethodObject methodsFor:'queries'!
+
+isMethod
+    ^ true
+! !
+
 !SnapShotImageMemory::ImageClassObject methodsFor:'accessing - slots'!
 
 category
-    |categoryRef category|
-
-    categoryRef := self categorySlot.
-    categoryRef isInteger ifTrue:[
-        categoryRef := memory fetchObjectAt:categoryRef.
+    |categoryRef|
+
+    cachedCategory isNil ifTrue:[
+        categoryRef := self categorySlot.
+        categoryRef isInteger ifTrue:[
+            categoryRef := memory fetchObjectAt:categoryRef.
+        ].
+        categoryRef notNil ifTrue:[
+            cachedCategory := memory fetchStringFor:categoryRef.
+        ].
     ].
-    categoryRef notNil ifTrue:[
-        category := memory fetchStringFor:categoryRef.
-    ].
-    ^ category
+    ^ cachedCategory
 !
 
 categorySlot
@@ -1396,7 +1447,7 @@
             ].
         ].
     ].
-    ^ classVarNames
+    ^ classVarNames ? #()
 !
 
 classVariableString
@@ -1436,13 +1487,16 @@
 flags
     |flags amount|
 
-    flags := self flagsSlot.
-
-    (SnapShotImageMemory isSmallIntegerOOP:flags) ifFalse:[
-        self halt
+    cachedFlags isNil ifTrue:[
+        flags := self flagsSlot.
+
+        (SnapShotImageMemory isSmallIntegerOOP:flags) ifFalse:[
+            self halt
+        ].
+        amount := -1.
+        cachedFlags := flags bitShift:amount.
     ].
-    amount := -1.
-    ^ flags bitShift:amount.
+    ^ cachedFlags
 !
 
 flagsSlot
@@ -1506,23 +1560,23 @@
 !
 
 name
-    |nameRef name|
-
-    self isMeta ifTrue:[
-        ^ self theNonMetaclass name , ' class'
+    |nameRef|
+
+    cachedName isNil ifTrue:[
+        self isMeta ifTrue:[
+            cachedName := self theNonMetaclass name , ' class'
+        ] ifFalse:[
+            nameRef := self nameSlot.
+            nameRef isInteger ifTrue:[
+                nameRef := memory fetchObjectAt:nameRef.
+            ].
+            nameRef notNil ifTrue:[
+                cachedName := memory fetchStringFor:nameRef.
+                cachedName := cachedName asSymbol
+            ].
+        ].
     ].
-
-    nameRef := self nameSlot.
-    nameRef isInteger ifTrue:[
-        nameRef := memory fetchObjectAt:nameRef.
-    ].
-    nameRef notNil ifTrue:[
-        name := memory fetchStringFor:nameRef.
-    ].
-    nameRef notNil ifTrue:[
-        name := name asSymbol.
-    ].
-    ^ name
+    ^ cachedName
 !
 
 nameSlot
@@ -1634,7 +1688,7 @@
         "/ metaclasses are not found via Smalltalk allClassesDo:
         "/ here, walk over classes and enumerate corresponding metas.
         self soleInstance allSubclassesDo:[:aSubClass |
-            aBlock value:(aSubClass class)
+            aBlock value:(aSubClass theMetaclass)
         ].
     ] ifFalse:[
         Smalltalk allClassesDo:[:aClass |
@@ -2313,14 +2367,14 @@
         self printClassNameOn:aStream.
     ].
     aStream nextPutAll:' class instanceVariableNames:'''.
-    self class printInstVarNamesOn:aStream indent:8.
+    self theMetaclass printInstVarNamesOn:aStream indent:8.
     aStream nextPutAll:''''.
 
     "mhmh - good idea; saw this in SmallDraw sourcecode ..."
 
     anySuperClassInstVar := false.
     self allSuperclassesDo:[:aSuperClass |
-        aSuperClass class instVarNames do:[:ignored | anySuperClassInstVar := true].
+        aSuperClass theMetaclass instVarNames do:[:ignored | anySuperClassInstVar := true].
     ].
 
     aStream cr; cr; nextPut:(Character doubleQuote); cr; space.
@@ -2333,7 +2387,7 @@
         aStream cr.
         self allSuperclassesDo:[:aSuperClass |
             aStream tab; nextPutAll:aSuperClass name; nextPutAll:' - '.
-            aStream nextPutLine:(aSuperClass class instanceVariableString).
+            aStream nextPutLine:(aSuperClass theMetaclass instanceVariableString).
         ].
 
     ].
@@ -2783,8 +2837,19 @@
     "Modified: 22.8.1997 / 14:59:14 / cg"
 !
 
-isObsolete
-    ^ false
+isObsolete 
+    "return true, if the receiver is obsolete 
+     (i.e. has been replaced by a different class or was removed, 
+      but is still referenced by instanced)"
+
+    |cat|
+
+    cat := self category.
+
+    ^ cat = 'obsolete' 
+      or:[cat = 'removed'
+      or:[cat = '* removed *'
+      or:[cat = '* obsolete *']]]
 !
 
 isSubclassOf:aClass
@@ -2914,6 +2979,24 @@
     "Modified: / 18.7.1998 / 22:53:19 / cg"
 !
 
+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 := cls superclass
+    ].
+    ^ nil
+!
+
 nameWithoutNameSpacePrefix
     |nm owner|
 
@@ -3590,7 +3673,7 @@
         "/ metaclasses are not found via Smalltalk allClassesDo:
         "/ here, walk over classes and enumerate corresponding metas.
         self soleInstance subclassesDo:[:aSubClass |
-            aBlock value:(aSubClass class)
+            aBlock value:(aSubClass theMetaclass)
         ].
         ^ self
     ].
@@ -3648,6 +3731,36 @@
     ^ true
 !
 
+whichClassDefinesClassVar:aVariableName
+    "return the class which defines the class variable
+     named aVariableName. This method should not be used for
+     repeated searches (i.e. in the compiler/parser), since it creates
+     many throw away intermediate objects."
+
+    |cls|
+
+    cls := self.
+    [cls notNil] whileTrue:[
+        (cls classVarNames includes:aVariableName) ifTrue:[ ^ cls].
+        cls := cls superclass
+    ].
+    ^ nil
+!
+
+whichClassIncludesSelector:aSelector
+    "return the class in the inheritance chain, which implements the method
+     for aSelector; return nil if none."
+
+    |cls|
+
+    cls := self.
+    [cls notNil] whileTrue:[
+        (cls includesSelector:aSelector) ifTrue:[^ cls].
+        cls := cls superclass
+    ].
+    ^ nil
+!
+
 withAllSuperclasses
     "return a collection containing the receiver and all
      of the receivers accumulated superclasses"
@@ -3661,10 +3774,6 @@
         theSuperClass := theSuperClass superclass
     ].
     ^ aCollection
-
-    "
-     String withAllSuperclasses 
-    "
 !
 
 withAllSuperclassesDo:aBlock
@@ -3707,6 +3816,10 @@
     ^ (self flags bitAnd:Behavior maskIndexType) == Behavior flagFloats.
 !
 
+isImageBehavior
+    ^ true
+!
+
 isLoaded
     |superclass|