--- 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