SnapShotImage.st
changeset 1417 28d6026fe30c
parent 1415 77abca16cfa3
child 1418 7466259d8bb5
--- a/SnapShotImage.st	Mon Oct 23 19:41:18 2000 +0200
+++ b/SnapShotImage.st	Tue Oct 24 13:17:22 2000 +0200
@@ -1,3 +1,5 @@
+'From Smalltalk/X, Version:4.1.1 on 24-Okt-2000 at 12:50:49'                    !
+
 "{ Package: 'cg:private' }"
 
 Object subclass:#SnapShotImage
@@ -17,15 +19,16 @@
 !SnapShotImage methodsFor:'private'!
 
 fetchGlobals
+    globals := IdentityDictionary new.
     memory globalEntries do:[:eachEntry |
-        |pNameSym pVal nameSym value|
+        |nameSymRef valRef nameSym value|
 
-        pNameSym := eachEntry key.
-        pVal := eachEntry value.
+        nameSymRef := eachEntry key.
+        valRef := eachEntry value.
+        nameSymRef isImageSymbol ifFalse:[self halt].
 
-        nameSym := memory fetchObjectAt:pNameSym.
-        value := memory fetchObjectAt:pVal.
-        self halt.
+        nameSym := (memory printStringOfSymbol:nameSymRef) asSymbol.
+        globals at:nameSym put:valRef
     ].
 !
 
@@ -37,13 +40,28 @@
 !SnapShotImage methodsFor:'smalltalk protocol'!
 
 allClassesDo:aBlock
-    self keysAndValuesDo:[:key :val |
-        val isBehavior ifTrue:[
-            aBlock value:val
+    self keysAndValuesDo:[:key :valRef |
+        valRef isInteger ifFalse:[
+            valRef ~~ true ifTrue:[
+                valRef ~~ false ifTrue:[
+                    valRef notNil ifTrue:[
+                        valRef isImageBehavior ifTrue:[
+                            aBlock value:valRef
+                        ]
+                    ]
+                ]
+            ]
         ]
     ].
 !
 
+at:aKey
+    globals isNil ifTrue:[
+        self fetchGlobals
+    ].
+    ^ globals at:aKey
+!
+
 keysAndValuesDo:aTwoArgBlock
     globals isNil ifTrue:[
         self fetchGlobals